1# Copyright (c) 2010-2013 Zmanda, Inc.  All Rights Reserved.
2#
3# This program is free software; you can redistribute it and/or
4# modify it under the terms of the GNU General Public License
5# as published by the Free Software Foundation; either version 2
6# of the License, or (at your option) any later version.
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. Mathilda Ave., Suite 300
18# Sunnyvale, CA 94085, USA, or: http://www.zmanda.com
19
20package Amanda::Report;
21use strict;
22use warnings;
23use Data::Dumper;
24
25use Amanda::Disklist;
26use Amanda::Logfile qw/:logtype_t :program_t/;
27use Amanda::Util;
28use Amanda::Debug qw( debug warning );
29
30=head1 NAME
31
32Amanda::Report -- module for representing report data from logfiles
33
34=head1 SYNOPSIS
35
36    use Amanda::Report;
37
38    my $report = Amanda::Report->new($logfile);
39    my @hosts  = keys %{$report->{data}{disklist}};
40
41=head1 INTERFACE
42
43This module reads the logfile passed to it and aggregates the data in
44a format of nested hashes for convenient output.  All data read in is
45stored in C<< $report->{data} >>.
46
47=head2 Creating a Report
48
49  my $report = Amanda::Report->new($logfile, $historical);
50
51The constructor reads the logfile and produces the report, which can then be
52queried with the other methods.  C<$logfile> should specify the path to the
53logfile from which the report is prepared.  If the logfile is not the "current"
54logfile, then C<$historical> should be false.  Non-historical reports may draw
55information from the current Amanda environment, e.g., holding disks and info
56files.
57
58=head2 Summary Information
59
60Note that most of the data provided by these methods is simply a reference to
61data stored within the report, and should thus be considered read-only.  For
62example, do not use C<shift> or C<pop> to destructively consume lists.
63
64  my $datestamp = $report->get_timestamp();
65
66This returns the run timestamp for this dump run.  This is determined from one
67of several START entries.  This returns a full 14-digit timestamp regardless of
68the setting of C<usetimestamps> now or during the dump run.
69
70  my @hosts = $report->get_hosts();
71
72This method returns a list containing the hosts that have been seen in
73a logfile.  In a scalar context, C<get_hosts> returns the number of
74hosts seen.
75
76  my @disks = $report->get_disks($hostname);
77
78This method returns a list of disks that were archived under the given
79C<$hostname>.  In a scalar context, this method returns the number of
80disks seen, belonging to the hostname.
81
82  my @dles = $report->get_dles();
83
84This method returns a list of list references.  Each referenced list
85contains a hostname & disk pair that has been reported by either the
86planner or amflush.  The DLEs are stored in the order that they appear
87in the logfile.
88
89    @dles = (
90        [ 'example1', '/home' ],
91        [ 'example1', '/var/log' ],
92        [ 'example2', '/etc' ],
93        [ 'example2', '/home' ],
94        [ 'example3', '/var/www' ],
95    );
96
97  if ( $report->get_flag($flag) ) { ... }
98
99The C<get_flag> method accesses a number of flags that represent the state of
100the dump.  A true value is returned if the flag is set, and undef otherwise.
101The available flags are:
102
103=over
104
105=item C<got_finish>
106
107This flag is true when the driver finished
108correctly.  It indicates that the dump run has finished and cleaned
109up.
110
111=item C<degraded_mode>
112
113This flag is set if the taper encounters an
114error that forces it into degraded mode.
115
116=item C<amflush_run>
117
118This flag is set if amflush is run instead of planner.
119
120=item C<amvault_run>
121
122This flag is set if the run was by amvault.
123
124=item C<normal_run>
125
126This flag is set when planner is run.  Its value
127should be opposite of C<amflush_run>.
128
129=item C<dump_failed>
130
131If a dump failed.
132
133=item C<dump_strange>
134
135If a dump end in strange result.
136
137=item C<results_missing>
138
139If this was a normal run, but some DLEs named by the
140planner do not have any results, then this flag is set.  Users should look for
141DLEs with an empty C<dump> key to enumerate the missing results.
142
143=item C<historical>
144
145This flag is set if this is a "historical" report.  It is
146based on the value passed to the constructor.
147
148=back
149
150=head2 Report Data
151
152  my $dle = $report->get_dle_info($hostname, $disk [,$field] );
153
154This method returns the DLE information for the given C<$hostname> and C<disk>,
155or if C<$field> is given, returns that field of the DLE information.  See the
156DATA DESCRIPTION section for the format of this information.
157
158  my $info = $report->get_program_info($program [,$field] );
159
160This method returns the program information for the given C<$program>, or if
161C<$field> is given, returns that field of the DLE information.  See the DATA
162DESCRIPTION section for the format of this information.
163
164=head1 DATA DESCRIPTION
165
166=head2 Top Level
167
168The data in the logfile is stored in the module at C<< $report->{data} >>.
169Beneath that, there are a number of subdivisions that track both global and
170per-host status of the given Amanda run that the logfile represents.  Note that
171these subdivisions are usually accessed via C<get_dle_info> and
172C<get_program_info>, as described above.
173
174  $data->{programs}
175
176the C<programs> key of the data points to a hash of global program
177information, with one element per program.  See the Programs section, below.
178
179  $data->{boguses}
180
181The C<boguses> key refers to a list of arrayrefs of the form
182
183  [$prog, $type, $str]
184
185as returned directly by C<Amanda::Logfile::get_logline>.  These lines are not
186in a recognized trace log format.
187
188  $data->{disklist}
189
190The C<disklist> key points to a two-level hash of hostnames and
191disknames as present in the logfile.  It looks something like this:
192
193    $report->{data}{disklist} = {
194        "server.example.org" => {
195            "/home" => {...},
196            "/var"  => {...},
197        },
198        "workstation.example.org" => {
199            "/etc"     => {...},
200            "/var/www" => {...},
201        },
202    };
203
204Each C<{...}> in the above contains information about the corresponding DLE.  See DLEs, below.
205
206=head2 Programs
207
208Each program involved in a dump has a hash giving information about its
209performance during the run.  A number of fields are common across all of the
210different programs:
211
212=over
213
214=item C<start>
215
216the numeric timestamp at which the process was started.
217
218=item C<time>
219
220the length of time (in seconds) that the program ran.
221
222=item C<notes>
223
224a list which stores all notes reported to the logfile
225by the corresponding program.
226
227=item C<errors>
228
229a list which stores all errors reported to the
230logfile by the corresponding program.
231
232=back
233
234Program-specific fields are described in the following sections.
235
236=head3 planner
237
238The planner logs very little information other than determining what will be
239backed up.  It has no special fields other than those given above.
240
241=head3 driver
242
243The driver has one field that the other program-specific
244entries do not:
245
246=over
247
248=item C<start_time> - the time it takes for the driver to start up.
249
250=back
251
252=head3 amflush and amdump
253
254No special fields.
255
256=head3 dumper and chunker
257
258Most of the chunker's output and the dumper's output can be tied to a
259particular DLE, so their C<programs> hashes are limited to C<notes> and
260C<errors>.
261
262=head3 taper
263
264The taper hash holds notes and errors for the per-instance runs of the taper
265program, but also tracks the tapes seen in the logfile:
266
267=over
268
269=item C<tapes>
270
271This field is a hash reference keyed by the label of the tape.
272each value of the key is another hash which stores date, size, and the
273number of files seen by this backup on the tape.  For example:
274
275    $report->{data}{programs}{taper}{tapes} = {
276        FakeTape01 => {
277            label => "FakeTape01",
278            date  => "20100318141930",
279            kb    => 7894769,          # data written to tape this session
280            files => 14,               # parts written to tape this session
281            dle   => 13,               # number of dumps that begin on this tape
282            time  => 2.857,            # time spent writing to this tape
283        },
284    };
285
286=item C<tape_labels>
287
288The C<tape_labels> field is a reference to a list which records the
289order that the tapes have been seen.  This list should be used as an
290ordered index for C<tapes>.
291
292=back
293
294=head2 DLEs
295
296In the below, C<$dle> is the hash representing one disklist entry.
297
298The C<estimate> key describes the estimate given by the planner.  For
299example:
300
301    $dle->{estimate} = {
302	level => 0,     # the level of the backup
303	sec   => 20,    # estimated time to back up (seconds)
304	nkb   => 2048,  # expected uncompressed size (kb)
305	ckb   => 1293,  # expected compressed size (kb)
306	kps   => 934.1, # speed of the backup (kb/sec)
307    };
308
309Each dump of the DLE is represented in C<< $dle->{dumps} >>.  This is a hash,
310keyed by dump timestamp with a list of tries as the value for each dump.  Each
311try represents a specific attempt to finish writing this dump to a volume.  If
312an error occurs during the backup of a DLE and is retried, a second try is
313pushed to the tries list.  For example:
314
315    $dle->{dumps} = {
316	'20100317142122' => [ $try1 ],
317	'20100318141930' => [ $try1, $try2 ],
318    };
319
320=head3 Tries
321
322A try is a hash with at least one dumper, taper, and/or chunker DLE program as
323a key.  These entries contain the results from the associated program during
324try.
325
326There are a number of common fields between all three elements:
327
328=over
329
330=item C<date>
331
332a timestamp of when the program finished (if the program exited)
333
334=item C<status>
335
336the status of the dump at this program on this try ("success", "partial",
337"done", or "failed").  The planner adds an extra "skipped" status which is
338added when the planner decides to skip a DLE due to user configuration (e.g.,
339C<skipincr>).
340
341=item C<level>
342
343the incremental level of the backup.
344
345=item C<sec>
346
347the time in seconds for the program to finish.
348
349=item C<kb>
350
351the size of the data dumped in kb.
352
353=item C<kps>
354
355the rate at which the program was able to process data,
356in kb/sec.
357
358=item C<error>
359
360if the program fails, this field contains the error message
361
362=back
363
364The C<dumper> hash has an C<orig_kb> field, giving the size of the data dumped
365from the source, before any compression. If encountered, the C<dumper> hash may
366also contain a C<stranges> field, which is a list of all the messages of type
367C<L_STRANGE> encountered during the process.
368
369The C<taper> hash contains all the exit status data given by the taper.
370Because the same taper process handles multiple dumps, it does not have a
371C<date> field.  However, the taper does have an additional field, C<parts>,
372containing a list of parts written for this dump.
373
374=head3 Parts
375
376Each item in the list of taper parts is a hash with the following
377fields:
378
379=over
380
381=item C<label>
382
383the name of the tape that the part was written to.
384
385=item C<date>
386
387the datestamp at which this part was written.
388
389=item C<file>
390
391the filename of the part.
392
393=item C<part>
394
395the sequence number of the part for the DLE that the
396part is archiving.
397
398=item C<sec>
399
400the length of time, in seconds, that the part took to
401be written.
402
403=item C<kb>
404
405the total size of the part.
406
407=item C<kps>
408
409the speed at which the part was written.
410
411=back
412
413=cut
414
415use constant STATUS_STRANGE => 2;
416use constant STATUS_FAILED  => 4;
417use constant STATUS_MISSING => 8;
418use constant STATUS_TAPE    => 16;
419
420sub new
421{
422    my $class = shift @_;
423    my ($logfname, $historical) = @_;
424
425    my $self = {
426        data => {},
427
428	## inputs
429	_logfname => $logfname,
430	_historical => $historical,
431
432	## logfile-parsing state
433
434	# the tape currently being writen
435	_current_tape => undef,
436    };
437    bless $self, $class;
438
439    $self->read_file();
440    return $self;
441}
442
443
444sub read_file
445{
446    my $self       = shift @_;
447    my $data       = $self->{data} = {};
448    my $logfname   = $self->{_logfname};
449
450    # clear the program and DLE data
451    $data->{programs} = {};
452    $data->{disklist} = {};
453    $self->{cache}    = {};
454    $self->{flags}    = {};
455    $self->{run_timestamp} = '00000000000000';
456
457    my $logfh = Amanda::Logfile::open_logfile($logfname)
458      or die "cannot open '$logfname': $!";
459
460    $self->{flags}{exit_status} = 0;
461    $self->{flags}{results_missing} = 0;
462    $self->{flags}{dump_failed} = 0;
463    $self->{flags}{dump_strange} = 0;
464
465    while ( my ( $type, $prog, $str ) = Amanda::Logfile::get_logline($logfh) ) {
466        $self->read_line( $type, $prog, $str );
467    }
468
469    ## set post-run flags
470
471    $self->{flags}{historical} = $self->{_historical};
472    $self->{flags}{amflush_run} = 0;
473    $self->{flags}{amvault_run} = 0;
474    if (!$self->get_flag("normal_run")) {
475        if (   ( defined $self->get_program_info("amflush") )
476            && ( scalar %{ $self->get_program_info("amflush") } ) ) {
477	    debug("detected an amflush run");
478	    $self->{flags}{amflush_run} = 1;
479	} elsif (   ( defined $self->get_program_info("amvault") )
480                 && ( scalar %{ $self->get_program_info("amvault") } ) ) {
481	    debug("detected an amvault run");
482	    $self->{flags}{amvault_run} = 1;
483	}
484    }
485
486    # check for missing, fail and strange results
487    $self->check_missing_fail_strange() if $self->get_flag('normal_run');
488
489    # clean up any temporary values in the data
490    $self->cleanup();
491}
492
493sub cleanup
494{
495    my $self = shift;
496
497    #remove last_label field
498    foreach my $dle ($self->get_dles()) {
499        my $dle_info = $self->get_dle_info(@$dle);
500        delete $dle_info->{last_label};
501    }
502
503    return;
504}
505
506
507sub read_line
508{
509    my $self = shift @_;
510    my ( $type, $prog, $str ) = @_;
511
512    if ( $type == $L_CONT ) {
513	${$self->{nbline_ref}}++;
514	if ($str =~ /^\|/) {
515	    $self->{nb_strange}++;
516	    push @{$self->{contline}}, $str if $self->{nb_strange} + $self->{nb_error} <= 100;
517	} elsif ($str =~ /^\?/) {
518	    $self->{nb_error}++;
519	    push @{$self->{contline}}, $str if $self->{nb_error} <= 100;
520	} else {
521	    $self->{nb_normal}++;
522	    push @{$self->{contline}}, $str if ${$self->{nbline_ref}} <= 100;
523	}
524	return;
525    }
526    $self->{contline} = undef;
527    $self->{nb_normal} = 0;
528    $self->{nb_strange} = 0;
529    $self->{nb_error} = 0;
530
531    if ( $prog == $P_PLANNER ) {
532        return $self->_handle_planner_line( $type, $str );
533
534    } elsif ( $prog == $P_DRIVER ) {
535        return $self->_handle_driver_line( $type, $str );
536
537    } elsif ( $prog == $P_DUMPER ) {
538        return $self->_handle_dumper_line( $type, $str );
539
540    } elsif ( $prog == $P_CHUNKER ) {
541        return $self->_handle_chunker_line( $type, $str );
542
543    } elsif ( $prog == $P_TAPER ) {
544        return $self->_handle_taper_line( $type, $str );
545
546    } elsif ( $prog == $P_AMFLUSH ) {
547        return $self->_handle_amflush_line( $type, $str );
548
549    } elsif ( $prog == $P_AMVAULT ) {
550        return $self->_handle_amvault_line( $type, $str );
551
552    } elsif ( $prog == $P_AMDUMP ) {
553        return $self->_handle_amdump_line( $type, $str );
554
555    } elsif ( $prog == $P_REPORTER ) {
556        return $self->_handle_reporter_line( $type, $str );
557
558    } else {
559        return $self->_handle_bogus_line( $prog, $type, $str );
560    }
561}
562
563sub get_timestamp
564{
565    my $self = shift;
566    return $self->{'run_timestamp'};
567}
568
569sub get_hosts
570{
571    my $self  = shift @_;
572    my $cache = $self->{cache};
573
574    $cache->{hosts} = [ sort keys %{ $self->{data}{disklist} } ]
575      if ( !defined $cache->{hosts} );
576
577    return @{ $cache->{hosts} };
578}
579
580sub get_disks
581{
582    my $self = shift @_;
583    my ($hostname) = @_;
584    return sort keys %{ $self->{data}{disklist}{$hostname} };
585}
586
587sub get_dles
588{
589    my $self  = shift @_;
590    my $cache = $self->{cache};
591    my @dles;
592
593    if ( !defined $cache->{dles} ) {
594        foreach my $hostname ( $self->get_hosts() ) {
595            map { push @dles, [ $hostname, $_ ] } $self->get_disks($hostname);
596        }
597        $cache->{dles} = \@dles;
598    }
599    return @{ $cache->{dles} };
600}
601
602sub get_dle_info
603{
604    my $self = shift @_;
605    my ( $hostname, $disk, $field ) = @_;
606
607    return ( defined $field )
608      ? $self->{data}{disklist}{$hostname}{$disk}{$field}
609      : $self->{data}{disklist}{$hostname}{$disk};
610}
611
612sub get_program_info
613{
614    my ($self, $program, $field, $default) = @_;
615    my $prog = $self->{data}{programs}{$program};
616
617    $prog->{$field} = $default if (defined $field && !defined $prog->{$field});
618
619    return (defined $field) ? $prog->{$field} : $prog;
620}
621
622sub get_tape
623{
624    my ($self, $label) = @_;
625
626    my $taper       = $self->get_program_info("taper");
627    my $tapes       = $taper->{tapes}       ||= {};
628    my $tape_labels = $taper->{tape_labels} ||= [];
629
630    if (!exists $tapes->{$label}) {
631        push @$tape_labels, $label;
632        $tapes->{$label} = {date => "",
633			    kb => 0,
634			    files => 0,
635			    dle => 0,
636			    time => 0};
637    }
638
639    return $tapes->{$label};
640}
641
642sub get_flag
643{
644    my ( $self, $flag ) = @_;
645    return $self->{flags}{$flag};
646}
647
648sub _handle_planner_line
649{
650    my $self = shift @_;
651    my ( $type, $str ) = @_;
652    my $data     = $self->{data};
653    my $programs = $data->{programs};
654    my $disklist = $data->{disklist} ||= {};
655    my $planner  = $programs->{planner} ||= {};
656
657    if ( $type == $L_INFO ) {
658        return $self->_handle_info_line( "planner", $str );
659
660    } elsif ( $type == $L_WARNING ) {
661        return $self->_handle_warning_line( "planner", $str );
662
663    } elsif ( $type == $L_START ) {
664
665        $self->{flags}{normal_run} = 1;
666        return $self->_handle_start_line( "planner", $str );
667
668    } elsif ( $type == $L_FINISH ) {
669
670        my @info = Amanda::Util::split_quoted_strings($str);
671        return $planner->{time} = $info[3];
672
673    } elsif ( $type == $L_DISK ) {
674        return $self->_handle_disk_line( "planner", $str );
675
676    } elsif ( $type == $L_SUCCESS ) {
677        return $self->_handle_success_line( "planner", $str );
678
679    } elsif ( $type == $L_ERROR ) {
680        return $self->_handle_error_line( "planner", $str );
681
682    } elsif ( $type == $L_FATAL ) {
683        return $self->_handle_fatal_line( "planner", $str );
684
685    } elsif ( $type == $L_FAIL ) {
686
687        # TODO: these are not like other failure messages: later
688        # handle here
689        return $self->_handle_fail_line( "planner", $str );
690
691    } else {
692        return $self->_handle_bogus_line( $P_PLANNER, $type, $str );
693    }
694}
695
696
697sub _handle_driver_line
698{
699    my $self = shift @_;
700    my ( $type, $str ) = @_;
701    my $data     = $self->{data};
702    my $disklist = $data->{disklist};
703    my $programs = $data->{programs};
704    my $driver_p = $programs->{driver} ||= {};
705
706    if ( $type == $L_INFO ) {
707        return $self->_handle_info_line( "driver", $str );
708
709    } elsif ( $type == $L_START ) {
710        return $self->_handle_start_line( "driver", $str );
711
712    } elsif ( $type == $L_FINISH ) {
713
714        my @info = Amanda::Util::split_quoted_strings($str);
715        $self->{flags}{got_finish} = 1;
716        return $driver_p->{time} = $info[3];
717
718    } elsif ( $type == $L_STATS ) {
719
720        my @info = Amanda::Util::split_quoted_strings($str);
721        if ( $info[0] eq "hostname" ) {
722
723            return $self->{hostname} = $info[1];
724
725        } elsif ( $info[0] eq "startup" ) {
726
727            my @info = Amanda::Util::split_quoted_strings($str);
728            return $driver_p->{start_time} = $info[2];
729
730        } elsif ( $info[0] eq "estimate" ) {
731
732            # estimate format:
733            # STATS driver estimate <hostname> <disk> <timestamp>
734            # <level> [sec <sec> nkb <nkb> ckb <ckb> jps <kps>]
735            # note that the [..] section is *not* quoted properly
736            my ($hostname, $disk, $timestamp, $level) = @info[ 1 .. 4 ];
737
738            # if the planner didn't define the DLE then this is a bad
739            # line
740            unless (exists $disklist->{$hostname}{$disk}) {
741                return $self->_handle_bogus_line($P_DRIVER, $type, $str);
742            }
743
744            my $dle = $self->get_dle_info($hostname, $disk);
745            my ($sec, $nkb, $ckb, $kps) = @info[ 6, 8, 10, 12 ];
746            $kps =~ s{\]}{};    # strip trailing "]"
747
748            $dle->{estimate} = {
749                level => $level,
750                sec   => $sec,
751                nkb   => $nkb,
752                ckb   => $ckb,
753                kps   => $kps,
754            };
755
756        } else {
757            return $self->_handle_bogus_line( $P_DRIVER, $type, $str );
758        }
759
760    } elsif ( $type == $L_WARNING ) {
761
762        $self->{flags}{exit_status} |= STATUS_TAPE
763          if ($str eq "Taper protocol error");
764
765        return $self->_handle_warning_line("driver", $str);
766
767    } elsif ( $type == $L_ERROR ) {
768        return $self->_handle_error_line( "driver", $str );
769
770    } elsif ( $type == $L_FATAL ) {
771        return $self->_handle_fatal_line( "driver", $str );
772
773    } elsif ( $type == $L_FAIL ) {
774        return $self->_handle_fail_line( "driver", $str );
775
776    } else {
777        return $self->_handle_bogus_line( $P_DRIVER, $type, $str );
778    }
779}
780
781
782sub _handle_dumper_line
783{
784    my $self = shift @_;
785    my ( $type, $str ) = @_;
786    my $data     = $self->{data};
787    my $disklist = $data->{disklist};
788    my $programs = $data->{programs};
789    my $dumper_p = $programs->{dumper} ||= {};
790
791    if ( $type == $L_INFO ) {
792        return $self->_handle_info_line( "dumper", $str );
793
794    } elsif ( $type == $L_STRANGE ) {
795
796        my @info = Amanda::Util::split_quoted_strings($str);
797        my ( $hostname, $disk, $level ) = @info[ 0 .. 2 ];
798        my ( $sec, $kb, $kps, $orig_kb ) = @info[ 4, 6, 8, 10 ];
799	$kb = int($kb/1024) if $info[4] eq 'bytes';
800        $orig_kb =~ s{\]$}{};
801
802        my $dle    = $disklist->{$hostname}->{$disk};
803        my $try    = $self->_get_try( $dle, "dumper", $self->{'run_timestamp'});
804        my $dumper = $try->{dumper} ||= {};
805	$dumper->{level} = $level;
806	$dumper->{status} = 'strange';
807        $dumper->{sec}       = $sec;
808        $dumper->{kb}        = $kb;
809        $dumper->{kps}       = $kps;
810        $dumper->{orig_kb}   = $orig_kb;
811
812	$self->{contline} = $dumper->{stranges} ||= [];
813	$dumper->{nb_stranges} = 0;
814	$self->{nbline_ref} = \$dumper->{nb_stranges};
815	$self->{nb_normal} = 0;
816	$self->{nb_strange} = 0;
817	$self->{nb_error} = 0;
818
819        return $self->{flags}{exit_status} |= STATUS_STRANGE
820
821    } elsif ( $type == $L_WARNING ) {
822
823	return $self->_handle_warning_line("dumper", $str);
824
825    } elsif ( $type == $L_SUCCESS ) {
826
827        my @info = Amanda::Util::split_quoted_strings($str);
828        my ( $hostname, $disk, $timestamp, $level ) = @info[ 0 .. 3 ];
829        my ( $sec, $kb, $kps, $orig_kb ) = @info[ 5, 7, 9, 11 ];
830	$kb = int($kb/1024) if $info[6] eq 'bytes';
831        $orig_kb =~ s{\]$}{};
832
833        my $dle    = $disklist->{$hostname}->{$disk};
834        my $try    = $self->_get_try( $dle, "dumper", $timestamp );
835        my $dumper = $try->{dumper} ||= {};
836
837        $dumper->{date}      = $timestamp;
838        $dumper->{level}     = $level;
839        $dumper->{sec}       = $sec;
840        $dumper->{kb}        = $kb;
841        $dumper->{kps}       = $kps;
842        $dumper->{orig_kb}   = $orig_kb;
843
844        return $dumper->{status} = "success";
845
846    } elsif ( $type == $L_ERROR ) {
847        return $self->_handle_error_line( "dumper", $str );
848
849    } elsif ( $type == $L_FATAL ) {
850        return $self->_handle_fatal_line( "dumper", $str );
851
852    } elsif ( $type == $L_FAIL ) {
853        return $self->_handle_fail_line( "dumper", $str );
854
855    } else {
856        return $self->_handle_bogus_line( $P_DUMPER, $type, $str );
857    }
858}
859
860
861sub _handle_chunker_line
862{
863    my $self = shift @_;
864    my ( $type, $str ) = @_;
865    my $data      = $self->{data};
866    my $disklist  = $data->{disklist};
867    my $programs  = $data->{programs};
868    my $chunker_p = $programs->{chunker} ||= {};
869
870    if ( $type == $L_INFO ) {
871        return $self->_handle_info_line( "chunker", $str );
872
873    } elsif ( $type == $L_SUCCESS || $type == $L_PARTIAL ) {
874
875        my @info = Amanda::Util::split_quoted_strings($str);
876        my ( $hostname, $disk, $timestamp, $level ) = @info[ 0 .. 3 ];
877        my ( $sec, $kb, $kps ) = @info[ 5, 7, 9 ];
878	$kb = int($kb/1024) if $info[6] eq 'bytes';
879        $kps =~ s{\]$}{};
880
881        my $dle     = $disklist->{$hostname}->{$disk};
882        my $try     = $self->_get_try( $dle, "chunker", $timestamp );
883        my $chunker = $try->{chunker} ||= {};
884
885        $chunker->{date}  = $timestamp;
886        $chunker->{level} = $level;
887        $chunker->{sec}   = $sec;
888        $chunker->{kb}    = $kb;
889        $chunker->{kps}   = $kps;
890
891        return $chunker->{status} =
892          ( $type == $L_SUCCESS ) ? "success" : "partial";
893
894    } elsif ( $type == $L_ERROR ) {
895        return $self->_handle_error_line( "chunker", $str );
896
897    } elsif ( $type == $L_FATAL ) {
898        return $self->_handle_fatal_line( "chunker", $str );
899
900    } elsif ( $type == $L_FAIL ) {
901        return $self->_handle_fail_line( "chunker", $str );
902
903    } else {
904        return $self->_handle_bogus_line( $P_CHUNKER, $type, $str );
905    }
906}
907
908
909sub _handle_taper_line
910{
911    my $self = shift @_;
912    my ( $type, $str ) = @_;
913    my $data     = $self->{data};
914    my $disklist = $data->{disklist};
915    my $programs = $data->{programs};
916    my $taper_p  = $programs->{taper} ||= {};
917
918    if ( $type == $L_START ) {
919        # format is:
920        # START taper datestamp <start> label <label> tape <tapenum>
921        my @info = Amanda::Util::split_quoted_strings($str);
922        my ($datestamp, $label, $tapenum) = @info[ 1, 3, 5 ];
923        my $tape = $self->get_tape($label);
924        $tape->{date} = $datestamp;
925        $tape->{label} = $label;
926
927	# keep this tape for later
928	$self->{'_current_tape'} = $tape;
929
930	# call through to the generic start line function
931        $self->_handle_start_line( "taper", $str );
932    } elsif ( $type == $L_PART || $type == $L_PARTPARTIAL ) {
933
934# format is:
935# <label> <tapefile> <hostname> <disk> <timestamp> <currpart>/<predparts> <level> [sec <sec> kb <kb> kps <kps>]
936#
937# format for $L_PARTPARTIAL is the same as $L_PART, plus <err> at the end
938        my @info = Amanda::Util::split_quoted_strings($str);
939        my ($label, $tapefile, $hostname, $disk, $timestamp) = @info[ 0 .. 4 ];
940
941        $info[5] =~ m{^(\d+)\/(-?\d+)$};
942        my ( $currpart, $predparts ) = ( $1, $2 );
943
944        my ($level, $sec, $kb, $kps, $orig_kb) = @info[ 6, 8, 10, 12, 14 ];
945	$kb = int($kb/1024) if $info[9] eq 'bytes';
946        $kps =~ s{\]$}{};
947        $orig_kb =~ s{\]$}{} if defined($orig_kb);
948
949        my $dle   = $disklist->{$hostname}{$disk};
950        my $try   = $self->_get_try($dle, "taper", $timestamp);
951        my $taper = $try->{taper} ||= {};
952        my $parts = $taper->{parts} ||= [];
953
954        my $part = {
955            label => $label,
956            date  => $timestamp,
957            file  => $tapefile,
958            sec   => $sec,
959            kb    => $kb,
960            kps   => $kps,
961            partnum  => $currpart,
962        };
963
964	$taper->{orig_kb} = $orig_kb;
965
966        push @$parts, $part;
967
968        my $tape = $self->get_tape($label);
969	# count this as a filesystem if this is the first part
970        $tape->{dle}++ if $currpart == 1;
971        $tape->{kb}   += $kb;
972        $tape->{time} += $sec;
973        $tape->{files}++;
974
975    } elsif ( $type == $L_DONE || $type == $L_PARTIAL ) {
976
977# format is:
978# $type = DONE | PARTIAL
979# $type taper <hostname> <disk> <timestamp> <part> <level> [sec <sec> kb <kb> kps <kps>]
980        my @info = Amanda::Util::split_quoted_strings($str);
981        my ( $hostname, $disk, $timestamp, $part_ct, $level ) = @info[ 0 .. 4 ];
982        my ( $sec, $kb, $kps, $orig_kb ) = @info[ 6, 8, 10, 12 ];
983	$kb = int($kb/1024) if $info[7] eq 'bytes';
984	my $error;
985	if ($type == $L_PARTIAL) {
986	    if ($kps =~ /\]$/) {
987	        $error = join " ", @info[ 11 .. $#info ];
988	    } else {
989	        $error = join " ", @info[ 13 .. $#info ];
990	    }
991	}
992        $kps =~ s{\]$}{};
993        $orig_kb =~ s{\]$}{} if defined $orig_kb;
994
995        my $dle   = $disklist->{$hostname}->{$disk};
996        my $try   = $self->_get_try($dle, "taper", $timestamp);
997        my $taper = $try->{taper} ||= {};
998        my $parts = $taper->{parts};
999
1000        if ($part_ct - $#$parts != 1) {
1001            ## this should always be true; do nothing right now
1002        }
1003
1004        $taper->{level} = $level;
1005        $taper->{sec}   = $sec;
1006        $taper->{kb}    = $kb;
1007        $taper->{kps}   = $kps;
1008
1009        $taper->{status} = ( $type == $L_DONE ) ? "done" : "partial";
1010	$taper->{error} = $error if $type == $L_PARTIAL;
1011
1012    } elsif ( $type == $L_INFO ) {
1013        $self->_handle_info_line("taper", $str);
1014
1015    } elsif ( $type == $L_WARNING ) {
1016	$self->_handle_warning_line("taper", $str);
1017
1018    } elsif ( $type == $L_ERROR ) {
1019
1020        if ($str =~ m{^no-tape}) {
1021
1022	    my @info = Amanda::Util::split_quoted_strings($str);
1023	    my $failure_from = $info[1];
1024	    my $error = join " ", @info[ 2 .. $#info ];
1025
1026            $self->{flags}{exit_status} |= STATUS_TAPE;
1027            $self->{flags}{degraded_mode} = 1;
1028	    $taper_p->{failure_from} = $failure_from;
1029            $taper_p->{tape_error} = $error;
1030
1031        } else {
1032            $self->_handle_error_line("taper", $str);
1033        }
1034
1035    } elsif ( $type == $L_FATAL ) {
1036        return $self->_handle_fatal_line( "taper", $str );
1037
1038    } elsif ( $type == $L_FAIL ) {
1039        $self->_handle_fail_line( "taper", $str );
1040
1041    } else {
1042        $self->_handle_bogus_line( $P_TAPER, $type, $str );
1043    }
1044}
1045
1046
1047sub _handle_amflush_line
1048{
1049    my $self = shift @_;
1050    my ( $type, $str ) = @_;
1051    my $data      = $self->{data};
1052    my $disklist  = $data->{disklist};
1053    my $programs  = $data->{programs};
1054    my $amflush_p = $programs->{amflush} ||= {};
1055
1056    if ( $type == $L_DISK ) {
1057        return $self->_handle_disk_line( "amflush", $str );
1058
1059    } elsif ( $type == $L_START ) {
1060        return $self->_handle_start_line( "amflush", $str );
1061
1062    } elsif ( $type == $L_INFO ) {
1063        return $self->_handle_info_line( "amflush", $str );
1064
1065    } elsif ( $type == $L_FINISH ) {
1066        my @info = Amanda::Util::split_quoted_strings($str);
1067        $self->{flags}{got_finish} = 1;
1068        return $amflush_p->{time} = $info[3];
1069
1070    } else {
1071        return $self->_handle_bogus_line( $P_AMFLUSH, $type, $str );
1072    }
1073}
1074
1075sub _handle_amvault_line
1076{
1077    my $self = shift @_;
1078    my ( $type, $str ) = @_;
1079    my $data      = $self->{data};
1080    my $disklist  = $data->{disklist};
1081    my $programs  = $data->{programs};
1082    my $amvault_p = $programs->{amvault} ||= {};
1083
1084    if ( $type == $L_START ) {
1085        return $self->_handle_start_line( "amvault", $str );
1086
1087    } elsif ( $type == $L_INFO ) {
1088        return $self->_handle_info_line( "amvault", $str );
1089
1090    } elsif ( $type == $L_ERROR ) {
1091        return $self->_handle_error_line( "amvault", $str );
1092
1093    } elsif ( $type == $L_FATAL ) {
1094        return $self->_handle_fatal_line( "amvault", $str );
1095
1096    } elsif ( $type == $L_DISK ) {
1097        return $self->_handle_disk_line( "amvault", $str );
1098
1099    } elsif ( $type == $L_FINISH ) {
1100        my @info = Amanda::Util::split_quoted_strings($str);
1101        $self->{flags}{got_finish} = 1;
1102        return $amvault_p->{time} = $info[3];
1103
1104    } else {
1105        return $self->_handle_bogus_line( $P_AMFLUSH, $type, $str );
1106    }
1107}
1108
1109
1110sub _handle_amdump_line
1111{
1112    my $self = shift;
1113    my ( $type, $str ) = @_;
1114    my $data     = $self->{data};
1115    my $disklist = $data->{disklist};
1116    my $programs = $data->{programs};
1117    my $amdump = $programs->{amdump} ||= {};
1118
1119    if ( $type == $L_INFO ) {
1120        $self->_handle_info_line("amdump", $str);
1121
1122    } elsif ( $type == $L_START ) {
1123        $self->_handle_start_line("amdump", $str);
1124
1125    } elsif ( $type == $L_FATAL ) {
1126        return $self->_handle_fatal_line( "amdump", $str );
1127
1128    } elsif ( $type == $L_ERROR ) {
1129        $self->_handle_error_line("amdump", $str);
1130    }
1131}
1132
1133
1134sub _handle_fail_line
1135{
1136    my ($self, $program, $str) = @_;
1137
1138    my @info = Amanda::Util::split_quoted_strings($str);
1139    my ($hostname, $disk, $timestamp, $level) = @info;
1140    my $error;
1141    my $failure_from;
1142    if ($program eq 'taper') {
1143	$failure_from = $info[4];
1144	$error = join " ", @info[ 5 .. $#info ];
1145    } else {
1146	$error = join " ", @info[ 4 .. $#info ];
1147    }
1148
1149    #TODO: verify that this reaches the right try.  Also, DLE or
1150    #program?
1151    my $dle = $self->get_dle_info($hostname, $disk);
1152
1153    my $program_d;
1154    if ($program eq "planner" ||
1155        $program eq "driver") {
1156	$program_d = $dle->{$program} ||= {};
1157    } else {
1158        my $try = $self->_get_try($dle, $program, $timestamp);
1159        $program_d = $try->{$program} ||= {};
1160    }
1161
1162    $program_d->{level}  = $level;
1163    $program_d->{status} = "fail";
1164    $program_d->{failure_from}  = $failure_from;
1165    $program_d->{error}  = $error;
1166
1167    my $errors = $self->get_program_info("program", "errors", []);
1168    push @$errors, $error;
1169
1170    $self->{flags}{exit_status} |= STATUS_FAILED;
1171    if ($program eq "dumper") {
1172        $self->{contline} = $program_d->{errors} ||= [];
1173	$program_d->{nb_errors} = 0;
1174	$self->{nbline_ref} = \$program_d->{nb_errors};
1175	$self->{nb_normal} = 0;
1176	$self->{nb_strange} = 0;
1177	$self->{nb_error} = 0;
1178    }
1179}
1180
1181
1182sub _handle_error_line
1183{
1184    my $self = shift @_;
1185    my ( $program, $str ) = @_;
1186
1187    my $data      = $self->{data};
1188    my $programs  = $data->{programs};
1189    my $program_p = $programs->{$program};
1190    my $errors_p  = $program_p->{errors} ||= [];
1191
1192    $self->{flags}{exit_status} |= 1;
1193
1194    push @$errors_p, $str;
1195}
1196
1197
1198sub _handle_fatal_line
1199{
1200    my $self = shift @_;
1201    my ( $program, $str ) = @_;
1202
1203    my $data      = $self->{data};
1204    my $programs  = $data->{programs};
1205    my $program_p = $programs->{$program};
1206    my $fatal_p  = $program_p->{fatal} ||= [];
1207
1208    $self->{flags}{exit_status} |= 1;
1209
1210    push @$fatal_p, $str;
1211}
1212
1213
1214sub _handle_start_line
1215{
1216    my $self = shift @_;
1217    my ( $program, $str ) = @_;
1218
1219    my $data     = $self->{data};
1220    my $disklist = $data->{disklist};
1221    my $programs = $data->{programs};
1222
1223    my $program_p = $programs->{$program} ||= {};
1224
1225    my @info = Amanda::Util::split_quoted_strings($str);
1226    my $timestamp = $info[1];
1227    $program_p->{start} = $info[1];
1228
1229    if ($self->{'run_timestamp'} ne '00000000000000'
1230		and $self->{'run_timestamp'} ne $timestamp) {
1231	warning("not all timestamps in this file are the same; "
1232		. "$self->{run_timestamp}; $timestamp");
1233    }
1234    $self->{'run_timestamp'} = $timestamp;
1235}
1236
1237
1238sub _handle_disk_line
1239{
1240    my $self = shift @_;
1241    my ($program, $str) = @_;
1242
1243    my $data     = $self->{data};
1244    my $disklist = $data->{disklist};
1245    my $hosts    = $self->{cache}{hosts} ||= [];
1246    my $dles     = $self->{cache}{dles}  ||= [];
1247
1248    my @info = Amanda::Util::split_quoted_strings($str);
1249    my ($hostname, $disk) = @info;
1250
1251    if (!exists $disklist->{$hostname}) {
1252
1253        $disklist->{$hostname} = {};
1254        push @$hosts, $hostname;
1255    }
1256
1257    if (!exists $disklist->{$hostname}{$disk}) {
1258
1259        push @$dles, [ $hostname, $disk ];
1260        my $dle = $disklist->{$hostname}{$disk} = {};
1261        $dle->{'estimate'} = undef;
1262        $dle->{'dumps'}    = {};
1263    }
1264    return;
1265}
1266
1267sub _handle_success_line
1268{
1269    my $self = shift @_;
1270    my ($program, $str) = @_;
1271
1272    my $data     = $self->{data};
1273    my $disklist = $data->{disklist};
1274    my $hosts    = $self->{cache}{hosts} ||= [];
1275    my $dles     = $self->{cache}{dles}  ||= [];
1276
1277    my @info = Amanda::Util::split_quoted_strings($str);
1278    my ($hostname, $disk, $timestamp, $level, $stat1, $stat2) = @info;
1279
1280    if ($stat1 =~ /skipped/) {
1281        $disklist->{$hostname}{$disk}->{$program}->{'status'} = 'skipped';
1282    }
1283    return;
1284}
1285
1286
1287sub _handle_info_line
1288{
1289    my $self = shift @_;
1290    my ( $program, $str ) = @_;
1291
1292    my $data     = $self->{data};
1293    my $disklist = $data->{disklist};
1294    my $programs = $data->{programs};
1295
1296    my $program_p = $programs->{$program} ||= {};
1297
1298    if ( $str =~ m/^\w+ pid \d+/ || $str =~ m/^pid-done \d+/ ) {
1299
1300        #do not report pid lines
1301        return;
1302
1303    } else {
1304        my $notes = $program_p->{notes} ||= [];
1305        push @$notes, $str;
1306    }
1307}
1308
1309sub _handle_warning_line
1310{
1311    my $self = shift @_;
1312    my ( $program, $str ) = @_;
1313
1314    $self->_handle_info_line($program, $str);
1315}
1316
1317sub _handle_bogus_line
1318{
1319    my $self = shift @_;
1320    my ( $prog, $type, $str ) = @_;
1321
1322    my $data = $self->{data};
1323    my $boguses = $data->{boguses} ||= [];
1324    push @$boguses, [ $prog, $type, $str ];
1325}
1326
1327sub check_missing_fail_strange
1328{
1329    my ($self) = @_;
1330    my @dles = $self->get_dles();
1331
1332    foreach my $dle_entry (@dles) {
1333        my $alldumps = $self->get_dle_info(@$dle_entry, 'dumps');
1334	my $driver = $self->get_dle_info(@$dle_entry, 'driver');
1335	my $planner = $self->get_dle_info(@$dle_entry, 'planner');
1336
1337	if ($planner && $planner->{'status'} eq 'fail') {
1338	    $self->{flags}{dump_failed} = 1;
1339	} elsif ($planner && $planner->{'status'} eq 'skipped') {
1340	    # We don't want these to be counted as missing below
1341	} elsif (!defined $alldumps->{$self->{'run_timestamp'}} and
1342		 !$driver and
1343		 !$planner) {
1344	    $self->{flags}{results_missing} = 1;
1345	    $self->{flags}{exit_status} |= STATUS_MISSING;
1346	} else {
1347	    #get latest try
1348	    my $tries = $alldumps->{$self->{'run_timestamp'}};
1349	    my $try = @$tries[-1];
1350
1351	    if (exists $try->{dumper} && $try->{dumper}->{status} eq 'fail') {
1352		$self->{flags}{dump_failed} = 1;
1353	    } elsif ((defined($try->{'chunker'}) &&
1354		 $try->{'chunker'}->{status} eq 'success') ||
1355		(defined($try->{'taper'}) &&
1356		 $try->{'taper'}->{status} eq 'done')) {
1357		#chunker or taper success, use dumper status
1358		if (exists $try->{dumper} && $try->{dumper}->{status} eq 'strange') {
1359		    $self->{flags}{dump_strange} = 1;
1360		}
1361	    } else {
1362		#chunker or taper failed, the dump is not valid.
1363		$self->{flags}{dump_failed} = 1;
1364	    }
1365	}
1366    }
1367}
1368
1369#
1370# NOTE: there may be a complicated state diagram lurking in the midst
1371# of taper and chunker.  You have been warned.
1372#
1373sub _get_try
1374{
1375    my $self = shift @_;
1376    my ( $dle, $program, $timestamp ) = @_;
1377    my $tries = $dle->{'dumps'}{$timestamp} ||= [];
1378
1379    if (
1380        !@$tries    # no tries
1381        || defined $tries->[-1]->{$program}->{status}
1382        && $self->_program_finished(    # program has finished
1383            $program, $tries->[-1]->{$program}->{status}
1384        )
1385      ) {
1386        push @$tries, {};
1387    }
1388    return $tries->[-1];
1389}
1390
1391
1392sub _program_finished
1393{
1394    my $self = shift @_;
1395    my ( $program, $status ) = @_;
1396
1397    if ( $program eq "chunker" ) {
1398
1399        if ( $status eq "partial" ) {
1400            return;
1401        } else {
1402            return 1;
1403        }
1404
1405    } elsif ( $status eq "done"
1406        || $status eq "success"
1407        || $status eq "fail"
1408        || $status eq "partial" ) {
1409        return 1;
1410
1411    } else {
1412        return 0;
1413    }
1414}
1415
14161;
1417