Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 141 lines (111 sloc) 3.863 kB
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
1 #!/usr/bin/perl
2
845a630 @adunstan Add README and License files, and license/copyright notices.
adunstan authored
3 =comment
4
5 Copyright (c) 2003-2010, Andrew Dunstan
6
7 See accompanying License file for license details
8
9 =cut
10
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
11 ###################################################
12 #
13 # part of postgresql buildfarm suite.
14 #
15 # auxiliary script to get around the
16 # fact that the SDK perl for MSys can't do the web
17 # transaction part. On Windows the shebang line
18 # must be set to a perl that has the required packages below.
19 # I have only tested with ActiveState perl, and on my Windows machine
20 # the line reads: #!/c/perl/bin/perl
21 #
22 # Unix and Cygwin users should set the shebang line to be the same
23 # as the one in run_build.pl.
24 #
25 # All users need to set the aux_path setting in their config files
26 # to be an absolute or relative path to this script. If relative, then
27 # it must be relative to <buildroot>/<$branch>. The reason for this crazy
28 # setup is so that thhis script does not need to change directory
29 # at all, which lets us get around virtual path craziness that we
30 # encounter on MSys.
31 #
32 ######################################################
33
34
35
36 use strict;
37
27b7d1e @adunstan setting version for tag REL_4_4
adunstan authored
38 use vars qw($VERSION); $VERSION = 'REL_4.4';
e86c931 @adunstan Move to tag based versioning scheme - we'll be able to sue this with …
adunstan authored
39
9f67960 @adunstan Avoid giving Storable a regex object to freeze, which modern versions…
adunstan authored
40 # q$Id: run_web_txn.pl,v 1.10 2010/11/09 20:56:11 andrewd Exp $
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
41
42 use LWP;
43 use HTTP::Request::Common;
44 use MIME::Base64;
45 use Digest::SHA1 qw(sha1_hex);
de6849a @adunstan send frozen copy of conf to server
adunstan authored
46 use Storable qw(nfreeze);
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
47
110c804 @adunstan - upload a zipped tar of all the logs, regardless of success status
adunstan authored
48 my $lrname = $ARGV[0] || 'lastrun-logs' ;
49
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
50
51 use vars qw($changed_this_run $changed_since_success $branch $status $stage
52 $animal $ts $log_data $confsum $target $verbose $secret);
53
110c804 @adunstan - upload a zipped tar of all the logs, regardless of success status
adunstan authored
54 my $txfname = "$lrname/web-txn.data";
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
55 my $txdhandle;
56 $/=undef;
110c804 @adunstan - upload a zipped tar of all the logs, regardless of success status
adunstan authored
57 open($txdhandle,"$txfname") or die "opening $txfname: $!";
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
58 my $txdata = <$txdhandle>;
59 close($txdhandle);
60
61 eval $txdata; die $@ if $@;
62
110c804 @adunstan - upload a zipped tar of all the logs, regardless of success status
adunstan authored
63 my $tarname = "$lrname/runlogs.tgz";
64 my $tardata="";
65 if (open($txdhandle,$tarname))
66 {
67 binmode $txdhandle;
68 $tardata=<$txdhandle>;
69 close($txdhandle);
70 }
71
ffe86cb @adunstan report current timestamp to server for reconciliation.
adunstan authored
72 # add our own version string and time
73 my $current_ts = time;
74 my $webscriptversion = "'web_script_version' => '$VERSION',\n" ;
75 my $cts = "'current_ts' => $current_ts,\n";
76 # $2 here helps us to preserve the nice spacing from Data::Dumper
635fd00 @adunstan fix web script version bug
adunstan authored
77 my $scriptline = "((.*)'script_version' => '(REL_)?\\d+\\.\\d+',\n)";
ffe86cb @adunstan report current timestamp to server for reconciliation.
adunstan authored
78 $confsum =~ s/$scriptline/$1$2$webscriptversion$2$cts/;
de6849a @adunstan send frozen copy of conf to server
adunstan authored
79 my $sconf = $confsum;
80 $sconf =~ s/.*(\$Script_Config)/$1/ms;
81 my $Script_Config;
82 eval $sconf;
9f67960 @adunstan Avoid giving Storable a regex object to freeze, which modern versions…
adunstan authored
83 # very modern Storable modules choke on regexes
84 # the server has no need of them anyway, so just chop them out
85 # they are still there in the text version used for reporting
86 foreach my $k ( keys %$Script_Config )
87 {
88 delete $Script_Config->{$k}
89 if ref($Script_Config->{$k}) eq q(Regexp);
90 }
de6849a @adunstan send frozen copy of conf to server
adunstan authored
91 my $frozen_sconf = nfreeze $Script_Config;
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
92
93 # make the base64 data escape-proof; = is probably ok but no harm done
94 # this ensures that what is seen at the other end is EXACTLY what we
95 # see when we calculate the signature
96
97 map
98 { $_=encode_base64($_,""); tr/+=/$@/; }
de6849a @adunstan send frozen copy of conf to server
adunstan authored
99 ($log_data,$confsum,$changed_this_run,$changed_since_success,$tardata,
100 $frozen_sconf);
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
101
102 my $content =
103 "changed_files=$changed_this_run&".
104 "changed_since_success=$changed_since_success&".
105 "branch=$branch&res=$status&stage=$stage&animal=$animal&ts=$ts".
106 "&log=$log_data&conf=$confsum";
107 my $sig= sha1_hex($content,$secret);
1564a9f @adunstan add support for web proxy if farm member needs one to get through a f…
adunstan authored
108
de6849a @adunstan send frozen copy of conf to server
adunstan authored
109 $content .= "&frozen_sconf=$frozen_sconf";
110
110c804 @adunstan - upload a zipped tar of all the logs, regardless of success status
adunstan authored
111 if ($tardata)
112 {
113 $content .= "&logtar=$tardata";
114 }
115
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
116 my $ua = new LWP::UserAgent;
117 $ua->agent("Postgres Build Farm Reporter");
1564a9f @adunstan add support for web proxy if farm member needs one to get through a f…
adunstan authored
118 if (my $proxy = $ENV{BF_PROXY})
119 {
120 $ua->proxy('http',$proxy);
121 }
122
123
be6b85f @adunstan - sanity checks for running as root and absent cvs login
adunstan authored
124 my $request=HTTP::Request->new(POST => "$target/$sig");
125 $request->content_type("application/x-www-form-urlencoded");
126 $request->content($content);
127
128
129 my $response=$ua->request($request);
130
131 unless ($response->is_success)
132 {
133 print
134 "Query for: stage=$stage&animal=$animal&ts=$ts\n",
135 "Target: $target/$sig\n";
136 print "Status Line: ",$response->status_line,"\n";
137 print "Content: \n", $response->content,"\n"
138 if ($verbose && $response->content);
139 exit 1;
140 }
Something went wrong with that request. Please try again.