git.gag.com Git - debian/amanda/blob - installcheck/Installcheck/Catalogs.pm

   1 # Copyright (c) 2010-2012 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 94086, USA, or: http://www.zmanda.com
  19
  20 package Installcheck::Catalogs;
  21
  22 =head1 NAME
  23
  24 Installcheck::Catalogs - manage catalog info that can be used to test
  25 tools that do not need access to actual vtapes
  26
  27 =head1 SYNOPSIS
  28
  29   use Installcheck::Catalogs;
  30   my $cat = Installcheck::Catalogs::load("skipped");
  31   $cat->install();
  32   my @tags = $cat->get_tags();
  33
  34 =head1 DESCRIPTION
  35
  36 The C<load> method loads a named set of catalog information from catalog files.
  37
  38 The resulting object just decodes the catalog information into a perl
  39 structure.  To actually write the catalog to disk, use the C<install> method of
  40 the resulting object.
  41
  42 Note that many test catalogs require a configuration to be loaded; this package
  43 does not handle loading configurations.  However, the C<install> method does
  44 take care of erasing the C<logs> subdirectory of the configuration directory as
  45 well as any stray holding-disk files.
  46
  47 A catalog can have multiple, named snippets of text attached, as well.  These
  48 are accessed via the C<get_text($name)> method.
  49
  50 =head2 Database Results
  51
  52 The C<%H>, C<%P>, and C<%D> directives set up a "shadow database" of dumps and
  53 parts that are represented by the catalog.  These are available in two hashes,
  54 one for dumps and one for parts, available from methods C<get_dumps> and
  55 C<get_parts>.  The hashes are keyed by "tags", which are arbitrary strings.
  56 The dumps and parts are built to look like those produced by
  57 L<Amanda::DB::Catalog>; in particular, a dump has keys
  58
  59   parts (list of parts indexed by partnum)
  60   dump_timestamp
  61   hostname
  62   diskname
  63   level
  64   status
  65   kb
  66   orig_kb
  67   write_timestamp
  68   message
  69   nparts
  70   sec
  71
  72 while a part has keys
  73
  74   dump (points to the parent dump)
  75   status
  76   sec
  77   kb
  78   orig_kb
  79   partnum
  80
  81 a part will also have a C<holding_file> key if it is, indeed, a holding
  82 file.  The C<holding_filename($tag)> method will return the filename of a
  83 holding file.
  84
  85 =head2 Catalog Files
  86
  87 Each file in C<installcheck/catalogs> with the suffix C<.cat> represents a
  88 cached catalog.  Since the Amanda catalog consists of many files (curinfo,
  89 trace logs, index, disklist, tapelist, etc.), each catalog acts as a
  90 container for several other named files.  The file is parsed in a line-based
  91 fashion, with the following conventions:
  92
  93 =over 4
  94
  95 =item A line beginning with C<#> is a comment, and is ignored
  96
  97 =item A line beginning with C<%F> begins a new output file, with the rest of
  98 the line (after whitespace) interpreted as a filename relative to the TESTCONF
  99 configuration directory.  Any intervening directories required will be created.
 100
 101 =item A line beginning with C<%T> begins a new text section.  This is simliar
 102 to C<%F>, but instead of a filename, the rest of the line specifies a text
 103 handle.  The text will not be written to the filesystem on C<install>.
 104
 105 =item A line beginning with C<%H> specifies a holding-disk file.  The rest of
 106 the line is a space-separated list:
 107
 108   %H tag datestamp hostname pathname level status size
 109
 110 A single-chunk holding-disk file of the appropriate size will be created,
 111 filled with garbage, and the corresponding entries will be made in the dump and
 112 part hashes.
 113
 114 =item A line beginning with C<%D> specifies a dump.  The format, all on one line, is:
 115
 116   %D tag dump_timestamp write_timestamp hostname diskname level status
 117     message nparts sec kb orig_kb
 118
 119 =item A line beginning with C<%P> specifies a part.  The format, again all on
 120 one line, is:
 121
 122   %P tag dumptag label filenum partnum status sec kb orig_kb
 123
 124 where C<dumptag> is the tag of the dump of which this is a part.
 125
 126 =item A line beginning with C<%%> is a custom tag, intended for use by scripts
 127 to define their expectations of the logfile.  The results are available from
 128 the C<get_tags> method.
 129
 130 =item A line beginning with C<\> is copied literally into the current output
 131 file, without the leading C<\>.
 132
 133 =item Blank lines are ignored.
 134
 135 =back
 136
 137 =cut
 138
 139 sub load {
 140     my ($name) = @_;
 141
 142     return Installcheck::Catalogs::Catalog->new($name);
 143 }
 144
 145 package Installcheck::Catalogs::Catalog;
 146
 147 use warnings;
 148 use strict;
 149
 150 use Installcheck;
 151 use Amanda::Util;
 152 use Amanda::Paths;
 153 use Amanda::Xfer qw( :constants );
 154 use File::Path qw( mkpath rmtree );
 155
 156 my $holdingdir = "$Installcheck::TMP/holding";
 157
 158 sub new {
 159     my $class = shift;
 160     my ($name) = @_;
 161
 162     my $filename = "$srcdir/catalogs/$name.cat";
 163     die "no catalog file '$filename'" unless -f $filename;
 164
 165     my $self = bless {
 166         files => {},
 167         texts => {},
 168         tags => [],
 169         holding_files => {},
 170         dumps => {},
 171         parts => {},
 172     }, $class;
 173
 174     $self->_parse($filename);
 175
 176     return $self;
 177 }
 178
 179 sub _parse {
 180     my $self = shift;
 181     my ($filename) = @_;
 182     my $write_timestamp;
 183     my $fileref;
 184
 185     open(my $fh, "<", $filename) or die "could not open '$filename'";
 186     while (<$fh>) {
 187         ## comment or blank
 188         if (/^#/ or /^$/) {
 189             next;
 190
 191         ## new output file
 192         } elsif (/^(%[TF])\s*(.*)$/) {
 193             my $cur_filename = $2;
 194             my $kind = ($1 eq '%F')? 'files' : 'texts';
 195             die "duplicate file '$cur_filename'"
 196                 if exists $self->{$kind}{$cur_filename};
 197             $self->{$kind}{$cur_filename} = '';
 198             $fileref = \$self->{$kind}{$cur_filename};
 199
 200         # holding file
 201         } elsif (/^%H (\S+) (\S+) (\S+) (\S+) (\d+) (\S+) (\d+)$/) {
 202
 203             die "dump tag $1 already exists" if exists $self->{'dumps'}{$1};
 204             die "part tag $1 already exists" if exists $self->{'parts'}{$1};
 205
 206             my $safe_disk = $4;
 207             $safe_disk =~ tr{/}{_};
 208             my $hfile = "$holdingdir/$2/$3.$safe_disk";
 209
 210             $self->{'holding_files'}->{$1} = [ $hfile, $2, $3, $4, $5, $6, $7 ];
 211
 212             my $dump = $self->{'dumps'}{$1} = {
 213                 dump_timestamp => $2,
 214                 hostname => $3,
 215                 diskname => $4,
 216                 level => $5+0,
 217                 status => $6,
 218                 kb => $7,
 219                 orig_kb => 0,
 220                 write_timestamp => '00000000000000',
 221                 message => '',
 222                 nparts => 1,
 223                 sec => 0.0,
 224             };
 225             my $part = $self->{'parts'}{$1} = {
 226                 holding_file => $hfile,
 227                 dump => $dump,
 228                 status => $dump->{'status'},
 229                 sec => 0.0,
 230                 kb => $dump->{'kb'},
 231                 orig_kb => 0,
 232                 partnum => 1,
 233             };
 234             $dump->{'parts'} = [ undef, $part ];
 235
 236         # dump
 237         } elsif (/^%D (\S+) (\d+) (\d+) (\S+) (\S+) (\d+) (\S+) (\S+) (\d+) (\S+) (\d+) (\d+)/) {
 238             die "dump tag $1 already exists" if exists $self->{'dumps'}{$1};
 239             my $dump = $self->{'dumps'}{$1} = {
 240                 dump_timestamp => $2,
 241                 write_timestamp => $3,
 242                 hostname => $4,
 243                 diskname => $5,
 244                 level => $6+0,
 245                 status => $7,
 246                 message => $8,
 247                 nparts => $9,
 248                 sec => $10+0.0,
 249                 kb => $11,
 250                 orig_kb => $12,
 251                 parts => [ undef ],
 252             };
 253             # translate "" to an empty string
 254             $dump->{'message'} = '' if $dump->{'message'} eq '""';
 255
 256         # part
 257         } elsif (/^%P (\S+) (\S+) (\S+) (\d+) (\d+) (\S+) (\S+) (\d+) (\d+)/) {
 258             die "part tag $1 already exists" if exists $self->{'parts'}{$1};
 259             die "dump tag $2 does not exist" unless exists $self->{'dumps'}{$2};
 260
 261             my $part = $self->{'parts'}{$1} = {
 262                 dump => $self->{dumps}{$2},
 263                 label => $3,
 264                 filenum => $4,
 265                 partnum => $5,
 266                 status => $6,
 267                 sec => $7+0.0,
 268                 kb => $8,
 269                 orig_kb => $9
 270             };
 271             $self->{'dumps'}->{$2}->{'parts'}->[$5] = $part;
 272
 273         # processing tag
 274         } elsif (/^%%\s*(.*)$/) {
 275             push @{$self->{'tags'}}, $1;
 276
 277         # bogus directive
 278         } elsif (/^%/) {
 279             chomp;
 280             die "invalid processing instruction '$_'";
 281
 282         # contents of the file (\-escaped)
 283         } elsif (/^\\/) {
 284             s/^\\//;
 285             $$fileref .= $_;
 286
 287         # contents of the file (copy)
 288         } else {
 289             $$fileref .= $_;
 290         }
 291     }
 292 }
 293
 294 sub _make_holding_file {
 295     my ($filename, $datestamp, $hostname, $diskname, $level, $status, $size) = @_;
 296
 297     # make the parent dir
 298     my $dir = $filename;
 299     $dir =~ s{/[^/]*$}{};
 300     mkpath($dir);
 301
 302     # (note that multi-chunk holding files are not used at this point)
 303     my $hdr = Amanda::Header->new();
 304     $hdr->{'type'} = $Amanda::Header::F_DUMPFILE;
 305     $hdr->{'datestamp'} = $datestamp;
 306     $hdr->{'dumplevel'} = $level+0;
 307     $hdr->{'name'} = $hostname;
 308     $hdr->{'disk'} = $diskname;
 309     $hdr->{'program'} = "INSTALLCHECK";
 310     $hdr->{'is_partial'} = ($status ne 'OK');
 311
 312     open(my $fh, ">", $filename) or die("opening '$filename': $!");
 313     $fh->syswrite($hdr->to_string(32768,32768));
 314
 315     # transfer some data to that file
 316     my $xfer = Amanda::Xfer->new([
 317         Amanda::Xfer::Source::Pattern->new(1024*$size, "+-+-+-+-"),
 318         Amanda::Xfer::Dest::Fd->new($fh),
 319     ]);
 320
 321     $xfer->start(sub {
 322         my ($src, $msg, $xfer) = @_;
 323         if ($msg->{type} == $XMSG_ERROR) {
 324             die $msg->{elt} . " failed: " . $msg->{message};
 325         } elsif ($msg->{'type'} == $XMSG_DONE) {
 326             $src->remove();
 327             Amanda::MainLoop::quit();
 328         }
 329     });
 330     Amanda::MainLoop::run();
 331     close($fh);
 332 }
 333
 334 sub install {
 335     my $self = shift;
 336
 337     # first, remove the logdir
 338     my $logdir = "$Amanda::Paths::CONFIG_DIR/TESTCONF/log";
 339     rmtree($logdir) if -e $logdir;
 340
 341     # write the new config files
 342     for my $filename (keys %{$self->{'files'}}) {
 343         my $pathname = "$Amanda::Paths::CONFIG_DIR/TESTCONF/$filename";
 344         my $dirname = $pathname;
 345         $dirname =~ s{/[^/]+$}{};
 346
 347         mkpath($dirname) unless -d $dirname;
 348         Amanda::Util::burp($pathname, $self->{'files'}{$filename});
 349     }
 350
 351     # erase holding and create some new holding files
 352     rmtree($holdingdir);
 353     for my $hldinfo (values %{$self->{'holding_files'}}) {
 354         _make_holding_file(@$hldinfo);
 355     }
 356 }
 357
 358 sub get_tags {
 359     my $self = shift;
 360     return @{$self->{'tags'}};
 361 }
 362
 363 sub get_dumps {
 364     my $self = shift;
 365     return %{$self->{'dumps'}};
 366 }
 367
 368 sub get_parts {
 369     my $self = shift;
 370     return %{$self->{'parts'}};
 371 }
 372
 373 sub get_text {
 374     my $self = shift;
 375     my ($name) = @_;
 376
 377     return $self->{'texts'}->{$name};
 378 }
 379
 380 sub get_file {
 381     my $self = shift;
 382     my ($name) = @_;
 383
 384     return $self->{'files'}->{$name};
 385 }
 386
 387 sub holding_filename {
 388     my $self = shift;
 389     my ($tag) = @_;
 390
 391     my $fn = $self->{'holding_files'}{$tag}[0];
 392     return $fn;
 393 }
 394
 395 1;