1 package EximBuild::WebTxn;
5 Copyright (c) 2003-2013, Andrew Dunstan
7 See accompanying License file for license details
10 Most of this code is imported from the older standalone script run_web_txn.pl
11 which is now just a shell that calls the function below. It is now only
12 needed on older Msys installations (i.e. things running perl < 5.8).
19 use vars qw($VERSION); $VERSION = 'REL_0.1';
21 use vars qw($changed_this_run $changed_since_success $branch $status $stage
22 $animal $ts $log_data $confsum $target $verbose $secret);
27 my $lrname = shift || 'lastrun-logs';
29 # make these runtime imports so they are loaded by the perl that's running
30 # the procedure. On older Msys it won't be the same as the one that's
31 # running run_build.pl.
35 require HTTP::Request::Common;
36 import HTTP::Request::Common;
40 import Digest::SHA qw(sha1_hex);
42 import Storable qw(nfreeze);
44 my $txfname = "$lrname/web-txn.data";
47 open($txdhandle,"$txfname") or die "opening $txfname: $!";
48 my $txdata = <$txdhandle>;
58 my $tarname = "$lrname/runlogs.tgz";
60 if (open($txdhandle,$tarname))
62 # This creates the tarball to send to the buildfarm server
64 $tardata=<$txdhandle>;
68 # add our own version string and time
69 my $current_ts = time;
70 my $webscriptversion = "'web_script_version' => '$VERSION',\n";
71 my $cts = "'current_ts' => $current_ts,\n";
73 # $2 here helps us to preserve the nice spacing from Data::Dumper
74 my $scriptline = "((.*)'script_version' => '(REL_)?\\d+\\.\\d+',\n)";
75 $confsum =~ s/$scriptline/$1$2$webscriptversion$2$cts/;
77 $sconf =~ s/.*(\$Script_Config)/$1/ms;
81 # very modern Storable modules choke on regexes
82 # the server has no need of them anyway, so just chop them out
83 # they are still there in the text version used for reporting
84 foreach my $k ( keys %$Script_Config )
86 delete $Script_Config->{$k}
87 if ref($Script_Config->{$k}) eq q(Regexp);
89 my $frozen_sconf = nfreeze($Script_Config);
91 # make the base64 data escape-proof; = is probably ok but no harm done
92 # this ensures that what is seen at the other end is EXACTLY what we
93 # see when we calculate the signature
95 map{ $_=encode_base64($_,""); tr/+=/$@/; }(
96 $log_data,$confsum,$changed_this_run,$changed_since_success,$tardata,
101 "changed_files=$changed_this_run&"
102 . "changed_since_success=$changed_since_success&"
103 . 'branch=' . uri_escape($branch) . "&res=$status&stage=$stage&animal=$animal&ts=$ts"
104 ."&log=$log_data&conf=$confsum";
105 my $sig = sha1_hex($content,$secret);
107 $content .= "&frozen_sconf=$frozen_sconf";
111 $content .= "&logtar=$tardata";
114 my $ua = new LWP::UserAgent;
115 $ua->agent("Exim Build Farm Reporter");
116 if (my $proxy = $ENV{BF_PROXY})
118 # untested. Please notify hs@schlittermann.de, if you
119 # encounter any problem here:
120 $ua->proxy(URI->new($target)->scheme, $proxy);
123 my $request=HTTP::Request->new(POST => "$target/$sig");
124 $request->content_type("application/x-www-form-urlencoded");
125 $request->content($content);
127 my $response=$ua->request($request);
129 unless ($response->is_success)
132 "Query for: stage=$stage&animal=$animal&ts=$ts\n",
133 "Target: $target/$sig\n";
134 print "Status Line: ",$response->status_line,"\n";
135 print "Content: \n", $response->content,"\n"
136 if ($verbose && $response->content);