/[secure-testing]/bin/checklist
ViewVC logotype

Diff of /bin/checklist

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

sarge-checks/checklist revision 643 by joeyh, Fri Mar 25 02:29:35 2005 UTC bin/checklist revision 1765 by joeyh, Thu Sep 1 19:29:08 2005 UTC
# Line 1  Line 1 
1  #!/usr/bin/perl  #!/usr/bin/perl
2  # Must run on a machine with madison.  # Must run on a machine with madison.
3    #
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    use warnings;
8    use strict;
9  use URI::Escape;  use URI::Escape;
10    use Getopt::Long;
11    
12  my $html=0;  my $html=0;
13  if ($ARGV[0] eq 'html') {  my $debug=0;
14          shift;  my $suite="testing";
15          $html=1;  my $sta = "http://secure-testing.debian.net/debian-security-updates/dists/testing/security-updates/main/source/Sources.gz";
16    my $output;
17    if (! GetOptions(
18                    "html" => \$html,
19                    "debug" => \$debug,
20                    "suite=s" => \$suite,
21                    "sta=s" => \$sta,
22                    "output=s", \$output)
23        || ! @ARGV) {
24            die "usage: $0 [--suite suite] [--sta sta-mirror] [--html] [--output=file] [--debug] list ...\n";
25  }  }
26    
27  if (! @ARGV) {  system("wget -q -O /tmp/Sources.sta.gz $sta");
28          die "usage: $0 [html] list\n";  
29    if (defined $output) {
30            open (OUT, ">$output.tmp.$$") || die "output.tmp.$$: $!"; # Set the output to a file
31    }
32    else {
33            open (OUT, ">&STDOUT"); # Set the output to stdout
34    }
35    
36    if ($html) { # It's HTML, so we need a header
37            print OUT "<html><title>$suite security issues</title>\n";
38    
39            # This is being run against something it's not meant to be, so print a warning
40            if ($suite ne 'testing' && $suite ne 'unstable') {
41                    print OUT <<"EOF";
42    <p>
43    <em>Warning:</em> This page is the result of running the testing security
44    check script against the $suite distribution. As data is only gathered for
45    the testing distribution, results may be innacurate if a package has
46    changed its name, if a vulnerability affects $suite and not testing, or if a
47    vulnerability has been fixed in $suite by the $suite security team.
48    </p>
49    EOF
50            }
51            print OUT "<ul>\n";
52  }  }
53    
54    
55  my %data;  my %data;
56  my $unprop = my $unfixed = my $todos = 0;  my %advlist;
57    my %needkernel=qw/2.4.27 0 2.6.11 0/;
58    my $list_unknown=1; #set to 1 to display kernel images with unknown source version
59    my $sources=$ENV{SOURCES_FILE};
60    my $need_rebuild=0;
61    
62    # Set some colours for the urgency types
63    my @urgencies=("high", "medium", "low", "unknown");
64    my %colormap=(
65            high => "#FF0000",
66            medium => "#FF9999",
67            low => "#FFFFFF",
68            unknown => "#FFFF00"
69    );
70    
71    my $unprop = my $unprop_all = my $unfixed = my $todos = my $fixedsta = 0;
72    
73    # Add an item into the data array.
74  sub record {  sub record {
75          my ($package, $condition, $item)=@_;          my ($package, $condition, $item, $urgency)=@_;
76    
77          if ($html) {          if ($html) {
78                  $condition=~s{bug #(\d+)}{<a href="http://bugs.debian.org/$1">bug #$1</a>}g;                  $condition=~s{bug #(\d+)}{<a href="http://bugs.debian.org/$1">bug #$1</a>}g;
# Line 25  sub record { Line 80  sub record {
80                  $item=~s#((?:CAN|CVE)-\d+-\d+)#<a href="http://www.cve.mitre.org/cgi-bin/cvename.cgi?name=$1">$1</a>#g;                  $item=~s#((?:CAN|CVE)-\d+-\d+)#<a href="http://www.cve.mitre.org/cgi-bin/cvename.cgi?name=$1">$1</a>#g;
81          }          }
82    
83          push @{$data{$package}{$condition}}, $item;          push @{$data{$package}{$condition}}, {item => $item, urgency => $urgency};
84  }  }
85    
86  foreach my $list (@ARGV) {  foreach my $list (@ARGV) {
87            # Each of the @ARGVs we've got passed need parsing. So lets do that
88    
89            # If it's a directory, set the file to list, cause we need that.
90          if (-d $list) {          if (-d $list) {
91                  $list="$list/list";                  $list="$list/list";
92          }          }
93    
94          open (IN, $list) || die "open $list: $!";          open (IN, $list) || die "open $list: $!";
95          while (<IN>) {          while (<IN>) {
96                    my $id;
97                    print STDERR "line: $_" if $debug;
98                  chomp;                  chomp;
99                  if (/^\[/) {                  if (/\s+TODO/) { # It's a todo item. Add it to the count, and ignore it
100                          ($id)=m/((?:DSA|CAN|CVE)-[^\s]+) /;                          $todos++;
101                    }
102                    elsif (/^\[/) { # Checking adv. number for a line starting with [ : Set $id to it
103                            ($id)=m/((?:DSA|DTSA|CAN|CVE)-[^\s]+) /;
104                  }                  }
105                  elsif (/^((?:DSA|CAN|CVE)-[^\s]+)/) {                  elsif (/^((?:DSA|DTSA|CAN|CVE)-[^\s]+)/) { # Check for a line with an advisory at the start : Set $id to it
106                          $id=$1;                          $id=$1;
107                  }                  }
108                  elsif (/^\s+[!-]\s+(\S+)\s+(.*?)\s*$/) {                  elsif (/^\s+[!-]\s+(\S+)\s+(.*?)\s*$/) { # Deal with the rest of the lines
109                          my $package=$1;                          my $package=$1; # We know which package it is.
110                          my $version=$2;                          my $rest=$2;
111                            my $version;
112                          my $maddy=`madison -s testing '$package'`;                          my $notes;
113                          if ($? & 128) {                          if ($rest=~/([^\(\s]+)\s+\((.*)\)/) {
114                                  # good old newraff..                                  $version=$1;
115                                  record($package, "<em>madison segfaulted</em>", $id);                                  $notes=$2;
116                            }
117                            elsif ($rest=~/\((.*)\)/) {
118                                    $version="";
119                                    $notes=$1;
120                            }
121                            else {
122                                    $version=$rest;
123                                    $notes="";
124                            }
125    
126                            # by now, we also have the version that's affected by the security problem.
127                            # This is stored in $version
128    
129                            my @notes=split(/\s*;\s+/, $notes);
130    
131                            # Fetch the urgency, if we can.
132                            my $urgency="unknown";
133                            foreach my $u (@urgencies) {
134                                    if (grep { $_ eq $u } @notes) {
135                                            $urgency=$u;
136                                            @notes = grep { $_ ne $u } @notes;
137                                            last;
138                                    }
139                            }
140    
141                            # It's a kernel. Add it to the list of kernels that need to be looked at.
142                            if ($package=~/kernel-source-([0-9.]+)/) {
143                                    my $kernversion=$1;
144                                    if (exists $needkernel{$kernversion} &&
145                                        length $version &&
146                                        system("dpkg --compare-versions $needkernel{$kernversion} lt $version") != 0) {
147                                            $needkernel{$kernversion}=$version;
148                                    }
149                            }
150    
151                            # Fire up madison.
152                            my @maddy;
153                            for (1..5) {
154                                    @maddy=`madison -s '$suite' '$package'`;
155                                    if ($? & 127 || ($? >> 8 != 0 && $? >> 8 != 1)) {
156                                            # good old unrelaible newraff,
157                                            # home of our archive..
158                                            next;
159                                    }
160                                    last;
161                            }
162                            if ($? & 127) {
163                                    record($package, "<em>[madison segfaulted 5 times in a row.. Medic!]</em>", $id);
164                          }                          }
165                          elsif ($? >> 8 != 0 && $? >> 8 != 1) {                          elsif ($? >> 8 != 0 && $? >> 8 != 1) {
166                                  record($package, "<em>madison exited with ".($? >> 8)."</em>", $id);                                  record($package, "<em>[madison exited with ".($? >> 8)."]</em>", $id);
167                          }                          }
168                          if (! length $maddy) {                          if (! @maddy) {
169                                  next;                                  next;
170                          }                          }
171    
172                          if ($version=~/unfixed/ || $version=~/pending/) {                          if (grep { $_ eq 'unfixed' || $_ eq 'pending' } @notes) {
173                                  record($package, $version, $id);                                  record($package, '('.join("; ", @notes).')', $id, $urgency);
174                                  $unfixed++;                                  $unfixed++;
175                                    # It's not been fixed!
176                          }                          }
177                          else {                          else {
178                                  my @fields = split(/\s*\|\s*/, $maddy);                                  foreach my $maddy (@maddy) {
179                                  my $havver=$fields[1];                                          my @fields = split(/\s*\|\s*/, $maddy);
180                                  my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");                                          my $havver=$fields[1]; # It's this version in the archive I'm checking.
181                                  if ($cmp != 0) {                                          my $arches=$fields[3];
182                                          if ($html) {                                          $version=~s/\s+//; # strip whitespace
183                                                  $havver='<a href="http://bjorn.haxx.se/debian/testing.pl?package='.uri_escape($package).'">'.$havver.'</a>';                                          $arches=~s/\s+$//;
184                                            my $starchive = "";
185    
186                                            # Is the version in the archive greater than the version that's vulnerable?
187                                            my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");
188                                            if ($cmp != 0){ # No, so the archive is vulnerable.
189    
190                                                    # Does the version exist in the secure-testing archive?
191                                                    my $staversion = `zcat /tmp/Sources.sta.gz |grep-dctrl -F Package -e ^$package\$ -s Version -`;
192                                                    chomp $staversion;
193                                                    $staversion=~s/Version: //;
194                                                    $staversion=~s/\s+//;
195                                                    if (length ($staversion)) {
196                                                            # Yes, but what version is in s-t?
197                                                            my $stacmp = system("dpkg --compare-versions '$staversion' '>=' '$version'");
198                                                            if ($stacmp == 0){
199                                                                    # Well, the version in the s-t archive fixes the issue
200                                                                    # but it's still vulnerable in the main archive
201                                                                    $starchive = " (fixed in $staversion in the secure-testing archive)";
202                                                                    $fixedsta++;
203                                                            }
204                                                    }
205    
206                                                    if ($html && $suite eq 'testing') {
207                                                            $havver='<a href="http://bjorn.haxx.se/debian/testing.pl?package='.uri_escape($package).'">'.$havver.'</a>';
208                                                    }
209                                                    record($package, "$version needed, have $havver".(@maddy > 1 ? " [$arches]" : "").$starchive, $id, $urgency);
210                                                    $unprop++;
211                                                    $unprop_all++ unless @maddy > 1;
212                                          }                                          }
                                         record($package, "$version needed, have $havver", $id);  
                                         $unprop++;  
213                                  }                                  }
214                          }                          }
215                  }                  }
                 elsif (/\s+TODO/) {  
                         $todos++;  
                 }  
216          }          }
217  }  }
218    
219    
 if ($html) {  
         print "<html><title>testing security issues</title>\n";  
         print "<ul>\n";  
 }  
   
220  foreach my $package (sort keys %data) {  foreach my $package (sort keys %data) {
221          foreach my $condition (sort keys %{$data{$package}}) {          foreach my $condition (sort keys %{$data{$package}}) {
222                  print "<li>" if $html;                  print OUT "<li>" if $html;
223                  print "$package $condition for ";                  print OUT "$package $condition for ";
224                  my $items=0;                  my $items=0;
225                  foreach my $item (sort @{$data{$package}{$condition}}) {                  foreach my $i (sort @{$data{$package}{$condition}}) {
226                          print ", " if $items > 0;                          print OUT ", " if $items > 0;
227                          print $item;  
228                            if ($html) {
229                                    my $color=$colormap{$i->{urgency}};
230                                    print OUT "<span style=\"background:$color\">";
231                            }
232                            print OUT $i->{item};
233                            if ($html) {
234                                    print OUT "</span>";
235                            }
236    
237                          $items++;                          $items++;
238                  }                  }
239                  print "\n";                  print OUT "\n";
240            }
241    }
242    
243    my %needkern;
244    
245    foreach my $version (sort keys %needkernel) {
246            my %images;
247    
248            if ($needkern{$version} eq "0") {
249                    next;
250            }
251    
252            my @dctrl;
253            if (defined $sources && length $sources) {
254                    my $cat=($sources=~/\.gz/) ? "zcat" : "cat";
255                    @dctrl=`$cat $sources | grep-dctrl -F Binary kernel-image-$version -s Package,Build-Depends -`;
256            }
257    
258            my $package="";
259            my $haveversion;
260    
261            foreach my $line (@dctrl) {
262                    chomp;
263                    if ($line=~/Package:\s*(\S+)/) {
264                            $package=$1;
265                            $haveversion="0";
266                    } elsif ($line=~/Build-Depends/) {
267                            if ($line=~/kernel-tree-$version-([^,\s]+)/) {
268                                    $haveversion="$version-$1";
269                            } elsif ($line=~/kernel-source-$version\s+\(>?=\s*([^\s\)]+)\)/) {
270                                    $haveversion="$1";
271                            }
272                    } else {
273                            if ($package=~/linux-kernel-di/ || $package eq "") {
274                                    next;
275                            }
276                            $images{$package}=$haveversion;
277                            $package="";
278                    }
279            }
280    
281            foreach my $package (sort keys %images) {
282                    if ($images{$package} eq "0") {
283                            print OUT "<li>" if ($html && $list_unknown);
284                            print OUT "$package built from kernel-source-$version $needkernel{$version} needed, current version unknown\n" if $list_unknown;
285                    } elsif (!system("dpkg --compare-versions $needkernel{$version} gt $images{$package}")) {
286                    print OUT "<li>" if $html;
287                            print OUT "$package built from kernel-source-$version $needkernel{$version} needed, have $images{$package}\n";
288                            $need_rebuild++;
289                    }
290          }          }
291    
292    
293  }  }
294    
295    
296  if ($html) {  if ($html) {
297          print "</ul>\n";          print OUT "</ul>\n";
298          print "<hr>\n";          print OUT "<hr>\n";
299          print "Total holes unfixed: $unfixed<br>\n";          print OUT "Key: ";
300          print "Total holes fixed in unstable but not testing: $unprop<br>\n";          foreach my $keyline (@urgencies) {
301          print "Number of TODO lines in <a href=\"http://svn.debian.org/wsvn/secure-testing/sarge-checks/?rev=0&sc=0\">records</a>: $todos<br>\n";                  print OUT "<span style=\"border: 1px dashed; background:".$colormap{$keyline}."\">&nbsp;$keyline&nbsp;</span> ";
302          print "Maintained by the <a href=\"http://secure-testing.alioth.debian.org/\">testing security team</a><br>\n";          }
303          print "Last update: ".`date`."<br>\n";          print OUT "<br>";
304          print "</html>\n";          print OUT "Total holes unfixed: $unfixed<br>\n";
305            print OUT "Total holes fixed in unstable but not $suite: $unprop_all ($fixedsta fixed in secure-testing archive)";
306            if ($unprop_all != $unprop) {
307                    print OUT " (+".($unprop - $unprop_all)." on some arches)";
308            }
309            print OUT "<br>\n";
310            print OUT "Total number of kernel image packages not up to date: $need_rebuild<br>\n";
311            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";
312            print OUT "Maintained by the <a href=\"http://secure-testing.debian.net/\">testing security team</a><br>\n";
313            print OUT "Last update: ".`date`."<br>\n";
314            print OUT "</html>\n";
315    }
316    
317    close OUT;
318    if (defined $output) {
319            rename("$output.tmp.$$", $output) || die "rename: $!";
320  }  }
Legend:
Removed from v.643  
changed lines
  Added in v.1765
  ViewVC Help
Powered by ViewVC 1.1.5