Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Move web transaction into a module procedure.

The web transaction can now be called directly from the main build
script on all platforms except older MSys. These are now the only
machines that need to set aux_path any more. run_web_txn.pl becomes
a skeleton wrapper that calls the module from a more modern perl
than the MSys DTK perl. We detect the necessity for it by the fact
that the verion of perl running the build script is < 5.8.

This removes or greatly lessens the impact of a very long-standing
wart on the system.
  • Loading branch information...
commit ecca968fc60e5730a1da33f02e0bd1c12663c2a7 1 parent d5b614d
@adunstan adunstan authored
Showing with 166 additions and 111 deletions.
  1. +136 −0 PGBuild/WebTxn.pm
  2. +2 −2 build-farm.conf
  3. +18 −16 run_build.pl
  4. +10 −93 run_web_txn.pl
View
136 PGBuild/WebTxn.pm
@@ -0,0 +1,136 @@
+package PGBuild::WebTxn;
+
+=comment
+
+Copyright (c) 2003-2013, Andrew Dunstan
+
+See accompanying License file for license details
+
+
+Most of this code is imported from the older standalone script run_web_txn.pl
+which is now just a shell that calls the function below. It is now only
+needed on older Msys installations (i.e. things running perl < 5.8).
+
+=cut
+
+
+
+use strict;
+
+use vars qw($VERSION); $VERSION = 'REL_4.10';
+
+use vars qw($changed_this_run $changed_since_success $branch $status $stage
+ $animal $ts $log_data $confsum $target $verbose $secret);
+
+sub run_web_txn
+{
+
+ my $lrname = shift || 'lastrun-logs';
+
+ # make these runtime imports so they are loaded by the perl that's running
+ # the procedure. On older Msys it won't be the same as the one that's
+ # running run_build.pl.
+
+ require LWP; import LWP;
+ require HTTP::Request::Common; import HTTP::Request::Common;
+ require MIME::Base64; import MIME::Base64;
+ require Digest::SHA; import Digest::SHA qw(sha1_hex);
+ require Storable; import Storable qw(nfreeze);
+
+ my $txfname = "$lrname/web-txn.data";
+ my $txdhandle;
+ $/=undef;
+ open($txdhandle,"$txfname") or die "opening $txfname: $!";
+ my $txdata = <$txdhandle>;
+ close($txdhandle);
+
+ eval $txdata;
+ if ($@)
+ {
+ warn $@;
+ return undef;
+ }
+
+ my $tarname = "$lrname/runlogs.tgz";
+ my $tardata="";
+ if (open($txdhandle,$tarname))
+ {
+ binmode $txdhandle;
+ $tardata=<$txdhandle>;
+ close($txdhandle);
+ }
+
+ # add our own version string and time
+ my $current_ts = time;
+ my $webscriptversion = "'web_script_version' => '$VERSION',\n";
+ my $cts = "'current_ts' => $current_ts,\n";
+
+ # $2 here helps us to preserve the nice spacing from Data::Dumper
+ my $scriptline = "((.*)'script_version' => '(REL_)?\\d+\\.\\d+',\n)";
+ $confsum =~ s/$scriptline/$1$2$webscriptversion$2$cts/;
+ my $sconf = $confsum;
+ $sconf =~ s/.*(\$Script_Config)/$1/ms;
+ my $Script_Config;
+ eval $sconf;
+
+ # very modern Storable modules choke on regexes
+ # the server has no need of them anyway, so just chop them out
+ # they are still there in the text version used for reporting
+ foreach my $k ( keys %$Script_Config )
+ {
+ delete $Script_Config->{$k}
+ if ref($Script_Config->{$k}) eq q(Regexp);
+ }
+ my $frozen_sconf = nfreeze $Script_Config;
+
+ # 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/+=/$@/; }
+ ($log_data,$confsum,$changed_this_run,$changed_since_success,$tardata,
+ $frozen_sconf
+ );
+
+ my $content =
+ "changed_files=$changed_this_run&"
+ . "changed_since_success=$changed_since_success&"
+ ."branch=$branch&res=$status&stage=$stage&animal=$animal&ts=$ts"
+ ."&log=$log_data&conf=$confsum";
+ my $sig= sha1_hex($content,$secret);
+
+ $content .= "&frozen_sconf=$frozen_sconf";
+
+ if ($tardata)
+ {
+ $content .= "&logtar=$tardata";
+ }
+
+ 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 => "$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: stage=$stage&animal=$animal&ts=$ts\n",
+ "Target: $target/$sig\n";
+ print "Status Line: ",$response->status_line,"\n";
+ print "Content: \n", $response->content,"\n"
+ if ($verbose && $response->content);
+ return undef;
+ }
+
+ return 1;
+}
+
+1;
View
4 build-farm.conf
@@ -40,8 +40,8 @@ my $branch;
# path to directory with auxiliary web script
# if relative, the must be relative to buildroot/branch
- # possibly only necessary now on WIndows, if at all
- aux_path => "../..",
+ # Now only used on older Msys installations
+ # aux_path => "../..",
keep_error_builds => 0,
target => "http://www.pgbuildfarm.org/cgi-bin/pgstatus.pl",
View
34 run_build.pl
@@ -74,6 +74,7 @@ BEGIN
use PGBuild::SCM;
use PGBuild::Options;
+use PGBuild::WebTxn;
my %module_hooks;
my $orig_dir = getcwd();
@@ -1796,27 +1797,28 @@ sub send_result
unlink "$lrname/runlogs.tgz";
}
- unless (
- -x "$aux_path/run_web_txn.pl"
- ||($using_msvc && -f "$aux_path/run_web_txn.pl")
- )
- {
- print "Could not locate $aux_path/run_web_txn.pl\n";
- exit(1);
- }
+ my $txstatus;
- if ($using_msvc)
- {
+ # this should now only apply to older Msys installs. All others should
+ # be running with perl >= 5.8 since that's required to build postgres
+ # anyway
+ if (!$^V or $^V lt v5.8.0)
+ {
+
+ unless (-x "$aux_path/run_web_txn.pl")
+ {
+ print "Could not locate $aux_path/run_web_txn.pl\n";
+ exit(1);
+ }
- # no shebang line for windows, but perl is in the path
- system("perl \"$aux_path/run_web_txn.pl\" $lrname");
- }
- else
- {
system("$aux_path/run_web_txn.pl $lrname");
+ $txstatus = $? >> 8;
}
+ else
+ {
+ $txstatus = PGBuild::WebTxn::run_web_txn($lrname) ? 0 : 1;
- my $txstatus = $? >> 8;
+ }
if ($txstatus)
{
View
103 run_web_txn.pl
@@ -2,7 +2,7 @@
=comment
-Copyright (c) 2003-2010, Andrew Dunstan
+Copyright (c) 2003-2013, Andrew Dunstan
See accompanying License file for license details
@@ -12,6 +12,12 @@
#
# part of postgresql buildfarm suite.
#
+#
+# The comments below now only apply to older Msys installations (where
+# the native SDK perl version is < 5.8).
+# All other installations now do not need to set aux_path, nor should this
+# script be called.
+#
# auxiliary script to get around the
# fact that the SDK perl for MSys can't do the web
# transaction part. On Windows the shebang line
@@ -35,102 +41,13 @@
use vars qw($VERSION); $VERSION = 'REL_4.10';
-use LWP;
-use HTTP::Request::Common;
-use MIME::Base64;
-use Digest::SHA qw(sha1_hex);
-use Storable qw(nfreeze);
+use PGBuild::WebTxn;
my $lrname = $ARGV[0] || 'lastrun-logs';
-use vars qw($changed_this_run $changed_since_success $branch $status $stage
- $animal $ts $log_data $confsum $target $verbose $secret);
-
-my $txfname = "$lrname/web-txn.data";
-my $txdhandle;
-$/=undef;
-open($txdhandle,"$txfname") or die "opening $txfname: $!";
-my $txdata = <$txdhandle>;
-close($txdhandle);
-
-eval $txdata;
-die $@ if $@;
-
-my $tarname = "$lrname/runlogs.tgz";
-my $tardata="";
-if (open($txdhandle,$tarname))
-{
- binmode $txdhandle;
- $tardata=<$txdhandle>;
- close($txdhandle);
-}
-
-# add our own version string and time
-my $current_ts = time;
-my $webscriptversion = "'web_script_version' => '$VERSION',\n";
-my $cts = "'current_ts' => $current_ts,\n";
-
-# $2 here helps us to preserve the nice spacing from Data::Dumper
-my $scriptline = "((.*)'script_version' => '(REL_)?\\d+\\.\\d+',\n)";
-$confsum =~ s/$scriptline/$1$2$webscriptversion$2$cts/;
-my $sconf = $confsum;
-$sconf =~ s/.*(\$Script_Config)/$1/ms;
-my $Script_Config;
-eval $sconf;
-
-# very modern Storable modules choke on regexes
-# the server has no need of them anyway, so just chop them out
-# they are still there in the text version used for reporting
-foreach my $k ( keys %$Script_Config )
-{
- delete $Script_Config->{$k}
- if ref($Script_Config->{$k}) eq q(Regexp);
-}
-my $frozen_sconf = nfreeze $Script_Config;
-
-# 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/+=/$@/; }(
- $log_data,$confsum,$changed_this_run,$changed_since_success,$tardata,
- $frozen_sconf
-);
-
-my $content =
- "changed_files=$changed_this_run&"
- ."changed_since_success=$changed_since_success&"
- ."branch=$branch&res=$status&stage=$stage&animal=$animal&ts=$ts"
- ."&log=$log_data&conf=$confsum";
-my $sig= sha1_hex($content,$secret);
-
-$content .= "&frozen_sconf=$frozen_sconf";
-
-if ($tardata)
-{
- $content .= "&logtar=$tardata";
-}
+my $res = PGBuild::WebTxn::run_web_txn($lrname);
-my $ua = new LWP::UserAgent;
-$ua->agent("Postgres Build Farm Reporter");
-if (my $proxy = $ENV{BF_PROXY})
-{
- $ua->proxy('http',$proxy);
-}
+exit $res ? 0 : 1;
-my $request=HTTP::Request->new(POST => "$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: stage=$stage&animal=$animal&ts=$ts\n",
- "Target: $target/$sig\n";
- print "Status Line: ",$response->status_line,"\n";
- print "Content: \n", $response->content,"\n"
- if ($verbose && $response->content);
- exit 1;
-}
Please sign in to comment.
Something went wrong with that request. Please try again.