[Collab-qa-commits] r821 - svnbuildstat/trunk/script/qajob-manager
goneri at alioth.debian.org
goneri at alioth.debian.org
Sun Apr 27 01:53:06 UTC 2008
Author: goneri
Date: 2008-04-27 01:53:05 +0000 (Sun, 27 Apr 2008)
New Revision: 821
Modified:
svnbuildstat/trunk/script/qajob-manager/qajob-manager
Log:
the qa upload works fine (hum, it seems)
Modified: svnbuildstat/trunk/script/qajob-manager/qajob-manager
===================================================================
--- svnbuildstat/trunk/script/qajob-manager/qajob-manager 2008-04-27 01:52:36 UTC (rev 820)
+++ svnbuildstat/trunk/script/qajob-manager/qajob-manager 2008-04-27 01:53:05 UTC (rev 821)
@@ -16,107 +16,184 @@
use HTTP::Request::Common;
use LWP::UserAgent;
use HTTP::Response;
+use Getopt::Long;
+use File::Temp;
my $hostname = hostname();
-my $server = "http://wawax.info:3000";
+my $server = "http://nana2:3000";
my $admin = "Gonéri Le Bouder <goneri\@rulezlan.org>";
-chomp (my $arch = `dpkg-architecture -qDEB_HOST_ARCH`);
-sub getQAJob {
- my $p;
- my $report = {};
+my $params = {
+ action => undef,
+ qatool => undef,
+ jobfile => undef,
+ logfile => undef,
+ result => undef,
+ target => undef,
+ help => undef
+};
+sub postFiles {
+ my $files = shift;
+
+ die "File not found" unless -f $files->{'jobfile'} || -f $files->{'resultfile'};
+ my $ua = new LWP::UserAgent;
+
+
+ my $job;
+ open JOBFILE, "<".$params->{'jobfile'} or die "Can't open Jobfile:".$!;
+ foreach (<JOBFILE>) {
+ chomp;
+
+ $job->{$1} = $2 if (/(.*)=(.*)/);
+ }
+ close JOBFILE;
+
+ die "Invalide jobfile" unless $job->{'cookie'};
+ my $timestamp = time."-".$job->{'cookie'};
+ # The 'files' is used by the server to find the related files
+ $job->{'resultfile'} = $timestamp.'.resultfile';
+ if ($job->{'logfile'}) {
+ $job->{'logfile'} = $timestamp.'.logfile';
+ }
+
+
+ my $jobfile_fh = new File::Temp();
+ foreach (keys %$job) {
+ print $jobfile_fh $_."=".$job->{$_}."\n";
+ }
+ close $jobfile_fh;
+ $files->{'jobfile'} = $jobfile_fh->filename;
+ print $jobfile_fh->filename."\n";
+
+
+ # Order is important here since the .jobfile is used at the
+ # server side to start the import task
+ foreach (qw/logfile resultfile jobfile/) {
+ next unless $files->{$_};
+ next unless -f $files->{$_};
+
+ print "upload $_...\n";
+ my $response = $ua->request(POST $server.'/controls/buildInput',
+ Content_Type => 'form-data',
+ Content => ['file' => [ $files->{$_}, $timestamp.'.'.$_ ]]) or die "Upload failed\n";
+
+ print "report sent: ".$response->as_string()."\n";
+ }
+
+}
+
+
+sub getJob {
+ die unless $params->{'qatool'} && $params->{'jobfile'} && $params->{'target'};
+
my $ua = LWP::UserAgent->new();
my $req = POST $server."/controls/getQAJob", Content_Type => 'form-data',
Content => [
submit => 1,
- content => "qatool=lintian\n",
+ content => "qatool=".$params->{'qatool'}."\ntarget=".$params->{'target'},
];
my $response = $ua->request($req);
- return unless $response->is_success();
+ die "Failed to contact server" unless $response->is_success();
- foreach (split $/, $response->content) {
- chomp;
-
- $report->{$1} = $2 if (/(.*)=(.*)/);
- }
- print Dumper($report);
- return unless $report->{files};
- return unless $report->{id};
- $report;
+ open JOBFILE, ">".$params->{'jobfile'} or die "Can't open ".$params->{'jobfile'}.":$!\n";
+ print JOBFILE $response->content;
+ close JOBFILE;
}
-sub sendReport {
+sub sendJob {
my ($report, $threadbuildarea) = @_;
- print "sending result that are in $threadbuildarea\n";
+ print "sending result\n";
- $report->{'arch'} = $arch;
$report->{'admin'} = $admin;
$report->{hostname} = $hostname;
- #$report->{distro} = $distro;
- #$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, -2000000, 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";
- open (BUILDLOGTMP, "<","$threadbuildarea/build.log.tmp") or die;
- seek(BUILDLOGTMP, -20000, 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);
+# postFile($threadbuildarea."/".$logfile);
+# $report->{logfile} = $logfile;
+# if (bsd_glob($threadbuildarea.'/*.changes')) {
+# print "build is ok\n";
+# $report->{build} = "ok";
+# foreach (bsd_glob($threadbuildarea.'/*.deb'), bsd_glob($threadbuildarea.'/*.udeb')) {
+# $report->{binarypackages} = 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);
- 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";
+postFiles({
-# Prepare and send the report
-# my $ftp = Net::FTP->new($ftphost, Debug => 0) or die "Cannot connect
-# to ".$ftphost.": $@";
-# $ftp->login($ftplogin,$ftppassword) or die "Cannot login ", $ftp->message;
-# $ftp->binary or die "Cannot switch to binary mode ", $ftp->message;
-# my $dir = $report->{package_id}.'-'.time;
-# $ftp->mkdir($dir); # Do not die since mkdir fails if the
- # directory exist
-# $ftp->cwd($dir) or die "Can't cwd ", $ftp->message;
+ jobfile => $params->{'jobfile'},
+ resultfile => $params->{'resultfile'},
+ logfile => $params->{'logfile'}
+
+ });
- postFile($threadbuildarea."/".$logfile);
- $report->{logfile} = $logfile;
- if (bsd_glob($threadbuildarea.'/*.changes')) {
- print "build is ok\n";
- $report->{build} = "ok";
- foreach (bsd_glob($threadbuildarea.'/*.deb'), bsd_glob($threadbuildarea.'/*.udeb')) {
- $report->{binarypackages} = basename($_).' ';
- postFile($_);
- }
- } else {
- print "build is nok\n";
- $report->{build} = "nok";
- }
+}
+sub usage {
+ print "usage:\n";
+ print "\tqajob-manager --action get --qatool QATOOL --jobfile jobfile --target (source|binary)\n";
+ print "\tqajob-manager --action send --jobfile jobfile --resultfile resultfile (--logfile logfile)\n";
+ exit (1);
+}
- 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);
+my $verbose;
+usage unless GetOptions (
+ "help" => \$params->{'help'},
+ "action=s" => \$params->{'action'},
+ "qatool=s" => \$params->{'qatool'},
+ "jobfile=s" => \$params->{'jobfile'},
+ "logfile=s" => \$params->{'logfile'},
+ "resultfile=s" => \$params->{'resultfile'},
+ "target=s" => \$params->{'target'},
+);
+
+usage () unless $params->{'action'};
+if ($params->{'action'} eq 'get') {
+ if ($params->{'qatool'} !~ /^[\w_\+-]+$/ || !$params->{'jobfile'}|| !$params->{'target'}) {
+ print "--qatool=QATOOL, --jobfile=JOBFILE and --target=TARGET are needed\n";
+ usage();
+ }
+ getJob();
+} elsif ($params->{'action'} eq 'send') {
+ if (!$params->{'jobfile'} || !$params->{'resultfile'}) {
+ print "--jobfile=JOBFILE and --resultfile=RESULTFILE are needed\n";
+ }
+ sendJob();
+} else {
+ print "action is 'get' or 'send'.\n";
+ usage();
}
-
-print Dumper (getQAJob());
More information about the Collab-qa-commits
mailing list