3d768d2d758e4f0b1f95c7bf7a7dc07dfdae6565
[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: 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);