3 # Lintian reporting harness -- Create and maintain Lintian reports automatically
5 # Copyright (C) 1998 Christian Schwarz and Richard Braakman
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
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.
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,
26 use vars qw($opt_c $opt_f $opt_i $opt_r);
27 unless (getopts('cfir')) {
29 Lintian reporting harness
30 Create and maintain Lintian reports automatically
32 Usage: harness [ -i | -c [-f] ] [ -r ]
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
40 Incremental mode is the default if you have a lintian.log;
43 Report bugs to <lintian-maint\@debian.org>.
48 die "Can't use both incremental and full/clean." if ($opt_i && ($opt_f || $opt_c));
50 die "Can't use other modes with reports only." if ($opt_r && ($opt_i || $opt_f || $opt_c));
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);
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
68 # turn file buffering off
72 system("savelog $log_file $changes_file $list_file $html_reports_log >/dev/null") == 0
73 or Die("cannot rotate log files");
76 open(LOG, '>', $log_file)
77 or Die("cannot open log file $log_file for writing: $!");
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;
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 "$!";
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");
106 unless ($opt_f || $opt_c) {
108 if (-f $lintian_log) {
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");
126 if ($opt_i) { # process changes only
128 die "Old Lintian log file $lintian_log not found!\n" unless -f $lintian_log;
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);
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);
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);
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: $!");
159 if (/^N: Listed (changed|new) (binary|udeb|source) package (\S+) (\S+)/o) {
160 my ($type,$binsrc,$pkg,$ver) = ($1,$2,$3,$4);
162 Log("$type $binsrc package $pkg $ver");
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;
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;
180 } elsif (/^N: Removed (binary|udeb|source) package (\S+)/o) {
181 my ($binsrc,$pkg) = ($1,$2);
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;
191 $skip_source{$pkg} = 1;
196 Log("skipping changes line: $_");
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: $!");
212 if (/^N: Processing (binary|udeb|source) package (\S+)/o) {
213 my ($type,$pkg) = ($1,$2);
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};
220 $copy_mode = not exists $skip_source{$pkg};
228 print OUT "N: ---end-of-old-lintian-log-file---\n";
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");
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 $?");
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");
255 #Log("Creating depcheck pages...");
256 #run("$LINTIAN_ROOT/depcheck/deppages.pl >>$html_reports_log")
257 # or Log("warning: executing deppages.pl returned $?");
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");
273 # -------------------------------
276 print LOG $_[0],"\n";
280 Log("Executing $_[0]");
281 return (system($_[0]) == 0);
285 Log("fatal error: $_[0]");