Contents of /bin/checklist

#!/usr/bin/perl
# Must run on a machine with madison.
# 
# To check for un-updated binary kernel packages, also needs grep-dctrl 
# and a Sources file for the distribution. Set the location of the Sources
# file in SOURCES_FILE in the environment.
use URI::Escape;
use Getopt::Long;

my $html=0;
my $debug=0;
my $suite="testing";
my $output;
if (! GetOptions(
                "html" => \$html,
                "debug" => \$debug,
                "suite=s" => \$suite,
                "output=s", \$output)
    || ! @ARGV) {
        die "usage: $0 [--suite suite] [--html] [--output=file] [--debug] advisorylist dtsalist...\n";
}

if (defined $output) {
        open (OUT, ">$output.tmp.$$") || die "output.tmp.$$: $!";
}
else {
        open (OUT, ">&STDOUT");
}

if ($html) {
        print OUT "<html><title>$suite security issues</title>\n";
        if ($suite ne 'testing' && $suite ne 'unstable') {
                print OUT <<"EOF";
<p>
<em>Warning:</em> This page is the result of running the testing security
check script against the $suite distribution. As data is only gathered for
the testing distribution, results may be innacurate if a package has
changed its name, if a vulnerability affects $suite and not testing, or if a
vulnerability has been fixed in $suite by the $suite security team.
</p>
EOF
        }
        print OUT "<ul>\n";
}


my %data;
my %needkernel=qw/2.4.27 0 2.6.11 0/;
my $list_unknown=1; #set to 1 to display kernel images with unknown source version
my $sources=$ENV{SOURCES_FILE};
my $need_rebuild=0;

my @urgencies=("high", "medium", "low", "unknown");
my %colormap=(
        high => "#FF0000",
        medium => "#FF9999",
        low => "#FFFFFF",
        unknown => "#FFFF00"
);

my $unprop = my $unprop_all = my $unfixed = my $todos = 0;

