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