mirror of https://gitee.com/openkylin/lintian.git
518 lines
15 KiB
Perl
518 lines
15 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# Lintian reporting harness -- Create and maintain Lintian reports automatically
|
|
#
|
|
# Copyright (C) 1998 Christian Schwarz and Richard Braakman
|
|
#
|
|
# This program is free software. It is distributed under the terms of
|
|
# the GNU General Public License as published by the Free Software
|
|
# Foundation; either version 2 of the License, or (at your option) any
|
|
# later version.
|
|
#
|
|
# This program is distributed in the hope that it will be useful,
|
|
# but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
# GNU General Public License for more details.
|
|
#
|
|
# You should have received a copy of the GNU General Public License
|
|
# along with this program. If not, you can find it on the World Wide
|
|
# Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free
|
|
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
|
|
# MA 02110-1301, USA.
|
|
|
|
package reporting_harness;
|
|
|
|
use v5.20;
|
|
use warnings;
|
|
use utf8;
|
|
|
|
use constant BACKLOG_PROCESSING_GROUP_LIMIT => 1024;
|
|
|
|
use Date::Format qw(time2str);
|
|
use File::Copy;
|
|
use FileHandle;
|
|
use Getopt::Long;
|
|
use Path::Tiny;
|
|
use POSIX qw(strftime);
|
|
use YAML::XS ();
|
|
|
|
use Lintian::IO::Async qw(safe_qx);
|
|
use Lintian::Processable;
|
|
use Lintian::Relation::Version qw(versions_comparator);
|
|
use Lintian::Reporting::Util qw(load_state_cache save_state_cache);
|
|
use Lintian::Util qw(open_gz);
|
|
|
|
use constant EMPTY => q{};
|
|
|
|
sub usage {
|
|
print <<END;
|
|
Lintian reporting harness
|
|
Create and maintain Lintian reports automatically
|
|
|
|
Usage: harness [ -i | -f | -r | -c ]
|
|
|
|
Options:
|
|
-c clean mode, erase everything and start from scratch (implies -f)
|
|
-f full mode, blithely overwrite lintian.log
|
|
-i incremental mode, use old lintian.log data, process changes only
|
|
-r, --[no-]generate-reports
|
|
Whether to generate reports. By default, reports will be
|
|
generated at the end of a run with -i, -f or -c. It can also be
|
|
used as a standard alone "mode", where only reports are
|
|
regenerated.
|
|
--reporting-config FILE
|
|
Parse FILE as the primary configuration file. Defines which
|
|
archives to process, etc. (Default: ./config.yaml)
|
|
--dry-run pretend to do the actions without actually doing them. The
|
|
"normal" harness output will go to stdout rather than the
|
|
harness.log.
|
|
--to-stdout
|
|
[For debugging] Have output go to stdout as well as the usual
|
|
log files. Note, this option has no (extra) effect with --dry-run.
|
|
--schedule-chunk-size N
|
|
Schedule at most N groups in a given run of Lintian. If more than N
|
|
groups need to be processed, harness will invoke Lintian more than
|
|
once. If N is 0, schedule all groups in one go. (Default: 512)
|
|
--schedule-limit-groups N
|
|
Schedule at most N groups in this run of harness. If more than N
|
|
groups need to be processed, harness leave the rest for a subsequent
|
|
run. (Default: ${\BACKLOG_PROCESSING_GROUP_LIMIT})
|
|
|
|
Incremental mode is the default if you have a lintian.log;
|
|
otherwise, it's full.
|
|
|
|
Report bugs to <lintian-maint\@debian.org>.
|
|
END
|
|
#'/# for cperl-mode
|
|
exit;
|
|
}
|
|
|
|
my %opt = (
|
|
'schedule-chunk-size' => 512,
|
|
'schedule-limit-groups' => BACKLOG_PROCESSING_GROUP_LIMIT,
|
|
'reporting-config' => './config.yaml',
|
|
);
|
|
|
|
my %opthash = (
|
|
'i' => \$opt{'incremental-mode'},
|
|
'c' => \$opt{'clean-mode'},
|
|
'f' => \$opt{'full-mode'},
|
|
'generate-reports|r!' => \$opt{'generate-reports'},
|
|
'reporting-config=s'=> \$opt{'reporting-config'},
|
|
'dry-run' => \$opt{'dry-run'},
|
|
'schedule-chunk-size=i' => \$opt{'schedule-chunk-size'},
|
|
'schedule-limit-groups=i' => \$opt{'schedule-limit-groups'},
|
|
'to-stdout' => \$opt{'to-stdout'},
|
|
'help|h' => \&usage,
|
|
);
|
|
|
|
# Global variables
|
|
my (
|
|
$log_file, $lintian_log, $lintian_perf_log,
|
|
$html_reports_log,$sync_state_log, $lintian_cmd,
|
|
$STATE_DIR, $LINTIAN_VERSION, $LOG_FD,
|
|
$CONFIG,$LOG_DIR, $HTML_DIR,
|
|
$HTML_TMP_DIR,$LINTIAN_SCRATCH_SPACE, $LINTIAN_BASE,
|
|
$EXTRA_LINTIAN_OPTIONS,
|
|
);
|
|
|
|
sub required_cfg_value {
|
|
my (@keys) = @_;
|
|
my $v = $CONFIG;
|
|
for my $key (@keys) {
|
|
if (not exists($v->{$key})) {
|
|
my $k = join('.', @keys);
|
|
die("Missing required config parameter: ${k}\n");
|
|
}
|
|
$v = $v->{$key};
|
|
}
|
|
return $v;
|
|
}
|
|
|
|
sub required_cfg_list_value {
|
|
my (@keys) = @_;
|
|
my $v = required_cfg_value(@keys);
|
|
if (not defined($v) or ref($v) ne 'ARRAY') {
|
|
my $k = join('.', @keys);
|
|
die("Invalid configuration: ${k} must be a (possibly empty) list\n");
|
|
}
|
|
return $v;
|
|
}
|
|
|
|
sub main {
|
|
parse_options_and_config();
|
|
|
|
# turn file buffering off
|
|
STDOUT->autoflush;
|
|
|
|
unless ($opt{'dry-run'}) {
|
|
# rotate log files
|
|
my @rotate_logs
|
|
= ($log_file, $html_reports_log, $lintian_perf_log, $sync_state_log);
|
|
safe_qx('savelog', @rotate_logs);
|
|
|
|
# create new log file
|
|
open($LOG_FD, '>', $log_file)
|
|
or die("cannot open log file $log_file for writing: $!");
|
|
$LOG_FD->autoflush;
|
|
} else {
|
|
$opt{'to-stdout'} = 0;
|
|
open($LOG_FD, '>&', \*STDOUT)
|
|
or die "Cannot open log file <stdout> for writing: $!";
|
|
Log('Running in dry-run mode');
|
|
}
|
|
# From here on we can use Log() and Die().
|
|
if (not $opt{'dry-run'} and $opt{'clean-mode'}) {
|
|
Log('Purging old state-cache/dir');
|
|
path($STATE_DIR)->remove_tree;
|
|
}
|
|
|
|
if (not -d $STATE_DIR) {
|
|
path($STATE_DIR)->mkpath;
|
|
Log("Created cache dir: $STATE_DIR");
|
|
}
|
|
|
|
if ( !$opt{'generate-reports'}
|
|
&& !$opt{'full-mode'}
|
|
&& !$opt{'incremental-mode'}) {
|
|
# Nothing explicitly chosen, default to -i if the log is present,
|
|
# otherwise -f.
|
|
if (-f $lintian_log) {
|
|
$opt{'incremental-mode'} = 1;
|
|
} else {
|
|
$opt{'full-mode'} = 1;
|
|
}
|
|
}
|
|
|
|
# Default to yes, if not explicitly disabled.
|
|
$opt{'generate-reports'} //= 1;
|
|
|
|
if ($opt{'incremental-mode'} or $opt{'full-mode'}) {
|
|
run_lintian();
|
|
}
|
|
|
|
if ($opt{'generate-reports'}) {
|
|
generate_reports();
|
|
}
|
|
|
|
# ready!!! :-)
|
|
Log('All done.');
|
|
exit 0;
|
|
}
|
|
|
|
# -------------------------------
|
|
|
|
sub parse_options_and_config {
|
|
|
|
# init commandline parser
|
|
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
|
|
|
|
# process commandline options
|
|
GetOptions(%opthash)
|
|
or die("error parsing options\n");
|
|
|
|
# clean implies full - do this as early as possible, so we can just
|
|
# check $opt{'full-mode'} rather than a full
|
|
# ($opt{'clean-mode'} || $opt{'full-mode'})
|
|
$opt{'full-mode'} = 1 if $opt{'clean-mode'};
|
|
|
|
die("Cannot use both incremental and full/clean.\n")
|
|
if $opt{'incremental-mode'} && $opt{'full-mode'};
|
|
die("The argument for --schedule-limit-groups must be an > 0\n")
|
|
if $opt{'schedule-limit-groups'} < 1;
|
|
if (not $opt{'reporting-config'} or not -f $opt{'reporting-config'}) {
|
|
die("The --reporting-config parameter must point to an existing file\n"
|
|
);
|
|
}
|
|
# read configuration
|
|
$CONFIG = YAML::XS::LoadFile($opt{'reporting-config'});
|
|
$LOG_DIR = required_cfg_value('storage', 'log-dir');
|
|
$HTML_DIR = required_cfg_value('storage', 'reports-dir');
|
|
$HTML_TMP_DIR = required_cfg_value('storage', 'reports-work-dir');
|
|
$STATE_DIR = required_cfg_value('storage', 'state-cache');
|
|
$LINTIAN_SCRATCH_SPACE = required_cfg_value('storage', 'scratch-space');
|
|
|
|
if ( exists($CONFIG->{'lintian'})
|
|
&& exists($CONFIG->{'lintian'}{'extra-options'})) {
|
|
$EXTRA_LINTIAN_OPTIONS
|
|
= required_cfg_list_value('lintian', 'extra-options');
|
|
} else {
|
|
$EXTRA_LINTIAN_OPTIONS = [];
|
|
}
|
|
|
|
$LINTIAN_BASE = $ENV{'LINTIAN_BASE'};
|
|
|
|
$lintian_cmd = "$LINTIAN_BASE/bin/lintian";
|
|
|
|
$LINTIAN_VERSION= safe_qx("$LINTIAN_BASE/bin/lintian",'--print-version');
|
|
chomp($LINTIAN_VERSION);
|
|
|
|
(
|
|
$log_file, $lintian_log, $lintian_perf_log,$html_reports_log,
|
|
$sync_state_log
|
|
)
|
|
= map {"$LOG_DIR/$_" }
|
|
qw(harness.log lintian.log lintian-perf.log html_reports.log sync_state.log);
|
|
|
|
return;
|
|
}
|
|
|
|
sub run_lintian {
|
|
my @sync_state_args = (
|
|
'--reporting-config', $opt{'reporting-config'},
|
|
'--desired-version', $LINTIAN_VERSION,'--debug',
|
|
);
|
|
my @lintian_harness_args = (
|
|
'--lintian-frontend', "$LINTIAN_BASE/bin/lintian",
|
|
'--lintian-log-dir', $LOG_DIR,
|
|
'--schedule-chunk-size', $opt{'schedule-chunk-size'},
|
|
'--schedule-limit-groups', $opt{'schedule-limit-groups'},
|
|
'--state-dir', $STATE_DIR,
|
|
# Finish with the lintian command-line
|
|
'--', @{$EXTRA_LINTIAN_OPTIONS});
|
|
|
|
if ($opt{'full-mode'}) {
|
|
push(@sync_state_args, '--reschedule-all');
|
|
}
|
|
if ($opt{'dry-run'}) {
|
|
push(@sync_state_args, '--dry-run');
|
|
}
|
|
|
|
if ($LINTIAN_SCRATCH_SPACE) {
|
|
unshift(@lintian_harness_args,
|
|
'--lintian-scratch-space', $LINTIAN_SCRATCH_SPACE);
|
|
}
|
|
|
|
Log('Updating harness state cache (reading mirror index files)');
|
|
|
|
my $loop = IO::Async::Loop->new;
|
|
my $syncdone = $loop->new_future;
|
|
|
|
my @synccommand = ($lintian_cmd, 'reporting-sync-state', @sync_state_args);
|
|
Log('Command: ' . join(' ', @synccommand));
|
|
|
|
my $syncprocess = IO::Async::Process->new(
|
|
command => [@synccommand],
|
|
stdout => { via => 'pipe_read' },
|
|
stderr => { via => 'pipe_read' },
|
|
on_finish => sub {
|
|
my ($self, $exitcode) = @_;
|
|
my $status = ($exitcode >> 8);
|
|
|
|
if ($status) {
|
|
Log("warning: executing reporting-sync-state returned $status"
|
|
);
|
|
my $message= "Non-zero status $status from @synccommand";
|
|
$syncdone->fail($message);
|
|
return;
|
|
}
|
|
|
|
$syncdone->done("Done with @synccommand");
|
|
return;
|
|
});
|
|
|
|
my $syncfh = *STDOUT;
|
|
unless($opt{'dry-run'}) {
|
|
open($syncfh, '>', $sync_state_log)
|
|
or die "Could not open file '$sync_state_log': $!";
|
|
}
|
|
|
|
$syncprocess->stdout->configure(
|
|
on_read => sub {
|
|
my ($stream, $buffref, $eof) = @_;
|
|
|
|
if (length $$buffref) {
|
|
print {$syncfh} $$buffref;
|
|
$$buffref = EMPTY;
|
|
}
|
|
|
|
if ($eof) {
|
|
close($syncfh)
|
|
unless $opt{'dry-run'};
|
|
}
|
|
|
|
return 0;
|
|
},
|
|
);
|
|
|
|
$syncprocess->stderr->configure(
|
|
on_read => sub {
|
|
my ($stream, $buffref, $eof) = @_;
|
|
|
|
if (length $$buffref) {
|
|
print STDERR $$buffref;
|
|
$$buffref = EMPTY;
|
|
}
|
|
|
|
return 0;
|
|
},
|
|
);
|
|
|
|
$loop->add($syncprocess);
|
|
$syncdone->await;
|
|
|
|
Log('Running lintian (via reporting-lintian-harness)');
|
|
Log(
|
|
'Command: '
|
|
. join(' ',
|
|
$lintian_cmd, 'reporting-lintian-harness',@lintian_harness_args));
|
|
my %harness_lintian_opts = (
|
|
'pipe_out' => FileHandle->new,
|
|
'err' => '&1',
|
|
'fail' => 'never',
|
|
);
|
|
|
|
if (not $opt{'dry-run'}) {
|
|
spawn(\%harness_lintian_opts,
|
|
[$lintian_cmd, 'reporting-lintian-harness', @lintian_harness_args]
|
|
);
|
|
my $child_out = $harness_lintian_opts{'pipe_out'};
|
|
while (my $line = <$child_out>) {
|
|
chomp($line);
|
|
Log_no_ts($line);
|
|
}
|
|
close($child_out);
|
|
if (not reap(\%harness_lintian_opts)) {
|
|
my $exit_code = $harness_lintian_opts{harness}->full_result;
|
|
my $res = ($exit_code >> 8) & 0xff;
|
|
my $sig = $exit_code & 0xff;
|
|
# Exit code 2 is "time-out", 3 is "lintian got signalled"
|
|
# 255 => reporting-lintian-harness caught an unhandled trappable
|
|
# error.
|
|
if ($res) {
|
|
if ($res == 255) {
|
|
Die('Lintian harness died with an unhandled exception');
|
|
} elsif ($res == 3) {
|
|
Log('Lintian harness stopped early due to signal');
|
|
if ($opt{'generate-reports'}) {
|
|
Log('Skipping report generation');
|
|
$opt{'generate-reports'} = 0;
|
|
}
|
|
} elsif ($res != 2) {
|
|
Die("Lintian harness terminated with code $res");
|
|
}
|
|
} elsif ($sig) {
|
|
Die("Lintian harness was killed by signal $sig");
|
|
}
|
|
}
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub generate_reports {
|
|
my @html_reports_args
|
|
= ('--reporting-config',$opt{'reporting-config'},$lintian_log,);
|
|
# create html reports
|
|
Log('Creating HTML reports...');
|
|
Log("Executing $lintian_cmd reporting-html-reports @html_reports_args");
|
|
|
|
my $loop = IO::Async::Loop->new;
|
|
my $htmldone = $loop->new_future;
|
|
|
|
my @htmlcommand
|
|
= ($lintian_cmd, 'reporting-html-reports', @html_reports_args);
|
|
my $htmlprocess = IO::Async::Process->new(
|
|
command => [@htmlcommand],
|
|
stdout => { via => 'pipe_read' },
|
|
stderr => { via => 'pipe_read' },
|
|
on_finish => sub {
|
|
my ($self, $exitcode) = @_;
|
|
my $status = ($exitcode >> 8);
|
|
|
|
if ($status) {
|
|
Log(
|
|
"warning: executing reporting-html-reports returned $status"
|
|
);
|
|
my $message= "Non-zero status $status from @htmlcommand";
|
|
$htmldone->fail($message);
|
|
return;
|
|
}
|
|
|
|
$htmldone->done("Done with @htmlcommand");
|
|
return;
|
|
});
|
|
|
|
open(my $htmlfh, '>', $html_reports_log)
|
|
or die "Could not open file '$html_reports_log': $!";
|
|
|
|
$htmlprocess->stdout->configure(
|
|
on_read => sub {
|
|
my ($stream, $buffref, $eof) = @_;
|
|
|
|
if (length $$buffref) {
|
|
print {$htmlfh} $$buffref;
|
|
$$buffref = EMPTY;
|
|
}
|
|
|
|
close($htmlfh)
|
|
if $eof;
|
|
|
|
return 0;
|
|
},
|
|
);
|
|
|
|
$htmlprocess->stderr->configure(
|
|
on_read => sub {
|
|
my ($stream, $buffref, $eof) = @_;
|
|
|
|
if (length $$buffref) {
|
|
print STDERR $$buffref;
|
|
$$buffref = EMPTY;
|
|
}
|
|
|
|
return 0;
|
|
},
|
|
);
|
|
|
|
$loop->add($htmlprocess);
|
|
$htmldone->await;
|
|
|
|
Log('');
|
|
|
|
# rotate the statistics file updated by reporting-html-reports
|
|
if (!$opt{'dry-run'} && -f "$STATE_DIR/statistics") {
|
|
my $date = time2str('%Y%m%d', time());
|
|
my $dest = "$LOG_DIR/stats/statistics-${date}";
|
|
copy("$STATE_DIR/statistics", $dest)
|
|
or Log('warning: could not rotate the statistics file');
|
|
}
|
|
|
|
# install new html directory
|
|
Log('Installing HTML reports...');
|
|
unless ($opt{'dry-run'}) {
|
|
path($HTML_DIR)->remove_tree;
|
|
# a tiny bit of race right here
|
|
rename($HTML_TMP_DIR,$HTML_DIR)
|
|
or Die("error renaming $HTML_TMP_DIR into $HTML_DIR");
|
|
}
|
|
Log('');
|
|
return;
|
|
}
|
|
|
|
sub Log {
|
|
my ($msg) = @_;
|
|
my $ts = strftime('[%FT%T]', localtime());
|
|
Log_no_ts("${ts}: ${msg}");
|
|
return;
|
|
}
|
|
|
|
sub Log_no_ts {
|
|
my ($msg) = @_;
|
|
print {$LOG_FD} $msg,"\n";
|
|
print $msg, "\n" if $opt{'to-stdout'};
|
|
return;
|
|
}
|
|
|
|
sub Die {
|
|
Log("fatal error: $_[0]");
|
|
exit 1;
|
|
}
|
|
|
|
1;
|
|
|
|
# Local Variables:
|
|
# indent-tabs-mode: nil
|
|
# cperl-indent-level: 4
|
|
# End:
|
|
# vim: syntax=perl sw=4 sts=4 sr et
|