#!/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;
my $html=0;
if ($ARGV[0] eq 'html') {
shift;
$html=1;
}
if (! @ARGV) {
die "usage: $0 [html] list\n";
}
my %data;
my %needkernel=qw/2.4.27 0 2.6.8 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 $unprop = my $unprop_all = my $unfixed = my $todos = 0;
sub record {
my ($package, $condition, $item)=@_;
if ($html) {
$condition=~s{bug #(\d+)}{bug #$1}g;
$condition=~s{unfixed}{unfixed}g;
$item=~s#((?:CAN|CVE)-\d+-\d+)#$1#g;
}
push @{$data{$package}{$condition}}, $item;
}
foreach my $list (@ARGV) {
if (-d $list) {
$list="$list/list";
}
open (IN, $list) || die "open $list: $!";
while () {
chomp;
if (/^\[/) {
($id)=m/((?:DSA|CAN|CVE)-[^\s]+) /;
}
elsif (/^((?:DSA|CAN|CVE)-[^\s]+)/) {
$id=$1;
}
elsif (/^\s+[!-]\s+(\S+)\s+(.*?)\s*$/) {
my $package=$1;
my $version=$2;
if ($package=~/kernel-source-([0-9.]+)/) {
my $kernversion=$1;
if (exists $needkernel{$kernversion} &&
$version!~/\(/ ) {
$needkernel{$kernversion}=$version if !system("dpkg --compare-versions $needkernel{$kernversion} lt $version");
}
}
my @maddy;
for (1..5) {
@maddy=`madison -s testing '$package'`;
if ($? & 127 || ($? >> 8 != 0 && $? >> 8 != 1)) {
# good old unrelaible newraff,
# home of our archive..
next;
}
last;
}
if ($? & 127) {
record($package, "[madison segfaulted 5 times in a row.. Medic!]", $id);
}
elsif ($? >> 8 != 0 && $? >> 8 != 1) {
record($package, "[madison exited with ".($? >> 8)."]", $id);
}
if (! @maddy) {
next;
}
if ($version=~/unfixed/ || $version=~/pending/) {
record($package, $version, $id);
$unfixed++;
}
else {
foreach my $maddy (@maddy) {
my @fields = split(/\s*\|\s*/, $maddy);
my $havver=$fields[1];
my $arches=$fields[3];
$version=~s/\s+//; # strip whitespace
$arches=~s/\s+$//;
my $cmp=system("dpkg --compare-versions '$havver' '>=' '$version'");
if ($cmp != 0) {
if ($html) {
$havver=''.$havver.'';
}
record($package, "$version needed, have $havver".(@maddy > 1 ? " [$arches]" : ""), $id);
$unprop++;
$unprop_all++ unless @maddy > 1;
}
}
}
}
elsif (/\s+TODO/) {
$todos++;
}
}
}
if ($html) {
print "testing security issues\n";
print "\n";
}
foreach my $package (sort keys %data) {
foreach my $condition (sort keys %{$data{$package}}) {
print "- " if $html;
print "$package $condition for ";
my $items=0;
foreach my $item (sort @{$data{$package}{$condition}}) {
print ", " if $items > 0;
print $item;
$items++;
}
print "\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 "
- " if ($html && $list_unknown);
print "$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 "
- " if $html;
print "$package built from kernel-source-$version $needkernel{$version} needed, have $images{$package}\n";
$need_rebuild++;
}
}
}
if ($html) {
print "
\n";
print "
\n";
print "Total holes unfixed: $unfixed
\n";
print "Total holes fixed in unstable but not testing: $unprop_all";
if ($unprop_all != $unprop) {
print " (".($unprop - $unprop_all)." on some arches)";
}
print "
\n";
print "Total number of kernel image packages not up to date: $need_rebuild
\n";
print "Number of TODO lines in records: $todos
\n";
print "Maintained by the testing security team
\n";
print "Last update: ".`date`."
\n";
print "\n";
}