source-report/get_sources

   1 #!/usr/bin/perl
   2 # Filename:      get_sources
   3 # Purpose:       Fetches sources and creates to report
   4 # Authors:       grml-team (grml.org), (c) Alexander Wirt
   5 # Bug-Reports:   see http://grml.org/bugs/
   6 # License:       This file is licensed under the GPL v2.
   7 # Latest change: So Mai 06 02:18:45 CEST 2007 [formorer]
   8 ################################################################################
   9
  10 use strict;
  11 use warnings;
  12 use English;
  13
  14 use LWP::Simple qw(!head);
  15 use Data::Dumper;
  16 use HTML::Table;
  17 use CGI qw/:standard/;
  18 use YAML qw( LoadFile );
  19 use Params::Validate qw(:all);
  20 use File::Copy;
  21 use Digest::MD5;
  22
  23
  24 #validates the configfile
  25 sub validate_config ($) {
  26         validate_with(
  27                         params => \@_,
  28                         spec => {
  29                                 title => { type => SCALAR },
  30                                 statusfile => { type => SCALAR },
  31                                 sourcedir => { type => SCALAR },
  32                                 sourceslist => { type => SCALAR },
  33                                 baseurl => { type => SCALAR },
  34                                 chroot => { type => SCALAR },
  35                                 reportdir => { type => SCALAR },
  36                                 debug => { type => SCALAR, regex => qr/^(1|0)$/, optional => 1},
  37                                 alternativeurl => { type => HASHREF, optional => 1},
  38                                 updatesource => { type => SCALAR, regex => qr/^(1|0)$/, optional => 1},
  39                                 },
  40                         on_fail => sub { print STDERR "Could not validate configfile: @_"; exit -1},
  41
  42                         )
  43 }
  44
  45 sub md5_from_file($) {
  46         my $file = shift;
  47         die "'$file' does not exist" unless -f $file;
  48         open(my $fh, '<', $file)
  49                 or die "Can't open '$file': $!";
  50         binmode($fh);
  51         my $md5sum = Digest::MD5->new->addfile(*$fh)->hexdigest;
  52         return $md5sum;
  53 }
  54
  55 my $configfile = shift;
  56 die "Usage: $0 <configfile>" unless $configfile && -f $configfile;
  57
  58 my $config = LoadFile($configfile);
  59 validate_config($config);
  60 my $debug = $config->{debug} || 0;
  61
  62 # if we can't write our reports and packages we can die soon ;)
  63 if (! -d $config->{reportdir}) {
  64         mkdir $config->{reportdir}
  65                 or die "Could not create reportdir '".$config->{reportdir}."':$!";
  66 } else {
  67     #if the sourcedir already exists we have to clean it up first
  68     system("rm -rf ".$config->{reportdir}."/*");
  69     if ($? == -1) {
  70         die "Could not remove old reportdir '".$config->{reportdir}.":$!";
  71     }
  72 }
  73
  74 if (! -d $config->{sourcedir}) {
  75         mkdir $config->{sourcedir}
  76                 or die "Could not create sourcedir '".$config->{sourcedir}."':$!";
  77 }
  78
  79 #fsrst build a package tree
  80 die "Status file '".$config->{statusfile}."' not found" unless -f $config->{statusfile};
  81
  82 open (my $fh, '<', $config->{statusfile}) or die "Could not open status file '".$config->{statusfile}."': $!";
  83 my ($package_tree, $package, $version, $source);
  84 my $linenum = 0;
  85 while (my $line = <$fh>) {
  86         $linenum++;
  87         chomp $line;
  88         if ($line =~ /^Package: (.*)/) {
  89                 $package = $1;
  90         } elsif ($line =~ /^Version: (.*)/){
  91                 $version = $1;
  92         } elsif ($line =~ /Source: (.*)/){
  93                 if ($1 =~ /^(\S+) \(([^)]+)\)$/) {
  94                         $source = $1;
  95                         $version = $2;
  96                 } else {
  97                         $source = $1;
  98                 }
  99         } elsif ($line =~ /^$/) { #finalizing
 100                 $source = $source || $package;
 101
 102                                 #filter out binary nmus
 103                 if ($version =~ /^(.*)\+b/) {
 104                         $version = $1;
 105                 } elsif ($version =~ /(.*-.*)\.0\.\d+$/) { #old bin nmu
 106                         $version = $1;
 107                 } elsif ($version =~ /(.*-.*\.0)\.\d+$/) { #also old binnmu
 108                         $version = $1;
 109                 }
 110                 if ($version && $source && $package) {
 111                         $package_tree->{$package}->{'version'} = $version;
 112                         $package_tree->{$package}->{'source'} = $source;
 113                 } else {
 114                         print STDERR "Finalizing of ($linenum) not possible: package='$package', source='$source', version='$version'";
 115                 }
 116                 ($source, $package, $version) = '';
 117         }
 118 }
 119
 120 close ($fh);
 121
 122 #if we provide our own sources list it will be copied into the chroot
 123 if ($config->{sourceslist} && -f $config->{sourceslist}) {
 124         print "Copy sourceslist into chroot\n" if $debug;
 125         copy($config->{sourceslist},"apt/etc/sources.list") or die "Sources list cannot be copied: $!";
 126 }
 127
 128 #update chroot
 129 system ("apt-get -c=apt-config update") if $config->{updatesource};
 130
 131 foreach my $package (keys %{$package_tree}) {
 132         print "Working on $package\n" if $debug;
 133         my $error = 0;
 134         my $version = $package_tree->{$package}->{'version'};
 135         my $source = $package_tree->{$package}->{'source'};
 136         if (exists $config->{alternativeurl}->{$source}) {
 137                         print "Alternativ URL for $source => " . $config->{alternativeurl}->{$source} . "\n" if $debug;
 138                         $package_tree->{$package}->{'status'} = 'OK/External';
 139                         $package_tree->{$package}->{'url'} = $config->{alternativeurl}->{$source};
 140                         next;
 141         }
 142         $package_tree->{$package}->{'errors'} = ();
 143         my $fn;
 144         my $fversion = $version;;
 145         if ($version =~ /^\d+:(.*)/) {
 146                 $fn = $config->{sourcedir}."/$source/${source}_$1.dsc";
 147                 $fversion = $1;
 148         } else {
 149                 $fn = $config->{sourcedir}."/$source/${source}_$version.dsc";
 150         }
 151
 152         if (-e  $fn) {
 153                 print "$fn found - skipping\n" if $debug;
 154                 $package_tree->{$package}->{'status'} = 'OK';
 155                 if (! -d $config->{reportdir}."/$source") {
 156                         mkdir ($config->{reportdir}."/$source")
 157                                 or die "Could not create package dir '".$config->{reportdir}."/$source':$!";
 158                 }
 159
 160                 if ($version =~ /^([^-]+)-/) {
 161                         link $config->{sourcedir}."/$source/${source}_${fversion}.dsc",$config->{reportdir}."/$source/${source}_${fversion}.dsc";
 162                         link $config->{sourcedir}."/$source/${source}_${fversion}.diff.gz",$config->{reportdir}."/$source/${source}_${fversion}.diff.gz";
 163                         link $config->{sourcedir}."/$source/${source}_$1.orig.tar.gz",$config->{reportdir}."/$source/${source}_$1.orig.tar.gz";
 164                 } else {
 165                         link $config->{sourcedir}."/$source/${source}_${fversion}.dsc",$config->{reportdir}."/$source/${source}_${fversion}.dsc";
 166                         link $config->{sourcedir}."/$source/${source}_${fversion}.tar.gz",$config->{reportdir}."/$source/${source}_${fversion}.tar.gz";
 167                 }
 168                 next;
 169         }
 170
 171         open (my $fh, '-|', "apt-get -c=apt-config --print-uris -d source $source=$version 2>&1 ")
 172                 or warn "Could not launch apt-get command:$!";
 173         while (my $line = <$fh>) {
 174                 chomp $line;
 175                 if ($line =~ /^'([^']+)'\s+(\S+)\s+(\S+)\s+(\S+)/) {
 176                         my $uri = $1;
 177                         my $filename = $2;
 178                         my $size = $3;
 179                         my $md5sum = $4;
 180                         $md5sum =~ s/^MD5Sum://;
 181                         print "Filename: $filename\n" if $debug;
 182                         if (! -d $config->{reportdir}."/$source") {
 183                                 mkdir ($config->{reportdir}."/$source")
 184                                         or die "Could not create package dir '".$config->{reportdir}."/$source':$!";
 185                         }
 186                         if (! -d $config->{sourcedir}."/$source") {
 187                                 mkdir ($config->{sourcedir}."/$source")
 188                                         or die "Could not create package dir '".$config->{sourcedir}."/$source':$!";
 189                         }
 190                         my $status = 0;
 191                         if ( -e $config->{sourcedir}."/$source/$filename" ) {
 192                                 if ($md5sum eq md5_from_file($config->{sourcedir}."/$source/$filename")) {
 193                                         print $config->{sourcedir}."/$source/$filename already downloaded\n" if $debug;
 194                                         open (my $urifh, '>', $config->{sourcedir}."/$source/$filename.md5")
 195                                                 or die "Could not open " . $config->{sourcedir}."/$source/$filename.md5 for writing: $!";
 196                                         print $urifh $md5sum;
 197                                         close $urifh;
 198
 199                                         $status = 1;
 200                                 } else {
 201                                         print $config->{sourcedir}."/$source/$filename corrupt - download again\n" if $debug;
 202                                 }
 203
 204                         }
 205                         if ($status == 0)  {
 206                                 print "Getting uri '$uri' to ".$config->{sourcedir}. "/$source/$filename\n" if $debug;
 207                                 my $ret = getstore($uri, $config->{sourcedir}."/$source/$filename");
 208                                 if ($ret != 200) {
 209                                         print STDERR "Could not download $uri - Server returned: " . status_message($ret) . "\n";
 210                                         push @{$package_tree->{$package}->{'errors'}}, "$uri failed: " . status_message($ret);
 211                                         $error =1;
 212                                 }
 213
 214                                 if ($md5sum eq md5_from_file($config->{sourcedir}."/$source/$filename") ) {
 215                                         open (my $urifh, '>', $config->{sourcedir}."/$source/$filename.md5")
 216                                                 or die "Could not open " . $config->{sourcedir}."/$source/$filename.md5 for writing: $!";
 217                                         print $urifh $md5sum;
 218                                         close $urifh;
 219                                         open ($urifh, '>', $config->{sourcedir}."/$source/$filename.uri")
 220                                                 or die "Could not open " . $config->{sourcedir}."/$source/$filename.uri for writing: $!";
 221                                         print $urifh "$uri\n";
 222                                         close $urifh;
 223                                 } else {
 224                                         print STDERR "md5sum mismatch of $uri\n";
 225                                         push @{$package_tree->{$package}->{'errors'}}, "$uri failed: md5sum mismatch";
 226                                         unlink $config->{sourcedir}."/$source/$filename.md5";
 227                                         $error =1;
 228                                 }
 229                         }
 230                         if (! $error) {
 231                                 print "Creating links\n" if $debug;
 232                                 link $config->{sourcedir}."/$source/$filename",$config->{reportdir}."/$source/$filename";
 233                                 link $config->{sourcedir}."/$source/$filename.uri",$config->{reportdir}."/$source/$filename.uri";
 234                                 link $config->{sourcedir}."/$source/$filename.md5",$config->{reportdir}."/$source/$filename.md5";
 235                         }
 236                 } elsif ($line =~ /^E: (.*)/) {
 237                         push @{$package_tree->{$package}->{'errors'}}, "$1";
 238                         print STDERR "Got an error from apt-get for package $package (Source: $source, Version: $version): $1\n";
 239                         $error = 1;
 240                 }
 241         }
 242         close ($fh);
 243         if ($error) {
 244                 print "Package $package failed:\n" if $debug;
 245                 print join("\n", @{$package_tree->{$package}->{'errors'}}) . "\n" if $debug;
 246                 $package_tree->{$package}->{'status'} = 'FAILED';
 247         } else {
 248                 print "Package $package successfull\n" if $debug;
 249                 $package_tree->{$package}->{'status'} = 'OK';
 250         }
 251 }
 252
 253 my $t = new HTML::Table(
 254                                 -cols => 4,
 255                                 -border=>1,
 256                                 -head=> ['Package','Source','Version', 'Status'],
 257                         );
 258 foreach my $package (sort(keys %{$package_tree})) {
 259         if ($package_tree->{$package}->{'status'} eq 'OK') {
 260         $t->addRow(     $package,
 261                         "<a href='". $package_tree->{$package}->{'source'} . "'>" . $package_tree->{$package}->{'source'} . "</a>",
 262                         $package_tree->{$package}->{'version'},
 263                         $package_tree->{$package}->{'status'}
 264                 );
 265         } elsif ($package_tree->{$package}->{'status'} eq 'FAILED') {
 266                 open (my $fh, '>', $config->{reportdir}."/$package-error.html")
 267                         or die "Could not create error file '".$config->{reportdir}."/$package-error.html': $!";
 268                 print $fh start_html("Errors for $package (" . $package_tree->{$package}->{'version'} . ")");
 269                 print $fh "<h2>Errors for $package (". $package_tree->{$package}->{'version'} . ")</h2>";
 270                 print $fh join("<br>\n", @{$package_tree->{$package}->{'errors'}});
 271                 print $fh "<br><br><a href='index.html'>Back to index</a>";
 272                 print $fh end_html;
 273                 close ($fh);
 274                 $t->addRow(     $package,
 275                                 $package_tree->{$package}->{'source'},
 276                                 $package_tree->{$package}->{'version'},
 277                                 "<a href='$package-error.html'>".$package_tree->{$package}->{'status'}."</a>"
 278                         );
 279         } elsif ($package_tree->{$package}->{'status'} eq 'OK/External') {
 280                 $t->addRow(     $package,
 281                                 "<a href='".$package_tree->{$package}->{'url'} . "'>" . $package_tree->{$package}->{'source'} . "</a>",
 282                                 $package_tree->{$package}->{'version'},
 283                                 $package_tree->{$package}->{'status'}
 284                         );
 285         }
 286 }
 287
 288
 289 copy("apt/etc/sources.list", $config->{reportdir}."/sources.list") or die "Sources list cannot be copied: $!";
 290
 291 #first some statistics
 292 my $pnum = keys(%{$package_tree});
 293 my %s_hash;
 294 my $errors = 0;
 295 foreach my $package (keys(%{$package_tree})) {
 296         $errors++ if $package_tree->{$package}->{'status'} !~ /^OK/;
 297         if (! exists  $s_hash{ $package_tree->{$package}->{'source'} }) {
 298                 $s_hash{$package_tree->{$package}->{'source'}} = 1;
 299         }
 300 }
 301
 302 my $snum = keys(%s_hash);
 303 open ($fh, '>', $config->{reportdir}."/index.html") or die "Could not create indexfile '".$config->{reportdir}."/index.html': $!";
 304 print $fh start_html("Report for " . $config->{title});
 305 print $fh "<center><h2>Report for " . $config->{title} . "</h2>";
 306 print $fh "<b>Packages:</b> $pnum<br>";
 307 print $fh "<b>Sources:</b> $snum<br>";
 308 print $fh "<b>Errors:</b> $errors (" . $errors/$snum*100 . "%)<br>";
 309 print $fh "<a href='sources.list'>Sources list of the chroot</a><br><br>";
 310 print $fh "<b>Use:</b><i> deb-src " . $config->{'baseurl'} . " ./</i><br> ";
 311 print $fh "in your sources.list to get files via apt-get<br><br>";
 312 print $fh $t;
 313 print $fh end_html;
 314 close ($fh);
 315
 316 open ($fh, '>', $config->{reportdir}."/status.txt")
 317         or die "Could not create statusfile '".$config->{reportdir}."/status.txt': $!";
 318
 319 print $fh "Updated: " . localtime() . "\n";
 320 print $fh "Title: " . $config->{title} . "\n";
 321 print $fh "Baseurl: " . $config->{baseurl} . "\n";
 322 print $fh "Packages: $pnum\n";
 323 print $fh "Sources: $snum\n";
 324 print $fh "Errors: $errors\n";
 325
 326 system ("cd " . $config->{reportdir} . "; dpkg-scansources . | gzip -9 > Sources.gz");