Commit a29e63af authored by gregor herrmann's avatar gregor herrmann

New dpt subcommand: dpt-ci-failures.

Script to query ci.debian.net for autopkgtest failures.
parent b561a4e9
......@@ -90,6 +90,10 @@ See L<dpt-salsa(1)>.
See L<dpt-cd(1)>
=item B<ci-failures> - query ci.debian.net for autopkgtest failures
See L<dpt-ci-failures(1)>.
=item B<checkout> - work on pkg-perl package
=item (also available as B<co>)
......
......@@ -171,6 +171,11 @@ Files: scripts/salsa
Copyright: 2018, gregor herrmann <gregoa@debian.org>
License: Artistic or GPL-1+
Files: scripts/ci-failures
Copyright: 2017-2018, Niko Tyni <ntyni@debian.org>
2017-2018, gregor herrmann <gregoa@debian.org>
License: Artistic or GPL-1+
Files: lib/*
Copyright: 2016, Alex Muntada <alexm@alexm.org>
License: Artistic or GPL-1+
......
#!/usr/bin/perl -w
use strict;
use JSON::XS;
use Getopt::Std;
use Pod::Usage qw( pod2usage );
my %opts;
getopts('d:aA:nbhm', \%opts) || pod2usage(2);
my $showall = exists $opts{a};
my $arch = $opts{A} || 'amd64';
my $dist = $opts{d} || 'unstable';
my $keepcache = exists $opts{n};
my $showbugs = exists $opts{b};
pod2usage(1) if $opts{h};
pod2usage(-exitval => 0, -verbose => 2) if $opts{m};
use AptPkg::Config '$_config';
use AptPkg::System '$_system';
use AptPkg::Source;
use SOAP::Lite;
use Term::ANSIColor;
use File::Spec;
my $srccache;
my $versioning;
# initialise the global config object with the default values and
# setup the $_system object
$_config->init;
$_system = $_config->system;
$versioning = $_system->versioning;
# suppress cache building messages
$_config->{quiet} = 2;
# set up the cache
$srccache = AptPkg::Source->new;
my $cachedir = $ENV{XDG_CACHE_HOME} || $ENV{HOME} . '/.cache';
my $packagesfile = File::Spec->catfile($cachedir, "ci.debian.net-packages-$dist-$arch.json");
unlink $packagesfile unless $keepcache;
system("wget https://ci.debian.net/data/status/$dist/${arch}/packages.json -O $packagesfile")
if ! -f $packagesfile;
open(IN, "<$packagesfile") or die("open $packagesfile: $!");
local $/;
for my $j (@{decode_json(<IN>)}) {
my $p = $j->{package};
if ($j->{status} eq "fail") {
next if $p !~ /perl/ and !$showall;
my @slist = $srccache->find($p) or warn("can't find $p in apt source cache"), next;
my $s = src_latest(@slist);
next if $s->{Maintainer} !~ /pkg-perl/;
if (!$showall) {
next if $s->{Version} ne $j->{version};
}
my $prefix = substr($p, 0, ($p =~ /^lib/ ? 4 : 1));
my @rcbugs = map {"https://bugs.debian.org/$_"} src_rcbugs($p) if $showbugs;
printf "%s_%s %s %s %s\n", $p, $j->{version},
"http://ci.debian.net/packages/$prefix/$p/$dist/${arch}/",
(@rcbugs ? colored('RC: ', 'magenta') . join(" ", @rcbugs) : ""),
($j->{previous_status} eq "fail" ? "" : colored("# NEW", 'red'));
}
}
close IN;
sub src_latest {
return (sort src_byversion @_)[-1];
}
sub src_byversion {
return $versioning->compare($a->{Version}, $b->{Version});
}
sub src_rcbugs {
my $pkg = shift;
my $soap = SOAP::Lite->uri('Debbugs/SOAP')
->proxy('http://bugs.debian.org/cgi-bin/soap.cgi');
my $bugs
= $soap->get_status( $soap->get_bugs( src => $pkg )->result() )->result;
return unless $bugs;
my @rcbugs;
foreach my $b ( sort keys %$bugs ) {
next unless my $status = $bugs->{$b};
next
if $status->{done}
or $status->{archived}
or ( grep { !/(serious|grave|critical)/ } $status->{severity} );
push @rcbugs, $status->{bug_num};
}
return @rcbugs;
}
=head1 NAME
dpt-ci-failures - query ci.debian.net for autopkgtest failures
=head1 SYNOPSIS
B<dpt ci-failures> I<[-d E<lt>distributionE<gt>]> I<[-A E<lt>architectureE<gt>]> I<[-anbhm]>
=head1 OPTIONS
=over
=item B<-d E<lt>distributionE<gt>>
Defaults to I<unstable>.
=item B<-A E<lt>architectureE<gt>>
Defaults to I<amd64>.
=item B<-a>
Show more ("all") results (slow). By default only packages matching /perl/
and the latest versions are shown.
=item B<-b>
Additionally show RC bugs for the found packages.
=item B<-n>
Keep old cache file instead of downloading the current file from ci.debian.net.
=item B<-h>
Show this help.
=item B<-m>
Show full manpage.
=back
=head1 CONFIGURATION
None.
=head1 FILES
A file called F<ci.debian.net-packages-$dist-$arch.json> is stored in
F<$XDG_CACHE_HOME> or F<$HOME/.cache>.
=head1 COPYRIGHT AND LICENSE
Copyright 2017-2018, Niko Tyni <ntyni@debian.org>
2017-2018, gregor herrmann <gregoa@debian.org>
This program is free software. You may distribute it under the same
terms as Perl.
......@@ -40,6 +40,7 @@ Muntada
Niebur
OAuth
Paleino
RC
RFA
RFP
RT
......@@ -51,11 +52,15 @@ adduser
admin
admins
alioth
amd
anbhm
anonscm
autopkgtest
bts
bzip
changerepo
changeuser
ci
conf
configurerepo
createrepo
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment