vcs.maemo.org Git - maemian/blob - reporting/harness

   1 #!/usr/bin/perl
   2 #
   3 # Lintian reporting harness -- Create and maintain Lintian reports automatically
   4 #
   5 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
   6 #
   7 # This program is free software.  It is distributed under the terms of
   8 # the GNU General Public License as published by the Free Software
   9 # Foundation; either version 2 of the License, or (at your option) any
  10 # later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, you can find it on the World Wide
  19 # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  20 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  21 # MA 02110-1301, USA.
  22
  23 use strict;
  24 use Getopt::Std;
  25
  26 use vars qw($opt_c $opt_f $opt_i $opt_r);
  27 unless (getopts('cfir')) {
  28   print <<END;
  29 Lintian reporting harness
  30 Create and maintain Lintian reports automatically
  31
  32 Usage: harness [ -i | -c [-f] ] [ -r ]
  33
  34 Options:
  35   -c    clean mode, erase everything and start from scratch
  36   -f    full mode, blithely overwrite lintian.log
  37   -i    incremental mode, use old lintian.log data, process changes only
  38   -r    generate HTML reports only
  39
  40 Incremental mode is the default if you have a lintian.log;
  41 otherwise, it's full.
  42
  43 Report bugs to <lintian-maint\@debian.org>.
  44 END
  45 #'# for cperl-mode
  46   exit;
  47 }
  48
  49 die "Can't use both incremental and full/clean." if ($opt_i && ($opt_f || $opt_c));
  50 $opt_f = 1 if $opt_c;
  51 die "Can't use other modes with reports only." if ($opt_r && ($opt_i || $opt_f || $opt_c));
  52
  53 # read configuration
  54 require './config';
  55 use vars qw($LINTIAN_ROOT $LINTIAN_LAB $LINTIAN_ARCHIVEDIR $LINTIAN_DIST
  56             $LINTIAN_SECTION $LINTIAN_ARCH $LINTIAN_UNPACK_LEVEL $LINTIAN_CFG
  57             $lintian_cmd $html_reports_cmd
  58             $log_file $lintian_log $old_lintian_log
  59             $changes_file $list_file $html_reports_log
  60             $LOG_DIR $statistics_file
  61             $HTML_DIR $HTML_TMP_DIR $LINTIAN_BIN_DIR $LINTIAN_GPG_CHECK
  62             $LINTIAN_AREA);
  63
  64 # import perl libraries
  65 unshift @INC, "$LINTIAN_ROOT/lib";
  66 require Read_pkglists;
  67 use vars qw(%binary_info %source_info %udeb_info); # from the above
  68 require Util;
  69
  70 # turn file buffering off
  71 $| = 1;
  72
  73 # rotate log files
  74 system("savelog $log_file $changes_file $list_file $html_reports_log >/dev/null") == 0
  75     or Die("cannot rotate log files");
  76
  77 # create new log file
  78 open(LOG, '>', $log_file)
  79     or Die("cannot open log file $log_file for writing: $!");
  80
  81 system("mkdir -p -m 775 $LINTIAN_BIN_DIR") == 0 || die "$!";
  82
  83 # export Lintian's configuration
  84 $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT;
  85 $ENV{'LINTIAN_CFG'} = $LINTIAN_CFG;
  86 $ENV{'LINTIAN_LAB'} = $LINTIAN_LAB;
  87 $ENV{'LINTIAN_ARCHIVEDIR'} = $LINTIAN_ARCHIVEDIR;
  88 $ENV{'LINTIAN_DIST'} = $LINTIAN_DIST;
  89 $ENV{'LINTIAN_UNPACK_LEVEL'} = $LINTIAN_UNPACK_LEVEL;
  90 # LINTIAN_SECTION is deprecated in favour of LINTIAN_AREA
  91 if (defined $LINTIAN_SECTION) {
  92     print STDERR "warning: LINTIAN_SECTION has been deprecated in favour of LINTIAN_AREA.\n";
  93     if (defined $LINTIAN_AREA) {
  94         print STDERR "Using LINTIAN_AREA as both were defined.\n";
  95     } else {
  96         print STDERR "Both are currently accepted, but LINTIAN_SECTION may be removed\n";
  97         print STDERR "in a future Lintian release.\n";
  98         $LINTIAN_AREA = $LINTIAN_SECTION;
  99     }
 100 }
 101 $ENV{'LINTIAN_AREA'} = $LINTIAN_AREA;
 102 $ENV{'LINTIAN_ARCH'} = $LINTIAN_ARCH;
 103 $ENV{'PATH'} = $LINTIAN_BIN_DIR . ':' . $ENV{'PATH'};
 104
 105 if ($LINTIAN_GPG_CHECK) {
 106   if (-l $LINTIAN_BIN_DIR . '/gpg') {
 107     unlink($LINTIAN_BIN_DIR . '/gpg');
 108   } else {
 109     rename($LINTIAN_BIN_DIR . '/gpg', $LINTIAN_BIN_DIR . '/gpg.bkp');
 110   }
 111 } else {
 112   symlink '/bin/true', $LINTIAN_BIN_DIR . '/gpg'
 113     unless(-f $LINTIAN_BIN_DIR . '/gpg');
 114 }
 115
 116 if ($opt_c) { # purge the old packages
 117   system("rm -rf $LINTIAN_LAB/binary") == 0 || die "$!";
 118   system("mkdir -m 2775 $LINTIAN_LAB/binary") == 0 || die "$!";
 119   system("rm -rf $LINTIAN_LAB/udeb") == 0 || die "$!";
 120   system("mkdir -m 2775 $LINTIAN_LAB/udeb") == 0 || die "$!";
 121   system("rm -rf $LINTIAN_LAB/source") == 0 || die "$!";
 122   system("mkdir -m 2775 $LINTIAN_LAB/source") == 0 || die "$!";
 123   system("rm -f $LINTIAN_LAB/info/*") == 0 || die "$!";
 124 }
 125
 126 unless ($opt_r) {
 127   # make lintian update its packages files and save output
 128   run("$lintian_cmd -v --setup-lab >$changes_file")
 129       or Die("cannot run lintian --setup-lab");
 130   Log("");
 131 }
 132
 133 unless ($opt_f || $opt_c) {
 134   unless ($opt_r) {
 135     if (-f $lintian_log) {
 136       $opt_i = 1;
 137     } else {
 138       $opt_f = 1;
 139     }
 140   }
 141 }
 142
 143 if ($opt_f) { # check all packages
 144   Log("Running Lintian over all packages...");
 145   my $cmd = "$lintian_cmd -I -E --pedantic -v -a --show-overrides -U changelog-file >$lintian_log 2>&1";
 146   Log("Executing $cmd");
 147   my $res = (system($cmd) >> 8);
 148   (($res == 0) or ($res == 1))
 149     or Log("warning: executing lintian returned $res");
 150   Log("");
 151 }
 152
 153 if ($opt_i) { # process changes only
 154
 155     die "Old Lintian log file $lintian_log not found!\n" unless -f $lintian_log;
 156
 157     my $pkgfile;
 158     my %skip_binary;
 159     my %skip_udeb;
 160     my %skip_source;
 161
 162     # read binary packages files
 163     $pkgfile = "$LINTIAN_LAB/info/binary-packages";
 164     (-f $pkgfile) or Die("cannot find list of binary packages $pkgfile");
 165     read_bin_list($pkgfile);
 166
 167     # read udeb packages files
 168     $pkgfile = "$LINTIAN_LAB/info/udeb-packages";
 169     (-f $pkgfile) or Die("cannot find list of udeb packages $pkgfile");
 170     read_udeb_list($pkgfile);
 171
 172     # read source packages files
 173     $pkgfile = "$LINTIAN_LAB/info/source-packages";
 174     (-f $pkgfile) or Die("cannot find list of source packages $pkgfile");
 175     read_src_list($pkgfile);
 176
 177     # process changes file and create list of packages to process
 178     Log("Reading changes file...");
 179     open(IN, '<', $changes_file)
 180         or Die("cannot open changes file $changes_file for reading: $!");
 181     open(OUT, '>', $list_file)
 182         or Die("cannot open list file $list_file for writing: $!");
 183     while (<IN>) {
 184         chop;
 185
 186         if (/^N: Listed (changed|new) (binary|udeb|source) package (\S+) (\S+)/o) {
 187             my ($type,$binsrc,$pkg,$ver) = ($1,$2,$3,$4);
 188
 189             Log("$type $binsrc package $pkg $ver");
 190
 191             if ($binsrc eq 'binary') {
 192                 my $data = $binary_info{$pkg};
 193                 $data or Die("cannot find binary package $pkg in binary-packages file");
 194                 print OUT "b $binary_info{$pkg}->{'package'} $binary_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$binary_info{$pkg}->{'file'}\n";
 195                 $skip_binary{$pkg} = 1;
 196             } elsif ($binsrc eq 'udeb') {
 197                 my $data = $udeb_info{$pkg};
 198                 $data or Die("cannot find udeb package $pkg in udeb-packages file");
 199                 print OUT "u $udeb_info{$pkg}->{'package'} $udeb_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$udeb_info{$pkg}->{'file'}\n";
 200                 $skip_udeb{$pkg} = 1;
 201             } else {
 202                 my $data = $source_info{$pkg};
 203                 $data or Die("cannot find source package $pkg in source-packages file");
 204                 print OUT "s $source_info{$pkg}->{'source'} $source_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$source_info{$pkg}->{'file'}\n";
 205                 $skip_source{$pkg} = 1;
 206             }
 207         } elsif (/^N: Removed (binary|udeb|source) package (\S+)/o) {
 208             my ($binsrc,$pkg) = ($1,$2);
 209
 210             Log("removed $binsrc package $pkg");
 211             run("rm -r -- \"$LINTIAN_LAB/$binsrc/$pkg\"")
 212                 or Log("could not remove $binsrc package $pkg");
 213             if ($binsrc eq 'binary') {
 214                 $skip_binary{$pkg} = 1;
 215             } elsif ($binsrc eq 'udeb') {
 216                 $skip_udeb{$pkg} = 1;
 217             } else {
 218                 $skip_source{$pkg} = 1;
 219             }
 220         } elsif (/^N/o) {
 221             # ignore other notes
 222         } else {
 223             Log("skipping changes line: $_");
 224         }
 225     }
 226     close(OUT);
 227     close(IN);
 228     Log("");
 229
 230     # update lintian.log
 231     Log("Updating lintian.log...");
 232     rename $lintian_log, $old_lintian_log;
 233     open(IN, '<', $old_lintian_log)
 234         or Die("cannot open old lintian.log $old_lintian_log for reading: $!");
 235     open(OUT, '>', $lintian_log)
 236         or Die("cannot open lintian.log $lintian_log for writing: $!");
 237     my $copy_mode = 1;
 238     while (<IN>) {
 239         if (/^N: Processing (binary|udeb|source) package (\S+)/o) {
 240             my ($type,$pkg) = ($1,$2);
 241
 242             if ($type eq 'binary') {
 243                 $copy_mode = not exists $skip_binary{$pkg};
 244             } elsif ($type eq 'udeb') {
 245                 $copy_mode = not exists $skip_udeb{$pkg};
 246             } else {
 247                 $copy_mode = not exists $skip_source{$pkg};
 248             }
 249         }
 250
 251         if ($copy_mode) {
 252             print OUT $_;
 253         }
 254     }
 255     print OUT "N: ---end-of-old-lintian-log-file---\n";
 256     close(OUT);
 257     close(IN);
 258     Log("");
 259
 260     # run Lintian over the newly introduced or changed packages
 261     Log("Running Lintian over newly introduced and changed packages...");
 262     my $cmd = "$lintian_cmd -I -E --pedantic -v --show-overrides -p $list_file -U changelog-file >>$lintian_log 2>&1";
 263     Log("Executing $cmd");
 264     my $res = (system($cmd) >> 8);
 265     (($res == 0) or ($res == 1))
 266         or Log("warning: executing lintian returned $res");
 267     Log("");
 268 }
 269
 270 # create html reports
 271 Log("Creating HTML reports...");
 272 run("$html_reports_cmd $lintian_log >$html_reports_log 2>&1")
 273     or Log("warning: executing $html_reports_cmd returned $?");
 274 Log("");
 275
 276 # rotate the statistics file updated by $html_reports_cmd
 277 if (-f $statistics_file) {
 278   system("cp $statistics_file $LOG_DIR/stats/statistics-`date +%Y%m%d`") == 0
 279     or Log("warning: couldn't rotate the statistics file");
 280 }
 281
 282 #Log("Creating depcheck pages...");
 283 #run("$LINTIAN_ROOT/depcheck/deppages.pl >>$html_reports_log")
 284 #    or Log("warning: executing deppages.pl returned $?");
 285 #Log("");
 286
 287 # install new html directory
 288 Log("Installing HTML reports...");
 289 system("rm -rf $HTML_DIR") == 0
 290     or Die("error removing $HTML_DIR");
 291 # a tiny bit of race right here
 292 rename($HTML_TMP_DIR,$HTML_DIR)
 293     or Die("error renaming $HTML_TMP_DIR into $HTML_DIR");
 294 Log("");
 295
 296 # ready!!! :-)
 297 Log("All done.");
 298 exit 0;
 299
 300 # -------------------------------
 301
 302 sub Log {
 303     print LOG $_[0],"\n";
 304 }
 305
 306 sub run {
 307     Log("Executing $_[0]");
 308     return (system($_[0]) == 0);
 309 }
 310
 311 sub Die {
 312     Log("fatal error: $_[0]");
 313     exit 1;
 314 }