1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
#!/usr/bin/perl -w
use strict;
use JSON::XS;
use Getopt::Std;
use Pod::Usage qw( pod2usage );
use Time::Piece;
my %opts;
getopts('d:aA:nbhmI', \%opts) || pod2usage(2);
my $showall = exists $opts{a};
my $arch = $opts{A} || 'amd64';
my $dist = $opts{d} || 'unstable';
my $showbugs = exists $opts{b};
my $showid = exists $opts{I};
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;
use Debian::PkgPerl::Util;
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 $packagesfile = Debian::PkgPerl::Util->download_and_cache_file(
"https://ci.debian.net/data/status/$dist/$arch/packages.json",
"ci.debian.net-packages-$dist-$arch.json",
6 * 60 * 60
);
open(my $fh, '<', $packagesfile) or die("open $packagesfile: $!");
local $/;
for my $j (sort {$a->{package} cmp $b->{package}} @{decode_json(<$fh>)}) {
my $p = $j->{package};
if ($j->{status} eq "fail") {
next if $p !~ /perl/ and !$showall;
# "trigger": null (aka newly uploaded package?) or "trigger": "migration-reference%2F0"
next unless !defined($j->{trigger}) or $j->{trigger} =~ m/migration-reference/;
my @slist = $srccache->find($p) or warn("$p not found in $dist/$arch sources\n"), next;
my $s = src_latest(@slist);
next if $s->{Maintainer} !~ /pkg-perl/ and $p ne 'perl';
if (!$showall) {
next if !$j->{version} || $s->{Version} ne $j->{version};
}
# weed out reports older than 30 days (removed packages)
if ( $j->{date} ) {
# 2024-10-14T07:19:25.000Z
( my $reportdate = $j->{date} ) =~ s/^(.+)\.\w+$/$1/;
$reportdate = Time::Piece->strptime( $reportdate, '%Y-%m-%dT%H:%M:%S' );
my $now = gmtime;
my $diff = $now - $reportdate;
next if $diff->days > 30;
}
my $prefix = substr($p, 0, ($p =~ /^lib/ ? 4 : 1));
my @rcbugs = map {"https://bugs.debian.org/$_"} src_rcbugs($p) if $showbugs;
my $run_id = $j->{run_id};
my $previous_status = $j->{previous_status};
printf "%s_%s %s %s %s %s\n", $p, $j->{version},
"https://ci.debian.net/packages/$prefix/$p/$dist/${arch}/",
($showid ? $run_id : ''),
(@rcbugs ? colored('RC: ', 'magenta') . join(" ", @rcbugs) : ''),
($previous_status && $previous_status ne "fail" ? colored("# NEW", 'red') : '');
}
}
close $fh;
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('https://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 { $a <=> $b } 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<[-anbhmI]>
=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<-I>
Additionally show the run id for the last run (suitable for retrying a test
via the ci.debian.net API.)
=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/pkg-perl-tools> or F<$HOME/.cache/pkg-perl-tools>.
=head1 COPYRIGHT AND LICENSE
Copyright 2017-2018, Niko Tyni <ntyni@debian.org>
2017-2024, gregor herrmann <gregoa@debian.org>
This program is free software. You may distribute it under the same
terms as Perl.
|
