From: Todd Lyons Date: Wed, 16 Oct 2013 16:14:04 +0000 (-0700) Subject: Initial conversion to Exim X-Git-Url: https://git.exim.org/buildfarm-server.git/commitdiff_plain/8300080b490ebbaa1d9b9176d864b0ea62e7fd2a Initial conversion to Exim --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..27cd24b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +BuildFarmWeb.pl diff --git a/bf-alerts.pl b/bf-alerts.pl index 091b558..09ac2c2 100755 --- a/bf-alerts.pl +++ b/bf-alerts.pl @@ -116,10 +116,6 @@ print "starting alert run: $lts\n"; foreach my $sysbranch (@last_heard) { - # not all versions of DBD::Pg decode modern bytea literals nicely. cope. - $sysbranch->{config} =~ s/^(\\?x)([a-fA-F0-9]+)$/pack('H*',$2)/e; - - my $client_conf = thaw $sysbranch->{config}; my %client_alert_settings = %{ $client_conf->{alerts} || {} }; diff --git a/cgi-bin/eximstatus.pl b/cgi-bin/eximstatus.pl new file mode 100755 index 0000000..b57655c --- /dev/null +++ b/cgi-bin/eximstatus.pl @@ -0,0 +1,598 @@ +#!/usr/bin/perl + +=comment + +Copyright (c) 2003-2010, Andrew Dunstan + +See accompanying License file for license details + +=cut + +use strict; + +use vars qw($dbhost $dbname $dbuser $dbpass $dbport + $all_stat $fail_stat $change_stat $green_stat + $server_time + $min_script_version $min_web_script_version + $default_host $local_git_clone +); + +# force this before we do anything - even load modules +BEGIN { $server_time = time; } + +use CGI; +use Digest::SHA1 qw(sha1_hex); +use MIME::Base64; +use DBI; +use DBD::mysql; +use Data::Dumper; +use Mail::Send; +use Time::ParseDate; +use Storable qw(thaw); + +require "$ENV{BFConfDir}/BuildFarmWeb.pl"; +my $buildlogs = "$ENV{BFConfDir}/buildlogs"; + +die "no dbname" unless $dbname; +die "no dbuser" unless $dbuser; + +my $dsn="dbi:mysql:dbname=$dbname"; +$dsn .= ";host=$dbhost" if $dbhost; +$dsn .= ";port=$dbport" if $dbport; + +my $query = new CGI; + +my $sig = $query->path_info; +$sig =~ s!^/!!; + +my $stage = $query->param('stage'); +my $ts = $query->param('ts'); +my $animal = $query->param('animal'); +my $log = $query->param('log'); +my $res = $query->param('res'); +my $conf = $query->param('conf'); +my $branch = $query->param('branch'); +my $changed_since_success = $query->param('changed_since_success'); +my $changed_this_run = $query->param('changed_files'); +my $log_archive = $query->param('logtar'); +my $frozen_sconf = $query->param('frozen_sconf') || ''; + +my $brhandle; +if (open($brhandle,"../htdocs/branches_of_interest.txt")) +{ + my @branches_of_interest = <$brhandle>; + close($brhandle); + chomp(@branches_of_interest); + unless (grep {$_ eq $branch} @branches_of_interest) + { + print + "Status: 492 bad branch parameter $branch\nContent-Type: text/plain\n\n", + "bad branch parameter $branch\n"; + exit; + } +} + + +my $content = + "branch=$branch&res=$res&stage=$stage&animal=$animal&". + "ts=$ts&log=$log&conf=$conf"; + +my $extra_content = + "changed_files=$changed_this_run&". + "changed_since_success=$changed_since_success&"; + +unless ($animal && $ts && $stage && $sig) +{ + print + "Status: 490 bad parameters\nContent-Type: text/plain\n\n", + "bad parameters for request\n"; + exit; + +} + +unless ($branch =~ /^(HEAD|REL\d+_\d+_STABLE)$/) +{ + print + "Status: 492 bad branch parameter $branch\nContent-Type: text/plain\n\n", + "bad branch parameter $branch\n"; + exit; + +} + + +my $db = DBI->connect($dsn,$dbuser,$dbpass); + +die $DBI::errstr unless $db; + +my $gethost= + "select secret from buildsystems where name = ? and status = 'approved'"; +my $sth = $db->prepare($gethost); +$sth->execute($animal); +my ($secret)=$sth->fetchrow_array(); +$sth->finish; + +my $tsdiff = time - $ts; + +my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ts); +$year += 1900; $mon +=1; +my $date= + sprintf("%d-%.2d-%.2d_%.2d:%.2d:%.2d",$year,$mon,$mday,$hour,$min,$sec); + +if ($ENV{BF_DEBUG} || ($ts > time) || ($ts + 86400 < time ) || (! $secret) ) +{ + open(TX,">$buildlogs/$animal.$date"); + print TX "sig=$sig\nlogtar-len=" , length($log_archive), + "\nstatus=$res\nstage=$stage\nconf:\n$conf\n", + "tsdiff:$tsdiff\n", + "changed_this_run:\n$changed_this_run\n", + "changed_since_success:\n$changed_since_success\n", + "frozen_sconf:$frozen_sconf\n", + "log:\n",$log; +# $query->save(\*TX); + close(TX); +} + +unless ($ts < time + 120) +{ + my $gmt = gmtime($ts); + print "Status: 491 bad ts parameter - $ts ($gmt GMT) is in the future.\n", + "Content-Type: text/plain\n\n bad ts parameter - $ts ($gmt GMT) is in the future\n"; + $db->disconnect; + exit; +} + +unless ($ts + 86400 > time) +{ + my $gmt = gmtime($ts); + print "Status: 491 bad ts parameter - $ts ($gmt GMT) is more than 24 hours ago.\n", + "Content-Type: text/plain\n\n bad ts parameter - $ts ($gmt GMT) is more than 24 hours ago.\n"; + $db->disconnect; + exit; +} + +unless ($secret) +{ + print + "Status: 495 Unknown System\nContent-Type: text/plain\n\n", + "System $animal is unknown\n"; + $db->disconnect; + exit; + +} + + + + +my $calc_sig = sha1_hex($content,$secret); +my $calc_sig2 = sha1_hex($extra_content,$content,$secret); + +if ($calc_sig ne $sig && $calc_sig2 ne $sig) +{ + + print "Status: 450 sig mismatch\nContent-Type: text/plain\n\n"; + print "$sig mismatches $calc_sig($calc_sig2) on content:\n$content"; + $db->disconnect; + exit; +} + +# undo escape-proofing of base64 data and decode it +map {tr/$@/+=/; $_ = decode_base64($_); } + ($log, $conf,$changed_this_run,$changed_since_success,$log_archive, $frozen_sconf); + +if ($log =~/Last file mtime in snapshot: (.*)/) +{ + my $snaptime = parsedate($1); + my $brch = $branch eq 'HEAD' ? 'master' : $branch; + my $last_branch_time = time - (30 * 86400); + $last_branch_time = `TZ=UTC GIT_DIR=$local_git_clone git log -1 --pretty=format:\%ct $brch`; + if ($snaptime < ($last_branch_time - 86400)) + { + print "Status: 493 snapshot too old: $1\nContent-Type: text/plain\n\n"; + print "snapshot to old: $1\n"; + $db->disconnect; + exit; + } +} + +($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($ts); +$year += 1900; $mon +=1; +my $dbdate= + sprintf("%d-%.2d-%.2d %.2d:%.2d:%.2d",$year,$mon,$mday,$hour,$min,$sec); + +my $log_file_names; +my @log_file_names; +my $dirname = "$buildlogs/tmp.$$.unpacklogs"; + +my $githeadref; + +if ($log_archive) +{ + my $log_handle; + my $archname = "$buildlogs/tmp.$$.tgz"; + open($log_handle,">$archname"); + binmode $log_handle; + print $log_handle $log_archive; + close $log_handle; + mkdir $dirname; + @log_file_names = `tar -z -C $dirname -xvf $archname 2>/dev/null`; + map {s/\s+//g; } @log_file_names; + my @qnames = grep { $_ ne 'githead.log' } @log_file_names; + map { $_ = qq("$_"); } @qnames; + $log_file_names = '{' . join(',',@qnames) . '}'; + if (-e "$dirname/githead.log" ) + { + open(my $githead,"$dirname/githead.log"); + $githeadref = <$githead>; + chomp $githeadref; + close $githead; + } + # unlink $archname; +} + +my $config_flags; +my $client_conf; +if ($frozen_sconf) +{ + $client_conf = thaw $frozen_sconf; +} + +if ($min_script_version) +{ + $client_conf->{script_version} ||= '0.0'; + my $cli_ver = $client_conf->{script_version} ; + $cli_ver =~ s/^REL_//; + my ($minmajor,$minminor) = split(/\./,$min_script_version); + my ($smajor,$sminor) = split(/\./,$cli_ver); + if ($minmajor > $smajor || ($minmajor == $smajor && $minminor > $sminor)) + { + print "Status: 460 script version too low\nContent-Type: text/plain\n\n"; + print + "Script version is below minimum required\n", + "Reported version: $client_conf->{script_version},", + "Minumum version required: $min_script_version\n"; + $db->disconnect; + exit; + } +} + +if ($min_web_script_version) +{ + $client_conf->{web_script_version} ||= '0.0'; + my $cli_ver = $client_conf->{web_script_version} ; + $cli_ver =~ s/^REL_//; + my ($minmajor,$minminor) = split(/\./,$min_web_script_version); + my ($smajor,$sminor) = split(/\./,$cli_ver); + if ($minmajor > $smajor || ($minmajor == $smajor && $minminor > $sminor)) + { + print "Status: 461 web script version too low\nContent-Type: text/plain\n\n"; + print + "Web Script version is below minimum required\n", + "Reported version: $client_conf->{web_script_version}, ", + "Minumum version required: $min_web_script_version\n" + ; + $db->disconnect; + exit; + } +} + +my @config_flags; +if (not exists $client_conf->{config_opts} ) +{ + @config_flags = (); +} +elsif (ref $client_conf->{config_opts} eq 'HASH') +{ + # leave out keys with false values + @config_flags = grep { $client_conf->{config_opts}->{$_} } + keys %{$client_conf->{config_opts}}; +} +elsif (ref $client_conf->{config_opts} eq 'ARRAY' ) +{ + @config_flags = @{$client_conf->{config_opts}}; +} + +if (@config_flags) +{ + @config_flags = grep {! m/=/ } @config_flags; + map {s/\s+//g; $_=qq("$_"); } @config_flags; + push @config_flags,'git' if $client_conf->{scm} eq 'git'; + $config_flags = '{' . join(',',@config_flags) . '}' ; +} + +my $scm = $client_conf->{scm} || 'cvs'; +my $scmurl = $client_conf->{scm_url}; + +my $logst = <begin_work; +$db->do("select set_local_error_terse()"); + + +$sth=$db->prepare($logst); + +$sth->bind_param(1,$animal); +$sth->bind_param(2,$dbdate); +$sth->bind_param(3,$res & 0x8fffffff); # in case we get a 64 bit int status! +$sth->bind_param(4,$stage); +$sth->bind_param(5,$log); +$sth->bind_param(6,$conf); +$sth->bind_param(7,$branch); +$sth->bind_param(8,$changed_this_run); +$sth->bind_param(9,$changed_since_success); +$sth->bind_param(10,$log_file_names); +#$sth->bind_param(11,$log_archive,{ pg_type => DBD::mysql::PG_BYTEA }); +$sth->bind_param(11,undef,{ pg_type => DBD::mysql::PG_BYTEA }); +$sth->bind_param(12,$config_flags); +$sth->bind_param(13,$scm); +$sth->bind_param(14,$scmurl); +$sth->bind_param(15,$githeadref); +$sth->bind_param(16,$frozen_sconf,{ pg_type => DBD::mysql::PG_BYTEA }); + +$sqlres = $sth->execute; + +if ($sqlres) +{ + + $sth->finish; + + my $logst2 = q{ + + insert into build_status_log + (sysname, snapshot, branch, log_stage, log_text, stage_duration) + values (?, ?, ?, ?, ?, ?) + + }; + + $sth = $db->prepare($logst2); + + $/=undef; + + my $stage_start = $ts; + + foreach my $log_file( @log_file_names ) + { + next if $log_file =~ /^githead/; + my $handle; + open($handle,"$dirname/$log_file"); + my $mtime = (stat $handle)[9]; + my $stage_interval = $mtime - $stage_start; + $stage_start = $mtime; + my $ltext = <$handle>; + close($handle); + $ltext =~ s/\x00/\\0/g; + $sqlres = $sth->execute($animal,$dbdate,$branch,$log_file,$ltext, + "$stage_interval seconds"); + last unless $sqlres; + } + + $sth->finish unless $sqlres; + +} + +if (! $sqlres) +{ + + print "Status: 462 database failure\nContent-Type: text/plain\n\n"; + print "Your report generated a database failure:\n", + $db->errstr, + "\n"; + $db->rollback; + $db->disconnect; + exit; +} + + +$db->commit; + +my $prevst = <prepare($prevst); +$sth->execute($animal,$branch,$dbdate); +my $row=$sth->fetchrow_arrayref; +my $prev_stat=$row->[0]; +$sth->finish; + +my $det_st = <prepare($det_st); +$sth->execute($animal); +$row=$sth->fetchrow_arrayref; +my ($os, $compiler,$arch) = @$row; +$sth->finish; + +$db->begin_work; +# prevent occasional duplication by forcing serialization of this operation +$db->do("lock table dashboard_mat in share row exclusive mode"); +$db->do("delete from dashboard_mat"); +$db->do("insert into dashboard_mat select * from dashboard_mat_data"); +$db->commit; + +if ($stage ne 'OK') +{ + $db->begin_work; + # prevent occasional duplication by forcing serialization of this operation + $db->do("lock table nrecent_failures in share row exclusive mode"); + $db->do("delete from nrecent_failures"); + $db->do("insert into nrecent_failures select bs.sysname, bs.snapshot, bs.branch from build_status bs where bs.stage <> 'OK' and bs.snapshot > now() - interval '90 days'"); + $db->commit; +} + +$db->disconnect; + +print "Content-Type: text/plain\n\n"; +print "request was on:\n"; +print "res=$res&stage=$stage&animal=$animal&ts=$ts"; + +my $client_events = $client_conf->{mail_events}; + +if ($ENV{BF_DEBUG}) +{ + my $client_time = $client_conf->{current_ts}; + open(TX,">>$buildlogs/$animal.$date"); + print TX "\n",Dumper(\$client_conf),"\n"; + print TX "server time: $server_time, client time: $client_time\n" if $client_time; + close(TX); +} + +my $bcc_stat = []; +my $bcc_chg=[]; +if (ref $client_events) +{ + my $cbcc = $client_events->{all}; + if (ref $cbcc) + { + push @$bcc_stat, @$cbcc; + } + elsif (defined $cbcc) + { + push @$bcc_stat, $cbcc; + } + if ($stage ne 'OK') + { + $cbcc = $client_events->{all}; + if (ref $cbcc) + { + push @$bcc_stat, @$cbcc; + } + elsif (defined $cbcc) + { + push @$bcc_stat, $cbcc; + } + } + $cbcc = $client_events->{change}; + if (ref $cbcc) + { + push @$bcc_chg, @$cbcc; + } + elsif (defined $cbcc) + { + push @$bcc_chg, $cbcc; + } + if ($stage eq 'OK' || $prev_stat eq 'OK') + { + $cbcc = $client_events->{green}; + if (ref $cbcc) + { + push @$bcc_chg, @$cbcc; + } + elsif (defined $cbcc) + { + push @$bcc_chg, $cbcc; + } + } +} + + +my $url = $query->url(-base => 1); + + +my $stat_type = $stage eq 'OK' ? 'Status' : 'Failed at Stage'; + +my $mailto = [@$all_stat]; +push(@$mailto,@$fail_stat) if $stage ne 'OK'; + +my $me = `id -un`; chomp($me); + +my $host = `hostname`; chomp ($host); +$host = $default_host unless ($host =~ m/[.]/ || !defined($default_host)); + +my $from_addr = "PG Build Farm <$me\@$host>"; +$from_addr =~ tr /\r\n//d; + +my $msg = new Mail::Send; + + +$msg->to(@$mailto); +$msg->bcc(@$bcc_stat) if (@$bcc_stat); +$msg->subject("PGBuildfarm member $animal Branch $branch $stat_type $stage"); +$msg->set('From',$from_addr); +my $fh = $msg->open; +print $fh <close; + +exit if ($stage eq $prev_stat); + +$mailto = [@$change_stat]; +push(@$mailto,@$green_stat) if ($stage eq 'OK' || $prev_stat eq 'OK'); + +$msg = new Mail::Send; + + +$msg->to(@$mailto); +$msg->bcc(@$bcc_chg) if (@$bcc_chg); + +$stat_type = $prev_stat ne 'OK' ? "changed from $prev_stat failure to $stage" : + "changed from OK to $stage"; +$stat_type = "New member: $stage" if $prev_stat eq 'NEW'; +$stat_type .= " failure" if $stage ne 'OK'; + +$msg->subject("PGBuildfarm member $animal Branch $branch Status $stat_type"); +$msg->set('From',$from_addr); +$fh = $msg->open; +print $fh <close; diff --git a/cgi-bin/get_bf_status_soap.pl b/cgi-bin/get_bf_status_soap.pl index 7815207..051f3f4 100755 --- a/cgi-bin/get_bf_status_soap.pl +++ b/cgi-bin/get_bf_status_soap.pl @@ -11,8 +11,8 @@ See accompanying License file for license details use SOAP::Lite ; my $obj = SOAP::Lite - ->uri('http://www.pgbuildfarm.org/PGBuildFarm') - ->proxy('http://www.pgbuildfarm.org/cgi-bin/show_status_soap.pl') + ->uri('http://eximbuild.mrball.net/EximBuildFarm') + ->proxy('http://eximbuild.mrball.net/cgi-bin/show_status_soap.pl') ; my $data = $obj->get_status->result; diff --git a/cgi-bin/pgstatus.pl b/cgi-bin/pgstatus.pl deleted file mode 100755 index 16ac79f..0000000 --- a/cgi-bin/pgstatus.pl +++ /dev/null @@ -1,598 +0,0 @@ -#!/usr/bin/perl - -=comment - -Copyright (c) 2003-2010, Andrew Dunstan - -See accompanying License file for license details - -=cut - -use strict; - -use vars qw($dbhost $dbname $dbuser $dbpass $dbport - $all_stat $fail_stat $change_stat $green_stat - $server_time - $min_script_version $min_web_script_version - $default_host $local_git_clone -); - -# force this before we do anything - even load modules -BEGIN { $server_time = time; } - -use CGI; -use Digest::SHA1 qw(sha1_hex); -use MIME::Base64; -use DBI; -use DBD::Pg; -use Data::Dumper; -use Mail::Send; -use Time::ParseDate; -use Storable qw(thaw); - -require "$ENV{BFConfDir}/BuildFarmWeb.pl"; -my $buildlogs = "$ENV{BFConfDir}/buildlogs"; - -die "no dbname" unless $dbname; -die "no dbuser" unless $dbuser; - -my $dsn="dbi:Pg:dbname=$dbname"; -$dsn .= ";host=$dbhost" if $dbhost; -$dsn .= ";port=$dbport" if $dbport; - -my $query = new CGI; - -my $sig = $query->path_info; -$sig =~ s!^/!!; - -my $stage = $query->param('stage'); -my $ts = $query->param('ts'); -my $animal = $query->param('animal'); -my $log = $query->param('log'); -my $res = $query->param('res'); -my $conf = $query->param('conf'); -my $branch = $query->param('branch'); -my $changed_since_success = $query->param('changed_since_success'); -my $changed_this_run = $query->param('changed_files'); -my $log_archive = $query->param('logtar'); -my $frozen_sconf = $query->param('frozen_sconf') || ''; - -my $brhandle; -if (open($brhandle,"../htdocs/branches_of_interest.txt")) -{ - my @branches_of_interest = <$brhandle>; - close($brhandle); - chomp(@branches_of_interest); - unless (grep {$_ eq $branch} @branches_of_interest) - { - print - "Status: 492 bad branch parameter $branch\nContent-Type: text/plain\n\n", - "bad branch parameter $branch\n"; - exit; - } -} - - -my $content = - "branch=$branch&res=$res&stage=$stage&animal=$animal&". - "ts=$ts&log=$log&conf=$conf"; - -my $extra_content = - "changed_files=$changed_this_run&". - "changed_since_success=$changed_since_success&"; - -unless ($animal && $ts && $stage && $sig) -{ - print - "Status: 490 bad parameters\nContent-Type: text/plain\n\n", - "bad parameters for request\n"; - exit; - -} - -unless ($branch =~ /^(HEAD|REL\d+_\d+_STABLE)$/) -{ - print - "Status: 492 bad branch parameter $branch\nContent-Type: text/plain\n\n", - "bad branch parameter $branch\n"; - exit; - -} - - -my $db = DBI->connect($dsn,$dbuser,$dbpass); - -die $DBI::errstr unless $db; - -my $gethost= - "select secret from buildsystems where name = ? and status = 'approved'"; -my $sth = $db->prepare($gethost); -$sth->execute($animal); -my ($secret)=$sth->fetchrow_array(); -$sth->finish; - -my $tsdiff = time - $ts; - -my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($ts); -$year += 1900; $mon +=1; -my $date= - sprintf("%d-%.2d-%.2d_%.2d:%.2d:%.2d",$year,$mon,$mday,$hour,$min,$sec); - -if ($ENV{BF_DEBUG} || ($ts > time) || ($ts + 86400 < time ) || (! $secret) ) -{ - open(TX,">$buildlogs/$animal.$date"); - print TX "sig=$sig\nlogtar-len=" , length($log_archive), - "\nstatus=$res\nstage=$stage\nconf:\n$conf\n", - "tsdiff:$tsdiff\n", - "changed_this_run:\n$changed_this_run\n", - "changed_since_success:\n$changed_since_success\n", - "frozen_sconf:$frozen_sconf\n", - "log:\n",$log; -# $query->save(\*TX); - close(TX); -} - -unless ($ts < time + 120) -{ - my $gmt = gmtime($ts); - print "Status: 491 bad ts parameter - $ts ($gmt GMT) is in the future.\n", - "Content-Type: text/plain\n\n bad ts parameter - $ts ($gmt GMT) is in the future\n"; - $db->disconnect; - exit; -} - -unless ($ts + 86400 > time) -{ - my $gmt = gmtime($ts); - print "Status: 491 bad ts parameter - $ts ($gmt GMT) is more than 24 hours ago.\n", - "Content-Type: text/plain\n\n bad ts parameter - $ts ($gmt GMT) is more than 24 hours ago.\n"; - $db->disconnect; - exit; -} - -unless ($secret) -{ - print - "Status: 495 Unknown System\nContent-Type: text/plain\n\n", - "System $animal is unknown\n"; - $db->disconnect; - exit; - -} - - - - -my $calc_sig = sha1_hex($content,$secret); -my $calc_sig2 = sha1_hex($extra_content,$content,$secret); - -if ($calc_sig ne $sig && $calc_sig2 ne $sig) -{ - - print "Status: 450 sig mismatch\nContent-Type: text/plain\n\n"; - print "$sig mismatches $calc_sig($calc_sig2) on content:\n$content"; - $db->disconnect; - exit; -} - -# undo escape-proofing of base64 data and decode it -map {tr/$@/+=/; $_ = decode_base64($_); } - ($log, $conf,$changed_this_run,$changed_since_success,$log_archive, $frozen_sconf); - -if ($log =~/Last file mtime in snapshot: (.*)/) -{ - my $snaptime = parsedate($1); - my $brch = $branch eq 'HEAD' ? 'master' : $branch; - my $last_branch_time = time - (30 * 86400); - $last_branch_time = `TZ=UTC GIT_DIR=$local_git_clone git log -1 --pretty=format:\%ct $brch`; - if ($snaptime < ($last_branch_time - 86400)) - { - print "Status: 493 snapshot too old: $1\nContent-Type: text/plain\n\n"; - print "snapshot to old: $1\n"; - $db->disconnect; - exit; - } -} - -($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($ts); -$year += 1900; $mon +=1; -my $dbdate= - sprintf("%d-%.2d-%.2d %.2d:%.2d:%.2d",$year,$mon,$mday,$hour,$min,$sec); - -my $log_file_names; -my @log_file_names; -my $dirname = "$buildlogs/tmp.$$.unpacklogs"; - -my $githeadref; - -if ($log_archive) -{ - my $log_handle; - my $archname = "$buildlogs/tmp.$$.tgz"; - open($log_handle,">$archname"); - binmode $log_handle; - print $log_handle $log_archive; - close $log_handle; - mkdir $dirname; - @log_file_names = `tar -z -C $dirname -xvf $archname 2>/dev/null`; - map {s/\s+//g; } @log_file_names; - my @qnames = grep { $_ ne 'githead.log' } @log_file_names; - map { $_ = qq("$_"); } @qnames; - $log_file_names = '{' . join(',',@qnames) . '}'; - if (-e "$dirname/githead.log" ) - { - open(my $githead,"$dirname/githead.log"); - $githeadref = <$githead>; - chomp $githeadref; - close $githead; - } - # unlink $archname; -} - -my $config_flags; -my $client_conf; -if ($frozen_sconf) -{ - $client_conf = thaw $frozen_sconf; -} - -if ($min_script_version) -{ - $client_conf->{script_version} ||= '0.0'; - my $cli_ver = $client_conf->{script_version} ; - $cli_ver =~ s/^REL_//; - my ($minmajor,$minminor) = split(/\./,$min_script_version); - my ($smajor,$sminor) = split(/\./,$cli_ver); - if ($minmajor > $smajor || ($minmajor == $smajor && $minminor > $sminor)) - { - print "Status: 460 script version too low\nContent-Type: text/plain\n\n"; - print - "Script version is below minimum required\n", - "Reported version: $client_conf->{script_version},", - "Minumum version required: $min_script_version\n"; - $db->disconnect; - exit; - } -} - -if ($min_web_script_version) -{ - $client_conf->{web_script_version} ||= '0.0'; - my $cli_ver = $client_conf->{web_script_version} ; - $cli_ver =~ s/^REL_//; - my ($minmajor,$minminor) = split(/\./,$min_web_script_version); - my ($smajor,$sminor) = split(/\./,$cli_ver); - if ($minmajor > $smajor || ($minmajor == $smajor && $minminor > $sminor)) - { - print "Status: 461 web script version too low\nContent-Type: text/plain\n\n"; - print - "Web Script version is below minimum required\n", - "Reported version: $client_conf->{web_script_version}, ", - "Minumum version required: $min_web_script_version\n" - ; - $db->disconnect; - exit; - } -} - -my @config_flags; -if (not exists $client_conf->{config_opts} ) -{ - @config_flags = (); -} -elsif (ref $client_conf->{config_opts} eq 'HASH') -{ - # leave out keys with false values - @config_flags = grep { $client_conf->{config_opts}->{$_} } - keys %{$client_conf->{config_opts}}; -} -elsif (ref $client_conf->{config_opts} eq 'ARRAY' ) -{ - @config_flags = @{$client_conf->{config_opts}}; -} - -if (@config_flags) -{ - @config_flags = grep {! m/=/ } @config_flags; - map {s/\s+//g; $_=qq("$_"); } @config_flags; - push @config_flags,'git' if $client_conf->{scm} eq 'git'; - $config_flags = '{' . join(',',@config_flags) . '}' ; -} - -my $scm = $client_conf->{scm} || 'cvs'; -my $scmurl = $client_conf->{scm_url}; - -my $logst = <begin_work; -$db->do("select set_local_error_terse()"); - - -$sth=$db->prepare($logst); - -$sth->bind_param(1,$animal); -$sth->bind_param(2,$dbdate); -$sth->bind_param(3,$res & 0x8fffffff); # in case we get a 64 bit int status! -$sth->bind_param(4,$stage); -$sth->bind_param(5,$log); -$sth->bind_param(6,$conf); -$sth->bind_param(7,$branch); -$sth->bind_param(8,$changed_this_run); -$sth->bind_param(9,$changed_since_success); -$sth->bind_param(10,$log_file_names); -#$sth->bind_param(11,$log_archive,{ pg_type => DBD::Pg::PG_BYTEA }); -$sth->bind_param(11,undef,{ pg_type => DBD::Pg::PG_BYTEA }); -$sth->bind_param(12,$config_flags); -$sth->bind_param(13,$scm); -$sth->bind_param(14,$scmurl); -$sth->bind_param(15,$githeadref); -$sth->bind_param(16,$frozen_sconf,{ pg_type => DBD::Pg::PG_BYTEA }); - -$sqlres = $sth->execute; - -if ($sqlres) -{ - - $sth->finish; - - my $logst2 = q{ - - insert into build_status_log - (sysname, snapshot, branch, log_stage, log_text, stage_duration) - values (?, ?, ?, ?, ?, ?) - - }; - - $sth = $db->prepare($logst2); - - $/=undef; - - my $stage_start = $ts; - - foreach my $log_file( @log_file_names ) - { - next if $log_file =~ /^githead/; - my $handle; - open($handle,"$dirname/$log_file"); - my $mtime = (stat $handle)[9]; - my $stage_interval = $mtime - $stage_start; - $stage_start = $mtime; - my $ltext = <$handle>; - close($handle); - $ltext =~ s/\x00/\\0/g; - $sqlres = $sth->execute($animal,$dbdate,$branch,$log_file,$ltext, - "$stage_interval seconds"); - last unless $sqlres; - } - - $sth->finish unless $sqlres; - -} - -if (! $sqlres) -{ - - print "Status: 462 database failure\nContent-Type: text/plain\n\n"; - print "Your report generated a database failure:\n", - $db->errstr, - "\n"; - $db->rollback; - $db->disconnect; - exit; -} - - -$db->commit; - -my $prevst = <prepare($prevst); -$sth->execute($animal,$branch,$dbdate); -my $row=$sth->fetchrow_arrayref; -my $prev_stat=$row->[0]; -$sth->finish; - -my $det_st = <prepare($det_st); -$sth->execute($animal); -$row=$sth->fetchrow_arrayref; -my ($os, $compiler,$arch) = @$row; -$sth->finish; - -$db->begin_work; -# prevent occasional duplication by forcing serialization of this operation -$db->do("lock table dashboard_mat in share row exclusive mode"); -$db->do("delete from dashboard_mat"); -$db->do("insert into dashboard_mat select * from dashboard_mat_data"); -$db->commit; - -if ($stage ne 'OK') -{ - $db->begin_work; - # prevent occasional duplication by forcing serialization of this operation - $db->do("lock table nrecent_failures in share row exclusive mode"); - $db->do("delete from nrecent_failures"); - $db->do("insert into nrecent_failures select bs.sysname, bs.snapshot, bs.branch from build_status bs where bs.stage <> 'OK' and bs.snapshot > now() - interval '90 days'"); - $db->commit; -} - -$db->disconnect; - -print "Content-Type: text/plain\n\n"; -print "request was on:\n"; -print "res=$res&stage=$stage&animal=$animal&ts=$ts"; - -my $client_events = $client_conf->{mail_events}; - -if ($ENV{BF_DEBUG}) -{ - my $client_time = $client_conf->{current_ts}; - open(TX,">>$buildlogs/$animal.$date"); - print TX "\n",Dumper(\$client_conf),"\n"; - print TX "server time: $server_time, client time: $client_time\n" if $client_time; - close(TX); -} - -my $bcc_stat = []; -my $bcc_chg=[]; -if (ref $client_events) -{ - my $cbcc = $client_events->{all}; - if (ref $cbcc) - { - push @$bcc_stat, @$cbcc; - } - elsif (defined $cbcc) - { - push @$bcc_stat, $cbcc; - } - if ($stage ne 'OK') - { - $cbcc = $client_events->{all}; - if (ref $cbcc) - { - push @$bcc_stat, @$cbcc; - } - elsif (defined $cbcc) - { - push @$bcc_stat, $cbcc; - } - } - $cbcc = $client_events->{change}; - if (ref $cbcc) - { - push @$bcc_chg, @$cbcc; - } - elsif (defined $cbcc) - { - push @$bcc_chg, $cbcc; - } - if ($stage eq 'OK' || $prev_stat eq 'OK') - { - $cbcc = $client_events->{green}; - if (ref $cbcc) - { - push @$bcc_chg, @$cbcc; - } - elsif (defined $cbcc) - { - push @$bcc_chg, $cbcc; - } - } -} - - -my $url = $query->url(-base => 1); - - -my $stat_type = $stage eq 'OK' ? 'Status' : 'Failed at Stage'; - -my $mailto = [@$all_stat]; -push(@$mailto,@$fail_stat) if $stage ne 'OK'; - -my $me = `id -un`; chomp($me); - -my $host = `hostname`; chomp ($host); -$host = $default_host unless ($host =~ m/[.]/ || !defined($default_host)); - -my $from_addr = "PG Build Farm <$me\@$host>"; -$from_addr =~ tr /\r\n//d; - -my $msg = new Mail::Send; - - -$msg->to(@$mailto); -$msg->bcc(@$bcc_stat) if (@$bcc_stat); -$msg->subject("PGBuildfarm member $animal Branch $branch $stat_type $stage"); -$msg->set('From',$from_addr); -my $fh = $msg->open; -print $fh <close; - -exit if ($stage eq $prev_stat); - -$mailto = [@$change_stat]; -push(@$mailto,@$green_stat) if ($stage eq 'OK' || $prev_stat eq 'OK'); - -$msg = new Mail::Send; - - -$msg->to(@$mailto); -$msg->bcc(@$bcc_chg) if (@$bcc_chg); - -$stat_type = $prev_stat ne 'OK' ? "changed from $prev_stat failure to $stage" : - "changed from OK to $stage"; -$stat_type = "New member: $stage" if $prev_stat eq 'NEW'; -$stat_type .= " failure" if $stage ne 'OK'; - -$msg->subject("PGBuildfarm member $animal Branch $branch Status $stat_type"); -$msg->set('From',$from_addr); -$fh = $msg->open; -print $fh <close; diff --git a/cgi-bin/register.pl b/cgi-bin/register.pl index cf69bbf..ada9a8c 100755 --- a/cgi-bin/register.pl +++ b/cgi-bin/register.pl @@ -148,7 +148,7 @@ my $me = `id -un`; chomp($me); my $host = `hostname`; chomp ($host); $host = $default_host unless ($host =~ m/[.]/ || !defined($default_host)); -my $from_addr = "PG Build Farm <$me\@$host>"; +my $from_addr = "Exim Build Farm <$me\@$host>"; $from_addr =~ tr /\r\n//d; $msg->set('From',$from_addr); diff --git a/cgi-bin/show_status.pl b/cgi-bin/show_status.pl index c75b20e..187925f 100755 --- a/cgi-bin/show_status.pl +++ b/cgi-bin/show_status.pl @@ -22,7 +22,7 @@ my $query = new CGI; my @members = $query->param('member'); map { s/[^a-zA-Z0-9_ -]//g; } @members; -my $dsn="dbi:Pg:dbname=$dbname"; +my $dsn="dbi:mysql:dbname=$dbname"; $dsn .= ";host=$dbhost" if $dbhost; $dsn .= ";port=$dbport" if $dbport; diff --git a/cgi-bin/show_status_soap.pl b/cgi-bin/show_status_soap.pl index de314f7..e44f8d1 100755 --- a/cgi-bin/show_status_soap.pl +++ b/cgi-bin/show_status_soap.pl @@ -16,11 +16,11 @@ require "$ENV{BFConfDir}/BuildFarmWeb.pl"; use SOAP::Transport::HTTP; -SOAP::Transport::HTTP::CGI->dispatch_to('PGBuildFarm')->handle; +SOAP::Transport::HTTP::CGI->dispatch_to('EximBuildFarm')->handle; exit; -package PGBuildFarm; +package EximBuildFarm; use DBI; diff --git a/htdocs/branches_of_interest.txt b/htdocs/branches_of_interest.txt index 3a1c125..ffea877 100644 --- a/htdocs/branches_of_interest.txt +++ b/htdocs/branches_of_interest.txt @@ -1,6 +1 @@ -REL8_4_STABLE -REL9_0_STABLE -REL9_1_STABLE -REL9_2_STABLE -REL9_3_STABLE HEAD diff --git a/htdocs/index.html b/htdocs/index.html index 01157c1..6601849 100644 --- a/htdocs/index.html +++ b/htdocs/index.html @@ -3,7 +3,7 @@ - PostgreSQL BuildFarm + Exim BuildFarm