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