vcs.maemo.org Git - maemian/blob - nokia-lintian/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   exit;
  46 }
  47
  48 die "Can't use both incremental and full/clean." if ($opt_i && ($opt_f || $opt_c));
  49 $opt_f = 1 if $opt_c;
  50 die "Can't use other modes with reports only." if ($opt_r && ($opt_i || $opt_f || $opt_c));
  51
  52 # read configuration
  53 require './config';
  54 use vars qw($LINTIAN_ROOT $LINTIAN_LAB $LINTIAN_ARCHIVEDIR $LINTIAN_DIST
  55             $LINTIAN_SECTION $LINTIAN_ARCH $LINTIAN_UNPACK_LEVEL $LINTIAN_CFG
  56             $lintian_cmd $html_reports_cmd
  57             $log_file $lintian_log $old_lintian_log
  58             $changes_file $list_file $html_reports_log
  59             $LOG_DIR $statistics_file
  60             $HTML_DIR $HTML_TMP_DIR);
  61
  62 # import perl libraries
  63 unshift @INC, "$LINTIAN_ROOT/lib";
  64 require Read_pkglists;
  65 use vars qw(%binary_info %source_info %udeb_info); # from the above
  66 require Util;
  67
  68 # turn file buffering off
  69 $| = 1;
  70
  71 # rotate log files
  72 system("savelog $log_file $changes_file $list_file $html_reports_log >/dev/null") == 0
  73     or Die("cannot rotate log files");
  74
  75 # create new log file
  76 open(LOG, '>', $log_file)
  77     or Die("cannot open log file $log_file for writing: $!");
  78
  79 # export Lintian's configuration
  80 $ENV{'LINTIAN_ROOT'} = $LINTIAN_ROOT;
  81 $ENV{'LINTIAN_CFG'} = $LINTIAN_CFG;
  82 $ENV{'LINTIAN_LAB'} = $LINTIAN_LAB;
  83 $ENV{'LINTIAN_ARCHIVEDIR'} = $LINTIAN_ARCHIVEDIR;
  84 $ENV{'LINTIAN_DIST'} = $LINTIAN_DIST;
  85 $ENV{'LINTIAN_UNPACK_LEVEL'} = $LINTIAN_UNPACK_LEVEL;
  86 $ENV{'LINTIAN_SECTION'} = $LINTIAN_SECTION;
  87 $ENV{'LINTIAN_ARCH'} = $LINTIAN_ARCH;
  88
  89 if ($opt_c) { # purge the old packages
  90   system("rm -rf $LINTIAN_LAB/binary") == 0 || die "$!";
  91   system("mkdir -m 2775 $LINTIAN_LAB/binary") == 0 || die "$!";
  92   system("rm -rf $LINTIAN_LAB/udeb") == 0 || die "$!";
  93   system("mkdir -m 2775 $LINTIAN_LAB/udeb") == 0 || die "$!";
  94   system("rm -rf $LINTIAN_LAB/source") == 0 || die "$!";
  95   system("mkdir -m 2775 $LINTIAN_LAB/source") == 0 || die "$!";
  96   system("rm -f $LINTIAN_LAB/info/*") == 0 || die "$!";
  97 }
  98
  99 unless ($opt_r) {
 100   # make lintian update its packages files and save output
 101   run("$lintian_cmd -v --setup-lab >$changes_file")
 102       or Die("cannot run lintian --setup-lab");
 103   Log("");
 104 }
 105
 106 unless ($opt_f || $opt_c) {
 107   unless ($opt_r) {
 108     if (-f $lintian_log) {
 109       $opt_i = 1;
 110     } else {
 111       $opt_f = 1;
 112     }
 113   }
 114 }
 115
 116 if ($opt_f) { # check all packages
 117   Log("Running Lintian over all packages...");
 118   my $cmd = "$lintian_cmd -I -E -v -a --show-overrides -U changelog-file >$lintian_log";
 119   Log("Executing $cmd");
 120   my $res = (system($cmd) >> 8);
 121   (($res == 0) or ($res == 1))
 122     or Log("warning: executing lintian returned $res");
 123   Log("");
 124 }
 125
 126 if ($opt_i) { # process changes only
 127
 128     die "Old Lintian log file $lintian_log not found!\n" unless -f $lintian_log;
 129
 130     my $pkgfile;
 131     my %skip_binary;
 132     my %skip_udeb;
 133     my %skip_source;
 134
 135     # read binary packages files
 136     $pkgfile = "$LINTIAN_LAB/info/binary-packages";
 137     (-f $pkgfile) or Die("cannot find list of binary packages $pkgfile");
 138     read_bin_list($pkgfile);
 139
 140     # read udeb packages files
 141     $pkgfile = "$LINTIAN_LAB/info/udeb-packages";
 142     (-f $pkgfile) or Die("cannot find list of udeb packages $pkgfile");
 143     read_udeb_list($pkgfile);
 144
 145     # read source packages files
 146     $pkgfile = "$LINTIAN_LAB/info/source-packages";
 147     (-f $pkgfile) or Die("cannot find list of source packages $pkgfile");
 148     read_src_list($pkgfile);
 149
 150     # process changes file and create list of packages to process
 151     Log("Reading changes file...");
 152     open(IN, '<', $changes_file)
 153         or Die("cannot open changes file $changes_file for reading: $!");
 154     open(OUT, '>', $list_file)
 155         or Die("cannot open list file $list_file for writing: $!");
 156     while (<IN>) {
 157         chop;
 158
 159         if (/^N: Listed (changed|new) (binary|udeb|source) package (\S+) (\S+)/o) {
 160             my ($type,$binsrc,$pkg,$ver) = ($1,$2,$3,$4);
 161
 162             Log("$type $binsrc package $pkg $ver");
 163
 164             if ($binsrc eq 'binary') {
 165                 my $data = $binary_info{$pkg};
 166                 $data or Die("cannot find binary package $pkg in binary-packages file");
 167                 print OUT "b $binary_info{$pkg}->{'package'} $binary_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$binary_info{$pkg}->{'file'}\n";
 168                 $skip_binary{$pkg} = 1;
 169             } elsif ($binsrc eq 'udeb') {
 170                 my $data = $udeb_info{$pkg};
 171                 $data or Die("cannot find udeb package $pkg in udeb-packages file");
 172                 print OUT "u $udeb_info{$pkg}->{'package'} $udeb_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$udeb_info{$pkg}->{'file'}\n";
 173                 $skip_udeb{$pkg} = 1;
 174             } else {
 175                 my $data = $source_info{$pkg};
 176                 $data or Die("cannot find source package $pkg in source-packages file");
 177                 print OUT "s $source_info{$pkg}->{'source'} $source_info{$pkg}->{'version'} $LINTIAN_ARCHIVEDIR/$source_info{$pkg}->{'file'}\n";
 178                 $skip_source{$pkg} = 1;
 179             }
 180         } elsif (/^N: Removed (binary|udeb|source) package (\S+)/o) {
 181             my ($binsrc,$pkg) = ($1,$2);
 182
 183             Log("removed $binsrc package $pkg");
 184             run("rm -r -- \"$LINTIAN_LAB/$binsrc/$pkg\"")
 185                 or Log("could not remove $binsrc package $pkg");
 186             if ($binsrc eq 'binary') {
 187                 $skip_binary{$pkg} = 1;
 188             } elsif ($binsrc eq 'udeb') {
 189                 $skip_udeb{$pkg} = 1;
 190             } else {
 191                 $skip_source{$pkg} = 1;
 192             }
 193         } elsif (/^N/o) {
 194             # ignore other notes
 195         } else {
 196             Log("skipping changes line: $_");
 197         }
 198     }
 199     close(OUT);
 200     close(IN);
 201     Log("");
 202
 203     # update lintian.log
 204     Log("Updating lintian.log...");
 205     rename $lintian_log, $old_lintian_log;
 206     open(IN, '<', $old_lintian_log)
 207         or Die("cannot open old lintian.log $old_lintian_log for reading: $!");
 208     open(OUT, '>', $lintian_log)
 209         or Die("cannot open lintian.log $lintian_log for writing: $!");
 210     my $copy_mode = 1;
 211     while (<IN>) {
 212         if (/^N: Processing (binary|udeb|source) package (\S+)/o) {
 213             my ($type,$pkg) = ($1,$2);
 214
 215             if ($type eq 'binary') {
 216                 $copy_mode = not exists $skip_binary{$pkg};
 217             } elsif ($type eq 'udeb') {
 218                 $copy_mode = not exists $skip_udeb{$pkg};
 219             } else {
 220                 $copy_mode = not exists $skip_source{$pkg};
 221             }
 222         }
 223
 224         if ($copy_mode) {
 225             print OUT $_;
 226         }
 227     }
 228     print OUT "N: ---end-of-old-lintian-log-file---\n";
 229     close(OUT);
 230     close(IN);
 231     Log("");
 232
 233     # run Lintian over the newly introduced or changed packages
 234     Log("Running Lintian over newly introduced and changed packages...");
 235     my $cmd = "$lintian_cmd -I -E -v --show-overrides -p $list_file -U changelog-file >>$lintian_log";
 236     Log("Executing $cmd");
 237     my $res = (system($cmd) >> 8);
 238     (($res == 0) or ($res == 1))
 239         or Log("warning: executing lintian returned $res");
 240     Log("");
 241 }
 242
 243 # create html reports
 244 Log("Creating HTML reports...");
 245 run("$html_reports_cmd $lintian_log >$html_reports_log 2>&1")
 246     or Log("warning: executing $html_reports_cmd returned $?");
 247 Log("");
 248
 249 # rotate the statistics file updated by $html_reports_cmd
 250 if (-f $statistics_file) {
 251   system("cp $statistics_file $LOG_DIR/stats/statistics-`date +%Y%m%d`") == 0
 252     or Log("warning: couldn't rotate the statistics file");
 253 }
 254
 255 #Log("Creating depcheck pages...");
 256 #run("$LINTIAN_ROOT/depcheck/deppages.pl >>$html_reports_log")
 257 #    or Log("warning: executing deppages.pl returned $?");
 258 #Log("");
 259
 260 # install new html directory
 261 Log("Installing HTML reports...");
 262 system("rm -rf $HTML_DIR") == 0
 263     or Die("error removing $HTML_DIR");
 264 # a tiny bit of race right here
 265 rename($HTML_TMP_DIR,$HTML_DIR)
 266     or Die("error renaming $HTML_TMP_DIR into $HTML_DIR");
 267 Log("");
 268
 269 # ready!!! :-)
 270 Log("All done.");
 271 exit 0;
 272
 273 # -------------------------------
 274
 275 sub Log {
 276     print LOG $_[0],"\n";
 277 }
 278
 279 sub run {
 280     Log("Executing $_[0]");
 281     return (system($_[0]) == 0);
 282 }
 283
 284 sub Die {
 285     Log("fatal error: $_[0]");
 286     exit 1;
 287 }