diff options
Diffstat (limited to 'commands/reporting-harness.pm')
| -rw-r--r-- | commands/reporting-harness.pm | 517 |
1 files changed, 517 insertions, 0 deletions
diff --git a/commands/reporting-harness.pm b/commands/reporting-harness.pm new file mode 100644 index 0000000..89bf2c6 --- /dev/null +++ b/commands/reporting-harness.pm @@ -0,0 +1,517 @@ +#!/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 |