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: Wed May 02 05:17:01 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
  22 #validates the configfile
  23 sub validate_config ($) {
  24         validate_with(
  25                         params => \@_,
  26                         spec => {
  27                                 title => { type => SCALAR },
  28                                 statusfile => { type => SCALAR },
  29                                 chroot => { type => SCALAR },
  30                                 reportdir => { type => SCALAR },
  31                                 debug => { type => SCALAR, regex => qr/^(1|0)$/, optional => 1},
  32                                 alternativeurl => { type => HASHREF, optional => 1},
  33                                 updatesource => { type => SCALAR, regex => qr/^(1|0)$/, optional => 1},
  34                                 },
  35                         on_fail => sub { print STDERR "Could not validate configfile: @_"; exit -1},
  36
  37                         )
  38 }
  39 my $configfile = shift;
  40 die "Usage: $0 <configfile>" unless $configfile && -f $configfile;
  41
  42 my $config = LoadFile($configfile);
  43 validate_config($config);
  44 my $debug = $config->{debug} || 0;
  45
  46 # if we can't write our reports and packages we can die soon ;)
  47 if (! -d $config->{reportdir}) {
  48         mkdir $config->{reportdir}
  49                 or die "Could not create reportdir '".$config->{reportdir}."':$!";
  50 }
  51
  52 #fsrst build a package tree
  53 die "Status file '".$config->{statusfile}."' not found" unless -f $config->{statusfile};
  54
  55 open (my $fh, '<', $config->{statusfile}) or die "Could not open status file '".$config->{statusfile}."': $!";
  56 my ($package_tree, $package, $version, $source);
  57 my $linenum = 0;
  58 while (my $line = <$fh>) {
  59         $linenum++;
  60         chomp $line;
  61         if ($line =~ /^Package: (.*)/) {
  62                 $package = $1;
  63         } elsif ($line =~ /^Version: (.*)/){
  64                 $version = $1;
  65         } elsif ($line =~ /Source: (.*)/){
  66                 if ($1 =~ /^(\S+) \(([^)]+)\)$/) {
  67                         $source = $1;
  68                         $version = $2;
  69                 } else {
  70                         $source = $1;
  71                 }
  72         } elsif ($line =~ /^$/) { #finalizing
  73                 $source = $source || $package;
  74
  75                                 #filter out binary nmus
  76                 if ($version =~ /^(.*)\+b/) {
  77                         $version = $1;
  78                 } elsif ($version =~ /(.*-.*)\.0\.\d+$/) { #old bin nmu
  79                         $version = $1;
  80                 } elsif ($version =~ /(.*-.*\.0)\.\d+$/) { #also old binnmu
  81                         $version = $1;
  82                 }
  83                 if ($version && $source && $package) {
  84                         $package_tree->{$package}->{'version'} = $version;
  85                         $package_tree->{$package}->{'source'} = $source;
  86                 } else {
  87                         print STDERR "Finalizing of ($linenum) not possible: package='$package', source='$source', version='$version'";
  88                 }
  89                 ($source, $package, $version) = '';
  90         }
  91 }
  92
  93 close ($fh);
  94
  95 #update chroot
  96 system ("sudo chroot " . $config->{chroot} . " apt-get update") if $config->{updatesource};
  97
  98 foreach my $package (keys %{$package_tree}) {
  99         print "Working on $package\n" if $debug;
 100         my $error = 0;
 101         my $version = $package_tree->{$package}->{'version'};
 102         my $source = $package_tree->{$package}->{'source'};
 103         if (exists $config->{alternativeurl}->{$source}) {
 104                         print "Alternativ URL for $source => " . $config->{alternativeurl}->{$source} . "\n" if $debug;
 105                         $package_tree->{$package}->{'status'} = 'OK/External';
 106                         $package_tree->{$package}->{'url'} = $config->{alternativeurl}->{$source};
 107                         next;
 108         }
 109         $package_tree->{$package}->{'errors'} = ();
 110         open (my $fh, '-|', "sudo chroot " . $config->{chroot} . " apt-get --print-uris -d source $source=$version 2>&1 ")
 111                 or warn "Could not launch chroot command:$!";
 112         while (my $line = <$fh>) {
 113                 chomp $line;
 114                 if ($line =~ /^'([^']+)'/) {
 115                         my $uri = $1;
 116                         my ($filename) = $uri =~ /([^\/]+)$/;
 117                         print "Filename: $filename\n" if $debug;
 118                         if (! -d $config->{reportdir}."/$source") {
 119                                 mkdir ($config->{reportdir}."/$source")
 120                                         or die "Could not create package dir '".$config->{reportdir}."/$source':$!";
 121                         }
 122                         if ( -e $config->{reportdir}."/$source/$filename" ) {
 123                                 print $config->{reportdir}."/$source already downloaded\n" if $debug;
 124                         } else {
 125                                 print "Getting uri '$uri' to ".$config->{reportdir}. "/$source/$filename\n" if $debug;
 126                                 my $ret = getstore($uri, $config->{reportdir}."/$source/$filename");
 127                                 if ($ret != 200) {
 128                                         print STDERR "Could not download $uri - Server returned: " . status_message($ret) . "\n";
 129                                         push @{$package_tree->{$package}->{'errors'}}, "$uri failed: " . status_message($ret);
 130                                         $error =1;
 131                                 }
 132                         }
 133                 } elsif ($line =~ /^E: (.*)/) {
 134                         push @{$package_tree->{$package}->{'errors'}}, "$1";
 135                         print STDERR "Got an error from apt-get for package $package (Source: $source, Version: $version): $1\n";
 136                         $error = 1;
 137                         }
 138         }
 139         close ($fh);
 140         if ($error) {
 141                 print "Package $package failed:\n" if $debug;
 142                 print join("\n", @{$package_tree->{$package}->{'errors'}}) . "\n" if $debug;
 143                 $package_tree->{$package}->{'status'} = 'FAILED';
 144         } else {
 145                 print "Package $package successfull\n" if $debug;
 146                 $package_tree->{$package}->{'status'} = 'OK';
 147         }
 148 }
 149
 150 my $t = new HTML::Table(
 151                                 -cols => 4,
 152                                 -border=>1,
 153                                 -head=> ['Package','Source','Version', 'Status'],
 154                         );
 155 foreach my $package (sort(keys %{$package_tree})) {
 156         if ($package_tree->{$package}->{'status'} eq 'OK') {
 157         $t->addRow(     $package,
 158                         "<a href='". $package_tree->{$package}->{'source'} . "'>" . $package_tree->{$package}->{'source'} . "</a>",
 159                         $package_tree->{$package}->{'version'},
 160                         $package_tree->{$package}->{'status'}
 161                 );
 162         } elsif ($package_tree->{$package}->{'status'} eq 'FAILED') {
 163                 open (my $fh, '>', $config->{reportdir}."/$package-error.html")
 164                         or die "Could not create error file '".$config->{reportdir}."/$package-error.html': $!";
 165                 print $fh start_html("Errors for $package (" . $package_tree->{$package}->{'version'} . ")");
 166                 print $fh "<h2>Errors for $package (". $package_tree->{$package}->{'version'} . ")</h2>";
 167                 print $fh join("<br>\n", @{$package_tree->{$package}->{'errors'}});
 168                 print $fh "<br><br><a href='index.html'>Back to index</a>";
 169                 print $fh end_html;
 170                 close ($fh);
 171                 $t->addRow(     $package,
 172                                 $package_tree->{$package}->{'source'},
 173                                 $package_tree->{$package}->{'version'},
 174                                 "<a href='$package-error.html'>".$package_tree->{$package}->{'status'}."</a>"
 175                         );
 176         } elsif ($package_tree->{$package}->{'status'} eq 'OK/External') {
 177                 $t->addRow(     $package,
 178                                 "<a href='".$package_tree->{$package}->{'url'} . "'>" . $package_tree->{$package}->{'source'} . "</a>",
 179                                 $package_tree->{$package}->{'version'},
 180                                 $package_tree->{$package}->{'status'}
 181                         );
 182         }
 183 }
 184
 185
 186 copy($config->{chroot}."/etc/apt/sources.list", $config->{reportdir}."/sources.list") or die "Sources list cannot be copied: $!";
 187
 188 #first some statistics
 189 my $pnum = keys(%{$package_tree});
 190 my %s_hash;
 191 my $errors = 0;
 192 foreach my $package (keys(%{$package_tree})) {
 193         $errors++ if $package_tree->{$package}->{'status'} eq "ERROR";
 194         if (! exists  $s_hash{ $package_tree->{$package}->{'source'} }) {
 195                 $s_hash{$package_tree->{$package}->{'source'}} = 1;
 196         }
 197 }
 198
 199 my $snum = keys(%s_hash);
 200 open ($fh, '>', $config->{reportdir}."/index.html") or die "Could not create indexfile '".$config->{reportdir}."/index.html': $!";
 201 print $fh start_html("Report for " . $config->{title});
 202 print $fh "<center><h2>Report for " . $config->{title} . "</h2>";
 203 print $fh "<b>Packages:</b> $pnum<br>";
 204 print $fh "<b>Sources:</b> $snum<br>";
 205 print $fh "<b>Errors:</b> $errors (" . $errors/$snum*100 . "%)<br>";
 206 print $fh "<a href='sources.list'>Sources list of the chroot</a><br><br>";
 207 print $fh $t;
 208 print $fh end_html;
 209 close ($fh);