/[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 244 by joeyh, Wed Jan 5 12:30:13 2005 UTC data/checklist revision 1281 by joeyh, Mon Jun 27 20:22:06 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 URI::Escape;
8    use Getopt::Long;
9    
10  my $html=0;  my $html=0;
11  if ($ARGV[0] eq 'html') {  my $debug=0;
12          shift;  my $suite="testing";
13          $html=1;  my $output;
14    if (! GetOptions(
15                    "html" => \$html,
16                    "debug" => \$debug,
17                    "suite=s" => \$suite,
18                    "output=s", \$output)
19        || ! @ARGV) {
20            die "usage: $0 [--suite suite] [--html] [--output=file] [--debug] list ...\n";
21  }  }
22    
23  if (! @ARGV) {  if (defined $output) {
24          die "usage: $0 [html] list\n";          open (OUT, ">$output.tmp.$$") || die "output.tmp.$$: $!";
25    }
26    else {
27            open (OUT, ">&STDOUT");
28  }  }
29    
30  if ($html) {  if ($html) {
31          print "<html><title>testing security issues</title>\n";          print OUT "<html><title>$suite security issues</title>\n";
32          print "<ul>\n";          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    the testing distribution, results may be innecurate if a package has
38    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  sub formatout {  
47          my $out=shift;  my %data;
48    my %needkernel=qw/2.4.27 0 2.6.11 0/;
49    my $list_unknown=1; #set to 1 to display kernel images with unknown source version
50    my $sources=$ENV{SOURCES_FILE};
51    my $need_rebuild=0;
52    
53    my @urgencies=("high", "medium", "low", "unknown");
54    my %colormap=(
55            high => "#FF0000",
56            medium => "#FF9999",
57            low => "#FFFFFF",
58            unknown => "#FFFF00"
59    );
60    
61    my $unprop = my $unprop_all = my $unfixed = my $todos = 0;
62    
63    sub record {
64            my ($package, $condition, $item, $urgency)=@_;
65    
66          if ($html) {          if ($html) {
67                  $out=~s#((?:CAN|CVE)-\d+-\d+)#<a href="http://www.cve.mitre.org/cgi-bin/cvename.cgi?name=$1">$1</a>#g;                  $condition=~s{bug #(\d+)}{<a href="http://bugs.debian.org/$1">bug #$1</a>}g;
68                  $out=~s{bug #(\d+)}{<a href="http://bugs.debian.org/$1">bug #$1</a>}g;                  $condition=~s{unfixed}{<b>unfixed</b>}g;
69                    $item=~s#((?:CAN|CVE)-\d+-\d+)#<a href="http://www.cve.mitre.org/cgi-bin/cvename.cgi?name=$1">$1</a>#g;
70          }          }
         return $out;  
 }  
71    
72  my $unprop = my $unfixed = 0;          push @{$data{$package}{$condition}}, {item => $item, urgency => $urgency};
73    }
74    
75  foreach my $list (@ARGV) {  foreach my $list (@ARGV) {
76          if (-d $list) {          if (-d $list) {
# Line 34  foreach my $list (@ARGV) { Line 79  foreach my $list (@ARGV) {
79    
80          open (IN, $list) || die "open $list: $!";          open (IN, $list) || die "open $list: $!";
81          while (<IN>) {          while (<IN>) {
82                    print STDERR "line: $_" if $debug;
83                  chomp;                  chomp;
84                  if (/^\[/) {                  if (/^\[/) {
85                          ($id)=m/((?:DSA|CAN|CVE)-[^\s]+) /;                          ($id)=m/((?:DSA|CAN|CVE)-[^\s]+) /;
# Line 41  foreach my $list (@ARGV) { Line 87  foreach my $list (@ARGV) {
87                  elsif (/^((?:DSA|CAN|CVE)-[^\s]+)/) {                  elsif (/^((?:DSA|CAN|CVE)-[^\s]+)/) {
88                          $id=$1;                          $id=$1;
89                  }                  }
90                  elsif (/^\s+[!-]\s+(.*?)\s+(.*)$/) {                  elsif (/^\s+[!-]\s+(\S+)\s+(.*?)\s*$/) {
91                          my $package=$1;                          my $package=$1;
92                          my $version=$2;                          my $rest=$2;
93                            my $version;
94                            my $notes;
95                            if ($rest=~/([^\(\s]+)\s+\((.*)\)/) {
96                                    $version=$1;
97                                    $notes=$2;
98                            }
99                            elsif ($rest=~/\((.*)\)/) {
100                                    $version="";
101                                    $notes=$1;
102                            }
103                            else {
104                                    $version=$rest;
105                                    $notes="";
106                            }
107                            my @notes=split(/\s*;\s+/, $notes);
108    
109                            my $urgency="unknown";
110                            foreach my $u (@urgencies) {
111                                    if (grep { $_ eq $u } @notes) {
112                                            $urgency=$u;
113                                            @notes = grep { $_ ne $u } @notes;
114                                            last;
115                                    }
116                            }
117    
118                          my $maddy=`madison -s testing '$package'`;                          if ($package=~/kernel-source-([0-9.]+)/) {
119                          next unless length $maddy; # skip if not in testing                                  my $kernversion=$1;
120                                    if (exists $needkernel{$kernversion}) {
121                                            $needkernel{$kernversion}=$version if !system("dpkg --compare-versions $needkernel{$kernversion} lt $version");
122                                    }
123                            }
124    
125                            my @maddy;
126                            for (1..5) {
127                                    @maddy=`madison -s '$suite' '$package'`;
128                                    if ($? & 127 || ($? >> 8 != 0 && $? >> 8 != 1)) {
129                                            # good old unrelaible newraff,
130                                            # home of our archive..
131                                            next;
132                                    }
133                                    last;
134                            }
135                            if ($? & 127) {
136                                    record($package, "<em>[madison segfaulted 5 times in a row.. Medic!]</em>", $id);
137                            }
138                            elsif ($? >> 8 != 0 && $? >> 8 != 1) {
139                                    record($package, "<em>[madison exited with ".($? >> 8)."]</em>", $id);
140                            }
141                            if (! @maddy) {
142                                    next;
143                            }
144    
145                          if ($version=~/unfixed/) {                          if (grep { $_ eq 'unfixed' || $_ eq 'pending' } @notes) {
146                                  print "<li>" if $html;                                  record($package, '('.join("; ", @notes).')', $id, $urgency);
147                                  print formatout("$package $version for $id\n");                                  $unfixed++;
                                 $unprop++;  
148                          }                          }
149                          else {                          else {
150                                  my @fields = split(/\s*\|\s*/, $maddy);                                  foreach my $maddy (@maddy) {
151                                  my $havver=$fields[1];                                          my @fields = split(/\s*\|\s*/, $maddy);
152                                  my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");                                          my $havver=$fields[1];
153                                  if ($cmp != 0) {                                          my $arches=$fields[3];
154                                          if ($html) {                                          $version=~s/\s+//; # strip whitespace
155                                                  print "<li>";                                          $arches=~s/\s+$//;
156                                                  $havver='<a href="http://bjorn.haxx.se/debian/testing.pl?package='.$package.'">'.$havver.'</a>';                                          my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");
157                                            if ($cmp != 0) {
158                                                    if ($html && $suite eq 'testing') {
159                                                            $havver='<a href="http://bjorn.haxx.se/debian/testing.pl?package='.uri_escape($package).'">'.$havver.'</a>';
160                                                    }
161                                                    record($package, "$version needed, have $havver".(@maddy > 1 ? " [$arches]" : ""), $id, $urgency);
162                                                    $unprop++;
163                                                    $unprop_all++ unless @maddy > 1;
164                                          }                                          }
                                         print formatout("$package $version needed, have $havver for $id\n");  
                                         $unfixed++;  
165                                  }                                  }
166                          }                          }
167                  }                  }
168                    elsif (/\s+TODO/) {
169                            $todos++;
170                    }
171          }          }
172  }  }
173    
174    
175    foreach my $package (sort keys %data) {
176            foreach my $condition (sort keys %{$data{$package}}) {
177                    print OUT "<li>" if $html;
178                    print OUT "$package $condition for ";
179                    my $items=0;
180                    foreach my $i (sort @{$data{$package}{$condition}}) {
181                            print OUT ", " if $items > 0;
182    
183                            if ($html) {
184                                    my $color=$colormap{$i->{urgency}};
185                                    print OUT "<span style=\"background:$color\">";
186                            }
187                            print OUT $i->{item};
188                            if ($html) {
189                                    print OUT "</span>";
190                            }
191    
192                            $items++;
193                    }
194                    print OUT "\n";
195            }
196    }
197    
198    foreach my $version (sort keys %needkernel) {
199            my %images;
200    
201            if ($needkern{$version} eq "0") {
202                    next;
203            }
204    
205            my @dctrl;
206            if (defined $sources && length $sources) {
207                    my $cat=($sources=~/\.gz/) ? "zcat" : "cat";
208                    @dctrl=`$cat $sources | grep-dctrl -F Binary kernel-image-$version -s Package,Build-Depends -`;
209            }
210    
211            my $package="";
212            my $haveversion;
213    
214            foreach my $line (@dctrl) {
215                    chomp;
216                    if ($line=~/Package:\s*(\S+)/) {
217                            $package=$1;
218                            $haveversion="0";
219                    } elsif ($line=~/Build-Depends/) {
220                            if ($line=~/kernel-tree-$version-([^,\s]+)/) {
221                                    $haveversion="$version-$1";
222                            } elsif ($line=~/kernel-source-$version\s+\(>?=\s*([^\s\)]+)\)/) {
223                                    $haveversion="$1";
224                            }
225                    } else {
226                            if ($package=~/linux-kernel-di/ || $package eq "") {
227                                    next;
228                            }
229                            $images{$package}=$haveversion;
230                            $package="";
231                    }
232            }
233    
234            foreach $package (sort keys %images) {
235                    if ($images{$package} eq "0") {
236                            print OUT "<li>" if ($html && $list_unknown);
237                            print OUT "$package built from kernel-source-$version $needkernel{$version} needed, current version unknown\n" if $list_unknown;
238                    } elsif (!system("dpkg --compare-versions $needkernel{$version} gt $images{$package}")) {
239                    print OUT "<li>" if $html;
240                            print OUT "$package built from kernel-source-$version $needkernel{$version} needed, have $images{$package}\n";
241                            $need_rebuild++;
242                    }
243            }
244    
245    
246    }
247    
248    
249  if ($html) {  if ($html) {
250          print "</ul>\n";          print OUT "</ul>\n";
251          print "<hr>\n";          print OUT "<hr>\n";
252          print "Total unfixed: $unfixed<br>\n";          print OUT "Total holes unfixed: $unfixed<br>\n";
253          print "Total fixed in unstable but not testing: $unprop<br>\n";          print OUT "Total holes fixed in unstable but not $suite: $unprop_all";
254          print "Last update: ".`date`."<br>\n";          if ($unprop_all != $unprop) {
255          print "</html>\n";                  print OUT " (+".($unprop - $unprop_all)." on some arches)";
256            }
257            print OUT "<br>\n";
258            print OUT "Total number of kernel image packages not up to date: $need_rebuild<br>\n";
259            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";
260            print OUT "Maintained by the <a href=\"http://secure-testing.alioth.debian.org/\">testing security team</a><br>\n";
261            print OUT "Last update: ".`date`."<br>\n";
262            print OUT "</html>\n";
263    }
264    
265    close OUT;
266    if (defined $output) {
267            rename("$output.tmp.$$", $output) || die "rename: $!";
268  }  }
Legend:
Removed from v.244  
changed lines
  Added in v.1281
  ViewVC Help
Powered by ViewVC 1.1.5