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 <[EMAIL PROTECTED]>"; -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()); _______________________________________________ Collab-qa-commits mailing list [email protected] http://lists.alioth.debian.org/mailman/listinfo/collab-qa-commits
