[Collab-qa-commits] r827 - / qabuildstat qabuildstat/buildagent
goneri at alioth.debian.org
goneri at alioth.debian.org
Sun Apr 27 19:05:09 UTC 2008
Author: goneri
Date: 2008-04-27 19:05:08 +0000 (Sun, 27 Apr 2008)
New Revision: 827
Added:
qabuildstat/
qabuildstat/buildagent/
qabuildstat/buildagent/qabuild-buildagent
qabuildstat/buildagent/qabuild-buildagent.ini
Log:
/home/goneri/svn_svnbuildstat/trunk/script/svnbuildstat_agent.pl
Copied: qabuildstat/buildagent/qabuild-buildagent (from rev 826, svnbuildstat/trunk/script/svnbuildstat_agent.pl)
===================================================================
--- qabuildstat/buildagent/qabuild-buildagent (rev 0)
+++ qabuildstat/buildagent/qabuild-buildagent 2008-04-27 19:05:08 UTC (rev 827)
@@ -0,0 +1,442 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Data::Dumper;
+use File::Glob ':glob';
+use Sys::Hostname;
+use LWP::Simple;
+use POSIX ":sys_wait_h";
+use File::Basename;
+use File::stat;
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use HTTP::Response;
+use Proc::ProcessTable;
+use Config::IniFiles;
+
+###########################################################################
+###########################################################################
+###########################################################################
+
+my $RELEASE = "0.0.1";
+my $hostname = hostname();
+my $distro = "sid";
+chomp (my $arch = `dpkg-architecture -qDEB_HOST_ARCH`);
+
+my %job;
+
+die "You must be root!" unless $< == 0;
+
+my $inifile = "/etc/qabuild-agent.ini";
+my $cfg= Config::IniFiles->new( -file => $inifile ) or die "Can't load $inifile";
+my $debmirror = $cfg->val('path', 'debmirror');
+my $server = $cfg->val('path', 'server');
+my $vardir = $cfg->val('path', 'vardir');
+my $adminname = $cfg->val('admin', 'name');
+my $adminemail = $cfg->val('admin', 'email');
+my $adminteam = $cfg->val('admin', 'team');
+
+
+if (!$debmirror) {
+ die "Can't find the debmirror in $inifile";
+}
+if (!$server) {
+ die "Can't find the server in $inifile";
+}
+if (!$vardir || !-d $vardir) {
+ die "Can't find the vardir directory in $inifile";
+}
+
+my $maxjob = 1;
+my $workplace = $vardir."/workplace";
+my $pbuilderplace = $vardir."/pbuilder";
+my $buildarea = $vardir."/report";
+my $tmpdir = $vardir."/tmp";
+my $aptcachedir = $vardir."/aptcache";
+my $pbuildertgz = "$pbuilderplace/$distro.tar.gz";
+my $sigTermCatched = 0;
+my $exit = 0;
+sub sigterm {print "SIGTERM!\n";$sigTermCatched=1};
+$SIG{INT}= 'sigterm';
+
+my $keeptmpdir;
+die unless $maxjob =~ /^\d+$/;
+
+$ENV{LC_ALL} = 'C';
+$ENV{LANG} = 'C';
+
+# From Proc::Killall TODO package this
+#Copyright (c) 1998-2006 Daniel J. Urist. All rights reserved.
+#This package is free software; you can redistribute it and/or modify
+#it under the same terms as Perl itself.
+sub get_pids {
+
+ my($procs, @kids) = @_;
+
+ my @pids;
+ foreach my $kid (@kids) {
+ foreach my $proc (@$procs) {
+ if ($proc->ppid == $kid) {
+ my $pid = $proc->pid;
+ push @pids, $pid, get_pids $procs, $pid;
+ }
+ }
+ }
+ @pids;
+
+}
+
+sub killfam {
+
+ my($signal, @pids) = @_;
+
+ my $pt = Proc::ProcessTable->new;
+ my(@procs) = @{$pt->table};
+ my(@kids) = get_pids \@procs, @pids;
+ @pids = (@pids, @kids);
+ print "pid to kill: ";
+ print $_." " foreach (@pids);
+ print "\n";
+ kill $signal, @pids;
+
+} # end killfam
+
+
+sub purge {
+ print "What a nice day for a purge!\n";
+ die "please create: `".$vardir unless -d $vardir;
+# TODO check for running script in background
+# Purge
+ foreach ($workplace, $buildarea, $tmpdir) {
+ if (-d $workplace) {
+ `rm -r $workplace`;
+ }
+ }
+
+ foreach (`mount`) {
+ if (/^\/\S+\son\s(\S+)/) {
+ my $mountPoint = $1;
+ if ($mountPoint =~ /^$pbuilderplace/) {
+ print "umounting $mountPoint\n";
+ system("umount $mountPoint");
+ }
+ }
+ }
+ # !!! Maybe danger if $pbuilderplace is unset
+ # so I do another check here!
+ die "DANGER: pbuilderplace not correct!" unless $pbuilderplace =~ /\/./;
+
+ foreach (bsd_glob($pbuilderplace.'/*')) {
+ next if /tar.gz$/; # pbuilder tarball
+ system ("rm -r $_");
+ }
+
+# (Re)Create the directorys
+ foreach ($workplace, $buildarea, $pbuilderplace, $tmpdir, $aptcachedir) {
+ if (!-d && !mkdir $_) {
+ die "Failed to create $_\n";
+ }
+ }
+}
+
+sub debcachePurge {
+
+ `rm -f $aptcachedir/*` unless $keeptmpdir;
+
+}
+
+sub checkSanity {
+
+ if (isDiskFull($aptcachedir)) {
+ debcachePurge();
+ }
+
+ if (isMemFull()||isDiskFull($workplace)||isDiskFull($buildarea)||isDiskFull('/tmp')) {
+ print "checkSanity(): disk or memory full!!!\n";
+ purge();
+ }
+
+ $exit = 1 if $sigTermCatched;
+ if ($exit||isMemFull()||isDiskFull($workplace)||isDiskFull($buildarea)||isDiskFull('/tmp')) {
+ if (%job&&(isDiskFull($workplace)||isDiskFull($buildarea))) {
+ print "Emergency clean up\n";
+ killfam (15, keys %job);
+
+ foreach (1..10) {
+ sleep (1);
+ print ".";
+ }
+ print "\n";
+
+ killfam (9, keys %job);
+
+ foreach (keys %job) {
+ waitpid($_, WNOHANG);
+ delete ($job{$_});
+ }
+
+ purge() unless $keeptmpdir;
+ }
+ }
+}
+
+sub postFile {
+ my $file = shift;
+
+ my $ua = new LWP::UserAgent;
+
+
+ my $response = $ua->request(POST $server.'/controls/buildInput',
+ Content_Type => 'form-data',
+ Content => ['file' => [ $file, basename($file) ]]) or die "Upload failed\n";
+
+ if ($response->is_error) {
+ print "Failed to post file: ".$response->as_string()."\n";
+ }
+
+}
+
+sub isDiskFull {
+ my $path = shift;
+
+ my $free = 0;
+# /dev/hda2 7210656 5721668 1122708 84% /
+ foreach (`df -P $path`) {
+ if (/^\S+\s+\d+\s+\d+\s+(\d+)\s+\S+/) {
+ $free = $1;
+ }
+ }
+
+ $free < 300000;
+}
+
+sub isMemFull {
+
+ if (!open MEMINFO, "</proc/meminfo") {
+ warn "Can't open meminfo";
+ return;
+ }
+
+ my $free = 0;
+ foreach (<MEMINFO>) {
+ $free += $2 if /^(MemFree|SwapFree):\s+(\d+)\s+kB/;
+ }
+ # IMO, 50MB is not enough to continue a build
+ $free < 50000;
+}
+
+sub getBuildJob {
+ my $p;
+ my $report = {};
+
+ my $ua = LWP::UserAgent->new();
+ my $req = POST $server."/controls/getBuildJob", Content_Type => 'form-data',
+ Content => [
+ submit => 1,
+ content => "arch=$arch\n",
+ ];
+ my $response = $ua->request($req);
+ return unless $response->is_success();
+
+ foreach (split $/, $response->content) {
+ chomp;
+
+ $report->{$1} = $2 if (/(.*)=(.*)/);
+ }
+
+ return unless $report->{dsc};
+ return unless $report->{id};
+ $report;
+}
+
+sub upgradeChroot {
+ my $retry = shift;
+ $retry = 1 unless $retry;
+
+ my $pdebuildparam = "--debootstrap debootstrap --mirror ".$debmirror." --buildplace $pbuilderplace --othermirror 'deb ".$debmirror." $distro main contrib non-free' --distribution $distro --basetgz $pbuildertgz --debootstrap debootstrap";
+ if (-s $pbuildertgz) {
+ my $sb = stat($pbuildertgz);
+ if (time - $sb->ctime > 3600 * 24) {
+ # I recreate the chroot every day
+ `mv $pbuildertgz $pbuildertgz.save`;
+ }
+ }
+
+ if (! -s $pbuildertgz) {
+ # TODO redirect the log on another place
+ `/usr/sbin/pbuilder create $pdebuildparam >/tmp/pbuilder-create.log 1>&2`;
+ if (($? >> 8)!=0) {
+ print "Failed to create pbuilder image\n";
+ if (-f "$pbuildertgz.save") {
+ # I restore the previous chroot
+ `cp $pbuildertgz.save $pbuildertgz`;
+ `/usr/sbin/pbuilder update $pdebuildparam >/tmp/pbuilder-create.log 1>&2`;
+ }
+ } else {
+ # I save the created chroot
+ `cp $pbuildertgz $pbuildertgz.save`;
+ }
+ }
+
+ if (! -s $pbuildertgz) {
+ my $timer = 10*$retry;
+ $timer = 180 if $timer > 180;
+ print "Failed to create a pbuilder tarball, will sleep for $timer minutes and retry ...\n";
+ sleep ($timer*60);
+ upgradeChroot($retry+1);
+ }
+}
+
+
+sub sendReport {
+
+ my ($report, $threadbuildarea) = @_;
+
+ print "sending result that are in $threadbuildarea\n";
+
+ $report->{'arch'} = $arch;
+ $report->{hostname} = $hostname;
+ $report->{distro} = $distro;
+ $report->{adminname} = $adminname;
+ $report->{adminemail} = $adminemail;
+ $report->{adminteam} = $adminteam;
+
+ $report->{'agent_release'} = $RELEASE;
+ $report->{'pbuilder_release'} = `dpkg-query -W -f='\${Version}' pbuilder`;
+
+ my $tmp = basename($report->{dsc});
+ $tmp =~ s/\.dsc//;
+ my $prefix = $tmp."_".$arch."_$hostname";
+ my $logfile = $prefix.'.log';
+ my $infofile = $prefix.'.info';
+
+ open (BUILDLOGTMP, "<","$threadbuildarea/build.log.tmp") or die;
+ seek(BUILDLOGTMP, -1000000, 2); # I just keep the end of the logfile
+ open (BUILDLOG, ">", "$threadbuildarea/".$logfile) or die;
+ # If I'm not at the end of BUILDLOGTMP it means that seek moved me
+ print BUILDLOG "(log file truncated) ... " if tell(BUILDLOGTMP);
+
+ foreach (<BUILDLOGTMP>) {
+ # To avoid strange breakage I do some clean up in the log file
+ s/[[:cntrl:]]//g;
+ print BUILDLOG $_."\n";
+ }
+ close BUILDLOGTMP;
+ close BUILDLOG;
+ unlink "$threadbuildarea/build.log.tmp";
+
+
+ postFile($threadbuildarea."/".$logfile);
+ $report->{logfile} = $logfile;
+ if (bsd_glob($threadbuildarea.'/*.changes')) {
+ print "build is ok\n";
+ $report->{build} = "ok";
+ $report->{files} = '';
+ foreach (bsd_glob($threadbuildarea.'/*')) {
+ next if /orig\.tar\.gz$/; # deb & udeb
+ $report->{files} = $report->{files}.basename($_).' ';
+ postFile($_);
+ }
+ } else {
+ print "build is nok\n";
+ $report->{build} = "nok";
+ }
+
+
+ open (BUILDREPORT,">",$threadbuildarea."/".$infofile) or die "Can't open infofile";
+ foreach (sort keys %$report) {
+ chomp $report->{$_};
+ print BUILDREPORT $_."=".$report->{$_}."\n";
+ }
+# print BUILDREPORT "-END-\n";
+ close BUILDREPORT;
+ postFile ($threadbuildarea."/".$infofile);
+
+}
+
+
+sub build {
+ my $report = shift;
+
+ return unless $report;
+ die unless -d $workplace;
+ die unless -d $buildarea;
+ die unless -d $tmpdir;
+
+ my $threadworkplace = $workplace .'/'. $$;
+ my $threadbuildarea = $buildarea .'/'. $$;
+
+ die if (!-d $threadworkplace && !mkdir $threadworkplace);
+ die if (!-d $threadbuildarea && !mkdir $threadbuildarea);
+
+###########################################################################
+###########################################################################
+###########################################################################
+
+ print "dsc: ".$report->{dsc}."\n";
+
+ my $tarballdir;
+ # The archive are not signed for the moment
+ my $cmd = "cd $threadworkplace; dget -qxu ".$report->{dsc};
+ foreach (`$cmd`) {
+ $tarballdir = $1 if /dpkg-source:\sextracting\s\S+\sin\s(\S+)/;
+ }
+ print "tarballdir: $threadworkplace; $tarballdir\n";
+ if (!$tarballdir) {
+ system("rm -r $threadworkplace $threadbuildarea") unless $keeptmpdir;
+ return;
+ }
+
+ $report->{'stamp_build-start'} = time;
+ my $dsc_localpath = $threadworkplace.'/'.basename($report->{dsc});
+
+ `cd $threadworkplace/$tarballdir; pbuilder --build --buildresult $threadbuildarea --buildplace $pbuilderplace --aptcache $aptcachedir --distribution $distro --basetgz $pbuilderplace/$distro.tar.gz --timeout 10h $dsc_localpath >$threadbuildarea/build.log.tmp 2>&1`;
+ $report->{'stamp_build-end'} = time;
+
+ sendReport($report, $threadbuildarea);
+
+ `rm -rf $threadworkplace $threadbuildarea` unless $keeptmpdir;
+
+ 1;
+}
+
+##################################################################
+##################################################################
+##################################################################
+###### Main
+purge();
+
+while (sleep 1) {
+
+ checkSanity();
+ exit(1) if $exit;
+ upgradeChroot();
+
+# Check the running jobs (See #453710)
+ foreach my $pid (keys %job) {
+ waitpid($pid, WNOHANG);
+ if (! -d "/proc/".$pid) {
+ print "$pid is finish\n";
+ `rm -rf $workplace/$pid $buildarea/$pid` unless $keeptmpdir;
+ delete ($job{$pid});
+ }
+ }
+
+ if (keys %job < $maxjob) {
+ my $newpid = fork;
+ if ($newpid) { # Father
+ $job{$newpid} = time;
+ } else { # Son
+ my $report = getBuildJob ();
+ print $report->{dsc}."\n";
+ if (!exists($report->{dsc})) {
+ print "Can't get a package to build from $server\n";
+ } else {
+ build($report);
+ print "done\n";
+ }
+ exit;
+ }
+ }
+}
Added: qabuildstat/buildagent/qabuild-buildagent.ini
===================================================================
--- qabuildstat/buildagent/qabuild-buildagent.ini (rev 0)
+++ qabuildstat/buildagent/qabuild-buildagent.ini 2008-04-27 19:05:08 UTC (rev 827)
@@ -0,0 +1,12 @@
+[admin]
+name=
+email=
+team=
+
+[settings]
+maxjob=2
+
+[path]
+server=http://88.191.78.230:3000
+debmirror=http://ftp.fr.debian.org/debian/
+vardir=/home/goneri/svnbuildstat
More information about the Collab-qa-commits
mailing list