git.gag.com Git - debian/amanda/blob - server-src/amreport.pl

   1 #! @PERL@
   2 # Copyright (c) 2010 Zmanda, Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or modify it
   5 # under the terms of the GNU General Public License version 2 as published
   6 # by the Free Software Foundation.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc., 465 S Mathlida Ave, Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 use lib '@amperldir@';
  21 use strict;
  22 use warnings;
  23
  24 use Getopt::Long;
  25 use IPC::Open3;
  26 use Cwd qw( abs_path );
  27 use FileHandle;
  28 use POSIX;
  29
  30 use Amanda::Config qw( :init :getconf config_dir_relative );
  31 use Amanda::Util qw( :constants );
  32 use Amanda::Tapelist;
  33 use Amanda::Disklist;
  34 use Amanda::Constants;
  35 use Amanda::Debug qw( debug warning );
  36 use Amanda::Report;
  37 use Amanda::Report::human;
  38 use Amanda::Logfile qw( find_latest_log);
  39
  40 # constants for dealing with outputs
  41 use constant FORMAT  => 0;
  42 use constant FMT_TYP => 0;
  43 use constant FMT_TEMPLATE => 1;
  44
  45 use constant OUTPUT  => 1;
  46 use constant OUT_TYP => 0;
  47 use constant OUT_DST => 1;
  48
  49 # what mode is this running in? MODE_SCRIPT is when run from scripts like
  50 # amdump, while MODE_CMDLINE is when run from the command line
  51 use constant MODE_NONE    => 0;
  52 use constant MODE_SCRIPT  => 1;
  53 use constant MODE_CMDLINE => 2;
  54
  55 ## Global Variables
  56
  57 my $opt_nomail = 0;
  58 my ($opt_mailto, $opt_filename, $opt_logfname, $opt_psfname, $opt_xml);
  59 my ($config_name, $report, $outfh);
  60 my $mode = MODE_NONE;
  61
  62 # list of [ report-spec, output-spec ]
  63 my (@outputs, @output_queue);
  64
  65 ## Program subroutines
  66
  67 sub usage
  68 {
  69     print <<EOF;
  70 Usage: amreport conf [--version] [--help] [-o configoption]
  71   command-line mode options:
  72     [--log=logfile] [--ps=filename] [--text=filename] [--xml=filename]
  73     [--print=printer] [--mail-text=recipient]
  74   script-mode options:
  75     [-i] [-M address] [-f output-file] [-l logfile] [-p postscript-file]
  76     [--from-amdump]
  77
  78 Amreport uses short options for use from shell scripts (e.g., amreport), or
  79 long options for use on the command line.
  80
  81 If the printer is omitted, the printer from the configuration is used.  If the
  82 filename is omitted or is "-", output is to stdout.  If the recipient is
  83 omitted, then the default mailto from the configuration is used.
  84
  85 If no options are given, a text report is printed to stdout.  The --from-amdump
  86 option triggers script mode, and is used by amdump.
  87 EOF
  88     exit 1;
  89 }
  90
  91 sub error
  92 {
  93     my ( $error_msg, $exit_code ) = @_;
  94     warning("error: $error_msg");
  95     print STDERR "$error_msg\n";
  96     exit $exit_code;
  97 }
  98
  99 sub set_mode
 100 {
 101     my ($new_mode) = @_;
 102
 103     if ($mode != MODE_NONE && $mode != $new_mode) {
 104         error("cannot mix long options (command-line mode), and "
 105             . "short options (script mode) with each other", 1);
 106     }
 107
 108     $mode = $new_mode;
 109 }
 110
 111 # Takes a string specifying an option name (e.g. "M") and a reference to a
 112 # scalar variable. It's return values are suitable for use in the middle of
 113 # option specification, e.g. GetOptions("foo" => \$foo, opt_set_var("bar", \$bar)
 114 # It will only let the option be specified (at most) once, though, and will
 115 # print an error message and exit otherwise.
 116 sub opt_set_var
 117 {
 118     my ($opt, $ref) = @_;
 119     error("must pass scalar ref to opt_set_var", 1)
 120       unless (ref($ref) eq "SCALAR");
 121
 122     return (
 123         "$opt=s",
 124         sub {
 125             my ($op, $val) = @_;
 126
 127             # all short options are legacy options
 128             set_mode(MODE_SCRIPT);
 129
 130             if (defined($$ref)) {
 131                 error("you may specify at most one -$op\n", 1);
 132             } else {
 133                 $$ref = $val;
 134             }
 135         }
 136     );
 137 }
 138
 139
 140 sub opt_push_queue
 141 {
 142     my ($output) = @_;
 143
 144     unless ((ref $output eq "ARRAY")
 145         && (ref $output->[0] eq "ARRAY")
 146         && (ref $output->[1] eq "ARRAY")) {
 147         die "error: bad argument to opt_push_queue()";
 148     }
 149
 150     # all queue-pushing options are command-line options
 151     set_mode(MODE_CMDLINE);
 152
 153     push @output_queue, $output;
 154 }
 155
 156 sub get_default_logfile
 157 {
 158     my $logdir  = config_dir_relative(getconf($CNF_LOGDIR));
 159     my $logfile = "$logdir/log";
 160
 161     if (-f $logfile) {
 162         return $logfile;
 163
 164     } elsif ($mode == MODE_CMDLINE) {
 165
 166         $logfile = "$logdir/" . find_latest_log($logdir);
 167         return $logfile if -f $logfile;
 168     }
 169
 170     # otherwise, bail out
 171     error("nothing to report on!", 1);
 172 }
 173
 174 sub apply_output_defaults
 175 {
 176     my $ttyp         = getconf($CNF_TAPETYPE);
 177     my $tt           = lookup_tapetype($ttyp) if $ttyp;
 178     my $cfg_template = "" . tapetype_getconf($tt, $TAPETYPE_LBL_TEMPL) if $tt;
 179
 180     my $cfg_printer = getconf($CNF_PRINTER);
 181     my $cfg_mailto = getconf_seen($CNF_MAILTO) ? getconf($CNF_MAILTO) : undef;
 182
 183     foreach my $job (@output_queue) {
 184
 185         # supply the configured template if none was given.
 186         if (   $job->[FORMAT]->[FMT_TYP] eq 'postscript'
 187             && !$job->[FORMAT]->[FMT_TEMPLATE]) {
 188             $job->[FORMAT]->[FMT_TEMPLATE] = $cfg_template;
 189         }
 190
 191         # apply default destinations for each destination type
 192         if (!$job->[OUTPUT][OUT_DST]) {
 193             $job->[OUTPUT][OUT_DST] =
 194                 ($job->[OUTPUT]->[OUT_TYP] eq 'printer') ? $cfg_printer
 195               : ($job->[OUTPUT]->[OUT_TYP] eq 'mail')    ? $cfg_mailto
 196               : ($job->[OUTPUT]->[OUT_TYP] eq 'file')    ? '-'
 197               :   undef;    # will result in error
 198         }
 199
 200         push @outputs, $job;
 201     }
 202 }
 203
 204
 205 sub calculate_legacy_outputs {
 206     # Part of the "options" is the configuration.  Do we have a template?  And a
 207     # mailto? And mailer?
 208
 209     my $ttyp = getconf($CNF_TAPETYPE);
 210     my $tt = lookup_tapetype($ttyp) if $ttyp;
 211     my $cfg_template = "" . tapetype_getconf($tt, $TAPETYPE_LBL_TEMPL) if $tt;
 212
 213     my $cfg_mailer  = getconf($CNF_MAILER);
 214     my $cfg_printer = getconf($CNF_PRINTER);
 215     my $cfg_mailto  = getconf_seen($CNF_MAILTO) ? getconf($CNF_MAILTO) : undef;
 216
 217     if (!defined $opt_mailto) {
 218         # ignore the default value for mailto
 219         $opt_mailto = getconf_seen($CNF_MAILTO)? getconf($CNF_MAILTO) : undef;
 220         # (note that we still may not send mail if CNF_MAILER is not set)
 221     } else {
 222         # check that mailer is defined if we got an explicit -M, but go on
 223         # processing (we will probably do nothing..)
 224         if (!$cfg_mailer) {
 225             warning("a mailer is not defined; will not send mail");
 226             print "Warning: a mailer is not defined";
 227         }
 228     }
 229
 230     # should we send a mail?
 231     if ($cfg_mailer and $opt_mailto) {
 232         # -i and -f override this
 233         if (!$opt_nomail and !$opt_filename) {
 234             push @outputs, [ [ 'human' ], [ 'mail', $opt_mailto ] ];
 235         }
 236     }
 237
 238     # human/xml output to a file?
 239     if ($opt_filename) {
 240         if ($opt_xml) {
 241             push @outputs, [ [ 'xml' ], [ 'file', $opt_filename ] ];
 242         } else {
 243             push @outputs, [ [ 'human' ], [ 'file', $opt_filename ] ];
 244         }
 245     }
 246
 247     # postscript output to a printer?
 248     # (this is just silly)
 249     if ($Amanda::Constants::LPR and $cfg_template) {
 250         # oddly, -i ($opt_nomail) will disable printing, but -i -f prints.
 251         if ((!$opt_nomail and !$opt_psfname) or ($opt_nomail and $opt_filename)) {
 252             # but we don't print if the text report isn't going anywhere
 253             unless ((!$cfg_mailer or !$opt_mailto) and !($opt_filename and !$opt_xml)) {
 254                 push @outputs, [ [ 'postscript', $cfg_template ], [ 'printer', $cfg_printer ] ]
 255             }
 256         }
 257     }
 258
 259     # postscript output to a file?
 260     if ($opt_psfname and $cfg_template) {
 261         push @outputs, [ [ 'postscript', $cfg_template ], [ 'file', $opt_psfname ] ];
 262     }
 263 }
 264
 265 sub legacy_send_amreport
 266 {
 267     my ($output) = @_;
 268     my $cfg_send = getconf($CNF_SEND_AMREPORT_ON);
 269
 270     ## only check $cfg_send if we are in script mode and sending mail
 271     return 1 if ($mode != MODE_SCRIPT);
 272     return 1 if !($output->[OUTPUT]->[OUT_TYP] eq "mail");
 273
 274     ## do not bother checking for errors or stranges if set to 'all' or 'never'
 275     return 1 if ($cfg_send == $SEND_AMREPORT_ALL);
 276     return 0 if ($cfg_send == $SEND_AMREPORT_NEVER);
 277
 278     my $output_name = join(" ", @{ $output->[FORMAT] }, @{ $output->[OUTPUT] });
 279     my ($send_amreport, $process_stranges, $process_fails) = (0, 0, 0);
 280
 281     debug("testingamreport_send_on=$cfg_send, output:$output_name");
 282
 283     foreach my $dle ($report->get_dles()) {
 284
 285         my $dle_info = $report->get_dle_info(@$dle);
 286         my $tries    = $dle_info->{tries};
 287
 288         foreach my $try (@$tries) {
 289
 290             foreach my $program (keys %$try) {
 291
 292                 $process_stranges++ if $try->{$program}{status} eq 'strange';
 293                 $process_fails++    if $try->{$program}{status} eq 'fail';
 294             }
 295         }
 296     }
 297
 298     if ($cfg_send == $SEND_AMREPORT_STRANGE) {
 299
 300         if (   !$report->get_flag("got_finish")
 301             || ($report->get_flag("exit_status") != 0)
 302             || $process_stranges
 303             || $process_fails) {
 304
 305             debug("send_amreport_on=$cfg_send, condition filled for $output_name");
 306             $send_amreport = 1;
 307
 308         } else {
 309
 310             debug("send_amreport_on=$cfg_send, condition not filled for $output_name");
 311             $send_amreport = 0;
 312         }
 313
 314     } elsif ($cfg_send = $SEND_AMREPORT_ERROR) {
 315
 316         if (   !$report->get_flag("got_finish")
 317             || ($report->get_flag("exit_status") != 0)
 318             || $process_fails) {
 319
 320             debug("send_amreport_on=$cfg_send, condition filled for $output_name");
 321             $send_amreport = 1;
 322
 323         } else {
 324
 325             debug("send_amreport_on=$cfg_send, condition not filled for $output_name");
 326             $send_amreport = 0;
 327         }
 328     }
 329
 330     return $send_amreport;
 331 }
 332
 333 sub open_file_output {
 334     my ($report, $outputspec) = @_;
 335
 336     my $filename = $outputspec->[1];
 337     $filename = Amanda::Util::get_original_cwd() . "/$filename"
 338       unless ($filename eq "-" || $filename =~ m{^/});
 339
 340     if ($filename eq "-") {
 341         return \*STDOUT;
 342     } else {
 343         open my $fh, ">", $filename or die "Cannot open '$filename': $!";
 344         return $fh;
 345     }
 346 }
 347
 348 sub open_printer_output
 349 {
 350     my ($report, $outputspec) = @_;
 351     my $printer = $outputspec->[1];
 352
 353     my @cmd;
 354     if ($printer and $Amanda::Constants::LPRFLAG) {
 355         @cmd = ( $Amanda::Constants::LPR, $Amanda::Constants::LPRFLAG, $printer );
 356     } else {
 357         @cmd = ( $Amanda::Constants::LPR );
 358     }
 359
 360     debug("invoking printer: " . join(" ", @cmd));
 361
 362     # redirect stdout/stderr to stderr, which is usually the amdump log
 363     my $pid = open3( my $fh, ">&2", ">&2", @cmd)
 364       or error("cannot start $cmd[0]: $!", 1);
 365     return ($pid, $fh);
 366 }
 367
 368 sub open_mail_output
 369 {
 370     my ($report, $outputspec) = @_;
 371     my $mailto = $outputspec->[1];
 372
 373     if ($mailto =~ /[*<>()\[\];:\\\/"!$|]/) {
 374         error("mail address has invalid characters", 1);
 375     }
 376
 377     my $datestamp =
 378       $report->get_program_info(
 379         $report->get_flag("amflush_run") ? "amflush" : "planner", "start" );
 380
 381     $datestamp /= 1000000 if $datestamp > 99999999;
 382     $datestamp = int($datestamp);
 383     my $year  = int( $datestamp / 10000 ) - 1900;
 384     my $month = int( ( $datestamp / 100 ) % 100 ) - 1;
 385     my $day   = int( $datestamp % 100 );
 386     my $date  = POSIX::strftime( '%B %e, %Y', 0, 0, 0, $day, $month, $year );
 387     $date =~ s/  / /g;
 388
 389     my $process_fails = 0;
 390
 391     foreach my $dle ($report->get_dles()) {
 392         my $dle_info = $report->get_dle_info(@$dle);
 393         my $tries    = $dle_info->{tries};
 394
 395         foreach my $try (@$tries) {
 396             foreach my $program (keys %$try) {
 397                 $process_fails++    if $try->{$program}{status} eq 'fail';
 398             }
 399         }
 400     }
 401
 402     my $done = "";
 403     if (  !$report->get_flag("got_finish")
 404         || ($report->get_flag("exit_status") != 0)
 405         || $process_fails) {
 406         $done = " FAIL:";
 407     }
 408
 409     my $subj_str =
 410         getconf($CNF_ORG) . $done
 411       . ( $report->get_flag("amflush_run") ? " AMFLUSH" : " AMANDA" )
 412       . " MAIL REPORT FOR "
 413       . $date;
 414
 415     my $cfg_mailer = getconf($CNF_MAILER);
 416
 417     my @cmd = ("$cfg_mailer", "-s", $subj_str, $mailto);
 418     debug("invoking mail app: " . join(" ", @cmd));
 419
 420
 421     my ($pid, $fh);
 422     eval { $pid = open3($fh, ">&2", ">&2", @cmd); 1; } or do {
 423
 424         ($pid, $fh) = (0, undef);
 425         my $errstr =
 426           "error: could not run command: " . join(" ", @cmd) . ": $@";
 427
 428         if ($mode == MODE_SCRIPT) {
 429             debug($errstr);
 430         } else {
 431             error($errstr, 1);
 432         }
 433     };
 434
 435     return ($pid, $fh);
 436 }
 437
 438 sub run_output {
 439     my ($output) = @_;
 440     my ($reportspec, $outputspec) = @$output;
 441
 442     # get the output
 443     my ($pid, $fh);
 444     if ($outputspec->[0] eq 'file') {
 445         $fh = open_file_output($report, $outputspec);
 446     } elsif ($outputspec->[0] eq 'printer') {
 447         ($pid, $fh) = open_printer_output($report, $outputspec);
 448     } elsif ($outputspec->[0] eq 'mail') {
 449         ($pid, $fh) = open_mail_output($report, $outputspec);
 450     }
 451
 452
 453     # TODO: add some generic error handling here.  must be compatible
 454     # with legacy behavior.
 455
 456     # TODO: modularize these better
 457     if ($reportspec->[0] eq 'xml') {
 458         print $fh $report->xml_output();
 459     } elsif ($reportspec->[0] eq 'human') {
 460         my $hr =
 461           Amanda::Report::human->new( $report, $fh, $config_name, $opt_logfname );
 462         $hr->print_human_amreport();
 463     } elsif ($reportspec->[0] eq 'postscript') {
 464         use Amanda::Report::postscript;
 465         my $rep =
 466           Amanda::Report::postscript->new( $report, $config_name, $opt_logfname );
 467         $rep->write_report($fh);
 468     }
 469
 470     close $fh;
 471
 472     # clean up any subprocess
 473     if (defined $pid) {
 474         debug("waiting for child process to finish..");
 475         waitpid($pid, 0);
 476         if ($? != 0) {
 477             warning("child exited with status $?");
 478         }
 479     }
 480 }
 481
 482
 483 ## Application initialization
 484
 485 Amanda::Util::setup_application("amreport", "server", $CONTEXT_CMDLINE);
 486
 487 my $config_overrides = new_config_overrides( scalar(@ARGV) + 1 );
 488
 489 Getopt::Long::Configure(qw/bundling/);
 490 GetOptions(
 491
 492     ## old legacy configuration opts
 493     "i" => sub { set_mode(MODE_SCRIPT); $opt_nomail = 1; },
 494     opt_set_var("M", \$opt_mailto),
 495     opt_set_var("f", \$opt_filename),
 496     opt_set_var("l", \$opt_logfname),
 497     opt_set_var("p", \$opt_psfname),
 498
 499     "o=s" => sub { add_config_override_opt($config_overrides, $_[1]); },
 500
 501     ## trigger default amdump behavior
 502     "from-amdump" => sub { set_mode(MODE_SCRIPT) },
 503
 504     ## new configuration opts
 505     "log=s" => sub { set_mode(MODE_CMDLINE); $opt_logfname = $_[1]; },
 506     "ps:s" => sub { opt_push_queue([ ['postscript'], [ 'file', $_[1] ] ]); },
 507     "mail-text:s" => sub { opt_push_queue([ ['human'], [ 'mail', $_[1] ] ]); },
 508     "text:s"      => sub { opt_push_queue([ ['human'], [ 'file', $_[1] ] ]); },
 509     "xml:s"       => sub { opt_push_queue([ ['xml'],   [ 'file', $_[1] ] ]); },
 510     "print:s"     => sub { opt_push_queue([ [ 'postscript' ], [ 'printer', $_[1] ] ]); },
 511
 512     'version' => \&Amanda::Util::version_opt,
 513     'help'    => \&usage,
 514 ) or usage();
 515
 516 # set command line mode if no options were given
 517 $mode = MODE_CMDLINE if ($mode == MODE_NONE);
 518
 519 if ($mode == MODE_CMDLINE) {
 520     (scalar @ARGV == 1) or usage();
 521 } else {    # MODE_SCRIPT
 522     (scalar @ARGV > 0) or usage();
 523 }
 524
 525 $config_name = shift @ARGV;    # only use first argument
 526 $config_name ||= '.';          # default config is current dir
 527
 528 set_config_overrides($config_overrides);
 529 config_init( $CONFIG_INIT_EXPLICIT_NAME, $config_name );
 530
 531 my ( $cfgerr_level, @cfgerr_errors ) = config_errors();
 532 if ( $cfgerr_level >= $CFGERR_WARNINGS ) {
 533     config_print_errors();
 534     if ( $cfgerr_level >= $CFGERR_ERRORS ) {
 535         error( "errors processing config file", 1 );
 536     }
 537 }
 538
 539 Amanda::Util::finish_setup($RUNNING_AS_DUMPUSER);
 540
 541 # read the tapelist
 542 my $tl_file = config_dir_relative(getconf($CNF_TAPELIST));
 543 my $tl = Amanda::Tapelist::read_tapelist($tl_file);
 544
 545 # read the disklist
 546 my $diskfile = config_dir_relative(getconf($CNF_DISKFILE));
 547 $cfgerr_level += Amanda::Disklist::read_disklist('filename' => $diskfile);
 548 ($cfgerr_level < $CFGERR_ERRORS) || die "Errors processing disklist";
 549
 550 # shim for installchecks
 551 $Amanda::Constants::LPR = $ENV{'INSTALLCHECK_MOCK_LPR'}
 552     if exists $ENV{'INSTALLCHECK_MOCK_LPR'};
 553
 554 # calculate the logfile to read from
 555 $opt_logfname = Amanda::Util::get_original_cwd() . "/" . $opt_logfname
 556         if defined $opt_logfname and $opt_logfname !~ /^\//;
 557 my $logfile = $opt_logfname || get_default_logfile();
 558 my $historical = defined $opt_logfname;
 559 debug("using logfile: $logfile" . ($historical? " (historical)" : ""));
 560
 561 if ($mode == MODE_CMDLINE) {
 562     debug("operating in cmdline mode");
 563     apply_output_defaults();
 564     push @outputs, [ ['human'], [ 'file', '-' ] ] if !@outputs;
 565 } else {
 566     debug("operating in script mode");
 567     calculate_legacy_outputs();
 568 }
 569
 570 if (!@outputs) {
 571     print "no output specified, nothing to do\n";
 572     exit(0);
 573 }
 574
 575 ## Parse the report & set output
 576
 577 $report = Amanda::Report->new($logfile, $historical);
 578 my $exit_status = $report->get_flag("exit_status");
 579
 580 ## filter outputs by errors & stranges
 581
 582 @outputs = grep { legacy_send_amreport($_) } @outputs;
 583
 584 for my $output (@outputs) {
 585     debug("planned output: " . join(" ", @{ $output->[FORMAT] }, @{ $output->[OUTPUT] }));
 586 }
 587
 588 ## Output
 589
 590 for my $output (@outputs) {
 591     run_output($output);
 592 }
 593
 594 Amanda::Util::finish_application();
 595 exit $exit_status;