sub record {
        my ($package, $condition, $item, $urgency)=@_;
                
        if ($html) {
                $condition=~s{bug #(\d+)}{<a href="http://bugs.debian.org/$1">bug #$1</a>}g;
                $condition=~s{unfixed}{<b>unfixed</b>}g;
                $item=~s#((?:CAN|CVE)-\d+-\d+)#<a href="http://www.cve.mitre.org/cgi-bin/cvename.cgi?name=$1">$1</a>#g;
        }

        push @{$data{$package}{$condition}}, {item => $item, urgency => $urgency};
}

die ("No DTSA list specified") if (! length @ARGV[1]);
my $dtsalist = @ARGV[1];
foreach my $list (@ARGV[0]) {
        if (-d $list) {
                $list="$list/list";
        }
        
        open (IN, $list) || die "open $list: $!";
        while (<IN>) {
                print STDERR "line: $_" if $debug;
                chomp;
                if (/^\[/) {
                        ($id)=m/((?:DSA|DTSA|CAN|CVE)-[^\s]+) /;
                }
                elsif (/^((?:DSA|DTSA|CAN|CVE)-[^\s]+)/) {
                        $id=$1;
                }
                elsif (/^\s+[!-]\s+(\S+)\s+(.*?)\s*$/) {
                        my $package=$1;
                        my $rest=$2;
                        my $version;
                        my $notes;
                        if ($rest=~/([^\(\s]+)\s+\((.*)\)/) {
                                $version=$1;
                                $notes=$2;
                        }
                        elsif ($rest=~/\((.*)\)/) {
                                $version="";
                                $notes=$1;
                        }
                        else {
                                $version=$rest;
                                $notes="";
                        }
                        my @notes=split(/\s*;\s+/, $notes);

                        my $urgency="unknown";
                        foreach my $u (@urgencies) {
                                if (grep { $_ eq $u } @notes) {
                                        $urgency=$u;
                                        @notes = grep { $_ ne $u } @notes;
                                        last;
                                }
                        }
                        
                        if ($package=~/kernel-source-([0-9.]+)/) {
                                my $kernversion=$1;
                                if (exists $needkernel{$kernversion} &&
                                    length $version &&
                                    system("dpkg --compare-versions $needkernel{$kernversion} lt $version") != 0) {
                                        $needkernel{$kernversion}=$version;
                                }
                        }

                        my @maddy;
                        for (1..5) {
                                @maddy=`madison -s '$suite' '$package'`;
                                if ($? & 127 || ($? >> 8 != 0 && $? >> 8 != 1)) {
                                        # good old unrelaible newraff,
                                        # home of our archive..
                                        next;
                                }
                                last;
                        }
                        if ($? & 127) {
                                record($package, "<em>[madison segfaulted 5 times in a row.. Medic!]</em>", $id);
                        }
                        elsif ($? >> 8 != 0 && $? >> 8 != 1) {
                                record($package, "<em>[madison exited with ".($? >> 8)."]</em>", $id);
                        }
                        if (! @maddy) {
                                next;
                        }
                        
                        if (grep { $_ eq 'unfixed' || $_ eq 'pending' } @notes) {
                                record($package, '('.join("; ", @notes).')', $id, $urgency);
                                $unfixed++;
                        }
                        else {
                                foreach my $maddy (@maddy) {
                                        my @fields = split(/\s*\|\s*/, $maddy);
                                        my $havver=$fields[1];
                                        my $arches=$fields[3];
                                        my $dtsacmp=1;
                                        $version=~s/\s+//; # strip whitespace
                                        $arches=~s/\s+$//;
                                        my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");

                                        my $dtsaver = `grep "\\- $package" $dtsalist|awk '{print \$3}'`;
                                        chomp $dtsaver;
                                        if (length($dtsaver)) {
                                                my $hdcmp=system("dpkg --compare-versions '$havver' '>=' '$dtsaver'");
                                                if ($hdcmp != 0 && $vdcmp == 0) {
                                                        record($package, "have $dtsaver in secure-testing archive, but $havver is in main archive",$id, $urgency);
                                                }
                                                $dtsacmp = 0;
                                        }
                                        
                                        if ($cmp != 0 && $dtsacmp !=0) {
                                                if ($html && $suite eq 'testing') {
                                                        $havver='<a href="http://bjorn.haxx.se/debian/testing.pl?package='.uri_escape($package).'">'.$havver.'</a>';
                                                }
                                                record($package, "$version needed, have $havver".(@maddy > 1 ? " [$arches]" : ""), $id, $urgency);
                                                $unprop++;
                                                $unprop_all++ unless @maddy > 1;
                                        }
                                }
                        }
                }
                elsif (/\s+TODO/) {
                        $todos++;
                }
        }
}


foreach my $package (sort keys %data) {
        foreach my $condition (sort keys %{$data{$package}}) {
                print OUT "<li>" if $html;
                print OUT "$package $condition for ";
                my $items=0;
                foreach my $i (sort @{$data{$package}{$condition}}) {
                        print OUT ", " if $items > 0;
                        
                        if ($html) {
                                my $color=$colormap{$i->{urgency}};
                                print OUT "<span style=\"background:$color\">";
                        }
                        print OUT $i->{item};
                        if ($html) {
                                print OUT "</span>";
                        }
                        
                        $items++;
                }
                print OUT "\n";
        }
}

foreach my $version (sort keys %needkernel) {
        my %images;
        
        if ($needkern{$version} eq "0") {
                next;
        }

        my @dctrl;
        if (defined $sources && length $sources) {
                my $cat=($sources=~/\.gz/) ? "zcat" : "cat";
                @dctrl=`$cat $sources | grep-dctrl -F Binary kernel-image-$version -s Package,Build-Depends -`;
        }

        my $package="";
        my $haveversion;
        
        foreach my $line (@dctrl) {
                chomp;
                if ($line=~/Package:\s*(\S+)/) {
                        $package=$1;
                        $haveversion="0";
                } elsif ($line=~/Build-Depends/) {
                        if ($line=~/kernel-tree-$version-([^,\s]+)/) {
                                $haveversion="$version-$1";
                        } elsif ($line=~/kernel-source-$version\s+\(>?=\s*([^\s\)]+)\)/) {
                                $haveversion="$1";
                        }
                } else {
                        if ($package=~/linux-kernel-di/ || $package eq "") {
                                next;
                        }
                        $images{$package}=$haveversion;
                        $package="";
                }
        }

        foreach $package (sort keys %images) {
                if ($images{$package} eq "0") {
                        print OUT "<li>" if ($html && $list_unknown);
                        print OUT "$package built from kernel-source-$version $needkernel{$version} needed, current version unknown\n" if $list_unknown;
                } elsif (!system("dpkg --compare-versions $needkernel{$version} gt $images{$package}")) {
                print OUT "<li>" if $html;
                        print OUT "$package built from kernel-source-$version $needkernel{$version} needed, have $images{$package}\n";
                        $need_rebuild++;
                }
        }


}


if ($html) {
        print OUT "</ul>\n";
        print OUT "<hr>\n";
        print OUT "Total holes unfixed: $unfixed<br>\n";
        print OUT "Total holes fixed in unstable but not $suite: $unprop_all";
        if ($unprop_all != $unprop) {
                print OUT " (+".($unprop - $unprop_all)." on some arches)";
        }
        print OUT "<br>\n";
        print OUT "Total number of kernel image packages not up to date: $need_rebuild<br>\n";
        print OUT "Number of TODO lines in <a href=\"http://svn.debian.org/wsvn/secure-testing/data/?rev=0&sc=0\">records</a>: $todos<br>\n";
        print OUT "Maintained by the <a href=\"http://secure-testing.debian.net/\">testing security team</a><br>\n";
        print OUT "Last update: ".`date`."<br>\n";
        print OUT "</html>\n";
}

close OUT;
if (defined $output) {
        rename("$output.tmp.$$", $output) || die "rename: $!";
}
1	joeyh	2	#!/usr/bin/perl
2			# Must run on a machine with madison.
3	joeyh	644	#
4			# To check for un-updated binary kernel packages, also needs grep-dctrl
5			# and a Sources file for the distribution. Set the location of the Sources
6			# file in SOURCES_FILE in the environment.
7	joeyh	256	use URI::Escape;
8	joeyh	1278	use Getopt::Long;
9	joeyh	2
10	joeyh	230	my $html=0;
11	joeyh	1280	my $debug=0;
12	joeyh	1281	my $suite="testing";
13	joeyh	1279	my $output;
14			if (! GetOptions(
15			"html" => \$html,
16	joeyh	1280	"debug" => \$debug,
17	joeyh	1279	"suite=s" => \$suite,
18			"output=s", \$output)
19			\|\| ! @ARGV) {
20	neilm	1750	die "usage: $0 [--suite suite] [--html] [--output=file] [--debug] advisorylist dtsalist...\n";
21	joeyh	230	}
22
23	joeyh	1279	if (defined $output) {
24			open (OUT, ">$output.tmp.$$") \|\| die "output.tmp.$$: $!";
25			}
26			else {
27			open (OUT, ">&STDOUT");
28			}
29
30			if ($html) {
31			print OUT "<html><title>$suite security issues</title>\n";
32			if ($suite ne 'testing' && $suite ne 'unstable') {
33			print OUT <<"EOF";
34			<p>
35			<em>Warning:</em> This page is the result of running the testing security
36			check script against the $suite distribution. As data is only gathered for
37	joeyh	1285	the testing distribution, results may be innacurate if a package has
38	joeyh	1279	changed its name, if a vulnerability affects $suite and not testing, or if a
39			vulnerability has been fixed in $suite by the $suite security team.
40			</p>
41			EOF
42			}
43			print OUT "<ul>\n";
44			}
45
46
47	joeyh	307	my %data;
48	joeyh	1222	my %needkernel=qw/2.4.27 0 2.6.11 0/;
49	stef-guest	688	my $list_unknown=1; #set to 1 to display kernel images with unknown source version
50	joeyh	644	my $sources=$ENV{SOURCES_FILE};
51			my $need_rebuild=0;
52
53	joeyh	1243	my @urgencies=("high", "medium", "low", "unknown");
54			my %colormap=(
55			high => "#FF0000",
56			medium => "#FF9999",
57			low => "#FFFFFF",
58	joeyh	1246	unknown => "#FFFF00"
59	joeyh	1243	);
60
61	joeyh	735	my $unprop = my $unprop_all = my $unfixed = my $todos = 0;
62	joeyh	307
63			sub record {
64	joeyh	1242	my ($package, $condition, $item, $urgency)=@_;
65	joeyh	307
66	joeyh	231	if ($html) {
67	joeyh	307	$condition=~s{bug #(\d+)}{<a href="http://bugs.debian.org/$1">bug #$1</a>}g;
68	joeyh	311	$condition=~s{unfixed}{<b>unfixed</b>}g;
69	joeyh	307	$item=~s#((?:CAN\|CVE)-\d+-\d+)#<a href="http://www.cve.mitre.org/cgi-bin/cvename.cgi?name=$1">$1</a>#g;
70	joeyh	231	}
71	joeyh	307
72	joeyh	1242	push @{$data{$package}{$condition}}, {item => $item, urgency => $urgency};
73	joeyh	230	}
74
75	neilm	1750	die ("No DTSA list specified") if (! length @ARGV[1]);
76			my $dtsalist = @ARGV[1];
77			foreach my $list (@ARGV[0]) {
78	joeyh	31	if (-d $list) {
79			$list="$list/list";
80	joeyh	2	}
81	joeyh	31
82			open (IN, $list) \|\| die "open $list: $!";
83			while (<IN>) {
84	joeyh	1280	print STDERR "line: $_" if $debug;
85	joeyh	31	chomp;
86			if (/^\[/) {
87	joeyh	1660	($id)=m/((?:DSA\|DTSA\|CAN\|CVE)-[^\s]+) /;
88	joeyh	2	}
89	joeyh	1660	elsif (/^((?:DSA\|DTSA\|CAN\|CVE)-[^\s]+)/) {
90	joeyh	242	$id=$1;
91	joeyh	31	}
92	joeyh	643	elsif (/^\s+[!-]\s+(\S+)\s+(.?)\s$/) {
93	joeyh	31	my $package=$1;
94	joeyh	1242	my $rest=$2;
95			my $version;
96			my $notes;
97			if ($rest=~/([^\(\s]+)\s+\((.*)\)/) {
98			$version=$1;
99			$notes=$2;
100			}
101			elsif ($rest=~/\((.*)\)/) {
102			$version="";
103			$notes=$1;
104			}
105			else {
106			$version=$rest;
107			$notes="";
108			}
109			my @notes=split(/\s*;\s+/, $notes);
110
111			my $urgency="unknown";
112			foreach my $u (@urgencies) {
113			if (grep { $_ eq $u } @notes) {
114			$urgency=$u;
115			@notes = grep { $_ ne $u } @notes;
116			last;
117			}
118			}
119	joeyh	241
120	joeyh	644	if ($package=~/kernel-source-([0-9.]+)/) {
121			my $kernversion=$1;
122	joeyh	1283	if (exists $needkernel{$kernversion} &&
123			length $version &&
124			system("dpkg --compare-versions $needkernel{$kernversion} lt $version") != 0) {
125			$needkernel{$kernversion}=$version;
126	joeyh	644	}
127			}
128
129	joeyh	657	my @maddy;
130			for (1..5) {
131	joeyh	1278	@maddy=`madison -s '$suite' '$package'`;
132	joeyh	659	if ($? & 127 \|\| ($? >> 8 != 0 && $? >> 8 != 1)) {
133			# good old unrelaible newraff,
134			# home of our archive..
135	joeyh	657	next;
136			}
137			last;
138			}
139	joeyh	654	if ($? & 127) {
140	joeyh	657	record($package, "<em>[madison segfaulted 5 times in a row.. Medic!]</em>", $id);
141	joeyh	564	}
142			elsif ($? >> 8 != 0 && $? >> 8 != 1) {
143	joeyh	654	record($package, "<em>[madison exited with ".($? >> 8)."]</em>", $id);
144	joeyh	564	}
145	joeyh	657	if (! @maddy) {
146	joeyh	307	next;
147			}
148	joeyh	241
149	joeyh	1242	if (grep { $_ eq 'unfixed' \|\| $_ eq 'pending' } @notes) {
150	joeyh	1244	record($package, '('.join("; ", @notes).')', $id, $urgency);
151	joeyh	257	$unfixed++;
152	joeyh	2	}
153	joeyh	241	else {
154	joeyh	657	foreach my $maddy (@maddy) {
155			my @fields = split(/\s\\|\s/, $maddy);
156			my $havver=$fields[1];
157			my $arches=$fields[3];
158	neilm	1750	my $dtsacmp=1;
159	joeyh	657	$version=~s/\s+//; # strip whitespace
160			$arches=~s/\s+$//;
161			my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");
162	neilm	1750
163			my $dtsaver = `grep "\\- $package" $dtsalist\|awk '{print \$3}'`;
164			chomp $dtsaver;
165			if (length($dtsaver)) {
166			my $hdcmp=system("dpkg --compare-versions '$havver' '>=' '$dtsaver'");
167			if ($hdcmp != 0 && $vdcmp == 0) {
168			record($package, "have $dtsaver in secure-testing archive, but $havver is in main archive",$id, $urgency);
169			}
170			$dtsacmp = 0;
171			}
172
173			if ($cmp != 0 && $dtsacmp !=0) {
174	joeyh	1278	if ($html && $suite eq 'testing') {
175	joeyh	657	$havver='<a href="http://bjorn.haxx.se/debian/testing.pl?package='.uri_escape($package).'">'.$havver.'</a>';
176			}
177	joeyh	1242	record($package, "$version needed, have $havver".(@maddy > 1 ? " [$arches]" : ""), $id, $urgency);
178	joeyh	657	$unprop++;
179	joeyh	735	$unprop_all++ unless @maddy > 1;
180	joeyh	230	}
181	joeyh	31	}
182			}
183	joeyh	2	}
184	joeyh	309	elsif (/\s+TODO/) {
185			$todos++;
186			}
187	joeyh	2	}
188			}
189	joeyh	230
190	joeyh	307
191			foreach my $package (sort keys %data) {
192			foreach my $condition (sort keys %{$data{$package}}) {
193	joeyh	1279	print OUT "<li>" if $html;
194			print OUT "$package $condition for ";
195	joeyh	307	my $items=0;
196	joeyh	1242	foreach my $i (sort @{$data{$package}{$condition}}) {
197	joeyh	1279	print OUT ", " if $items > 0;
198	joeyh	1242
199			if ($html) {
200	joeyh	1243	my $color=$colormap{$i->{urgency}};
201	joeyh	1279	print OUT "<span style=\"background:$color\">";
202	joeyh	1242	}
203	joeyh	1279	print OUT $i->{item};
204	joeyh	1243	if ($html) {
205	joeyh	1279	print OUT "</span>";
206	joeyh	1243	}
207	joeyh	1242
208	joeyh	307	$items++;
209			}
210	joeyh	1279	print OUT "\n";
211	joeyh	307	}
212			}
213
214	joeyh	644	foreach my $version (sort keys %needkernel) {
215			my %images;
216
217			if ($needkern{$version} eq "0") {
218			next;
219			}
220
221			my @dctrl;
222			if (defined $sources && length $sources) {
223	joeyh	645	my $cat=($sources=~/\.gz/) ? "zcat" : "cat";
224			@dctrl=`$cat $sources \| grep-dctrl -F Binary kernel-image-$version -s Package,Build-Depends -`;
225	joeyh	644	}
226
227			my $package="";
228			my $haveversion;
229
230			foreach my $line (@dctrl) {
231			chomp;
232			if ($line=~/Package:\s*(\S+)/) {
233			$package=$1;
234			$haveversion="0";
235			} elsif ($line=~/Build-Depends/) {
236			if ($line=~/kernel-tree-$version-([^,\s]+)/) {
237			$haveversion="$version-$1";
238	stef-guest	687	} elsif ($line=~/kernel-source-$version\s+\(>?=\s*([^\s\)]+)\)/) {
239	joeyh	644	$haveversion="$1";
240			}
241			} else {
242			if ($package=~/linux-kernel-di/ \|\| $package eq "") {
243			next;
244			}
245			$images{$package}=$haveversion;
246			$package="";
247			}
248			}
249
250			foreach $package (sort keys %images) {
251			if ($images{$package} eq "0") {
252	joeyh	1279	print OUT "<li>" if ($html && $list_unknown);
253			print OUT "$package built from kernel-source-$version $needkernel{$version} needed, current version unknown\n" if $list_unknown;
254	joeyh	644	} elsif (!system("dpkg --compare-versions $needkernel{$version} gt $images{$package}")) {
255	joeyh	1279	print OUT "<li>" if $html;
256			print OUT "$package built from kernel-source-$version $needkernel{$version} needed, have $images{$package}\n";
257	joeyh	644	$need_rebuild++;
258			}
259			}
260
261
262			}
263
264
265	joeyh	307	if ($html) {
266	joeyh	1279	print OUT "</ul>\n";
267			print OUT "<hr>\n";
268			print OUT "Total holes unfixed: $unfixed<br>\n";
269			print OUT "Total holes fixed in unstable but not $suite: $unprop_all";
270	joeyh	735	if ($unprop_all != $unprop) {
271	joeyh	1279	print OUT " (+".($unprop - $unprop_all)." on some arches)";
272	joeyh	735	}
273	joeyh	1279	print OUT "<br>\n";
274			print OUT "Total number of kernel image packages not up to date: $need_rebuild<br>\n";
275			print OUT "Number of TODO lines in <a href=\"http://svn.debian.org/wsvn/secure-testing/data/?rev=0&sc=0\">records</a>: $todos<br>\n";
276	joeyh	1659	print OUT "Maintained by the <a href=\"http://secure-testing.debian.net/\">testing security team</a><br>\n";
277	joeyh	1279	print OUT "Last update: ".`date`."<br>\n";
278			print OUT "</html>\n";
279	joeyh	230	}
280	joeyh	1279
281			close OUT;
282			if (defined $output) {
283			rename("$output.tmp.$$", $output) \|\| die "rename: $!";
284			}