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