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