Update sources suite
[grml-infrastructure.git] / 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");