Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Branch: master
Fetching contributors…

Cannot retrieve contributors at this time

executable file 140 lines (97 sloc) 3.01 kB
#!/usr/bin/perl
=comment
Copyright (c) 2003-2010, Andrew Dunstan
See accompanying License file for license details
=cut
use vars qw($VERSION); $VERSION = 'REL_4.4';
# $Id: update_personality.pl,v 1.4 2010/11/07 23:35:29 andrewd Exp $
use strict;
use warnings;
no warnings qw(once); # suppress spurious warning about conf structure
use LWP;
use HTTP::Request::Common;
use MIME::Base64;
use Digest::SHA1 qw(sha1_hex);
use Getopt::Long;
# copy command line before processing - so we can later report it
# unmunged
my @invocation_args = (@ARGV);
my $buildconf = "build-farm.conf"; # default value
my ($os_version, $compiler_version,$help);
GetOptions('config=s' => \$buildconf,
'help' => \$help,
'os-version=s' => \$os_version,
'compiler-version=s' => \$compiler_version,
)
|| usage("bad command line");
usage("No extra args allowed")
if @_;
usage()
if $help;
usage("must specify at least one item to change")
unless ($os_version or $compiler_version);
#
# process config file
#
require $buildconf ;
my ($target,$animal,$secret,$upgrade_target) =
@PGBuild::conf{ qw(target animal secret upgrade_target) };
# default for old config files
unless ($upgrade_target)
{
$upgrade_target = $target;
$upgrade_target =~ s/pgstatus.pl/upgrade.pl/;
}
# make the base64 data escape-proof; = is probably ok but no harm done
# this ensures that what is seen at the other end is EXACTLY what we
# see when we calculate the signature
map
{ $_ ||= ""; $_ = encode_base64($_,""); tr/+=/$@/; }
($os_version,$compiler_version);
my $ts = time;
my $content = "animal=$animal\&ts=$ts";
$content .= "\&new_os=$os_version" if $os_version;
$content .= "\&new_compiler=$compiler_version" if $compiler_version;
my $sig= sha1_hex($content,$secret);
# set environment from config
while (my ($envkey,$envval) = each %{$PGBuild::conf{build_env}})
{
$ENV{$envkey}=$envval;
}
my $ua = new LWP::UserAgent;
$ua->agent("Postgres Build Farm Reporter");
if (my $proxy = $ENV{BF_PROXY})
{
$ua->proxy('http',$proxy);
}
my $request=HTTP::Request->new(POST => "$upgrade_target/$sig");
$request->content_type("application/x-www-form-urlencoded");
$request->content($content);
my $response=$ua->request($request);
unless ($response->is_success)
{
print
"Query for: animal=$animal&ts=$ts\n",
"Target: $upgrade_target/$sig\n",
"Query Content: $content\n";
print "Status Line: ",$response->status_line,"\n";
print "Content: \n", $response->content,"\n" ;
exit 1;
}
exit(0);
#######################################################################
sub usage
{
my $opt_message = shift ;
print "$opt_message\n" if $opt_message;
print <<EOH;
update_personality.pl [ option ... ]
where option is one or more of
--config=path /path/to/buildfarm.conf
--os-version=version new operating system version
--compiler-version=version new compiler version
--help get this message
EOH
;
exit defined($opt_message)+0;
}
Jump to Line
Something went wrong with that request. Please try again.