Imported Upstream version 3.2.0

[debian/amanda] / installcheck / Installcheck / Catalogs.pm

# Copyright (c) 2010 Zmanda, Inc.  All Rights Reserved.
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License version 2 as published
# by the Free Software Foundation.
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
#
# Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
# Sunnyvale, CA 94086, USA, or: http://www.zmanda.com

package Installcheck::Catalogs;

=head1 NAME

Installcheck::Catalogs - manage catalog info that can be used to test
tools that do not need access to actual vtapes

=head1 SYNOPSIS

  use Installcheck::Catalogs;
  my $cat = Installcheck::Catalogs::load("skipped");
  $cat->install();
  my @tags = $cat->get_tags();

=head1 DESCRIPTION

The C<load> method loads a named set of catalog information from catalog files.

The resulting object just decodes the catalog information into a perl
structure.  To actually write the catalog to disk, use the C<install> method of
the resulting object.

Note that many test catalogs require a configuration to be loaded; this package
does not handle loading configurations.  However, the C<install> method does
take care of erasing the C<logs> subdirectory of the configuration directory as
well as any stray holding-disk files.

A catalog can have multiple, named snippets of text attached, as well.  These
are accessed via the C<get_text($name)> method.

=head2 Database Results

The C<%H>, C<%P>, and C<%D> directives set up a "shadow database" of dumps and
parts that are represented by the catalog.  These are available in two hashes,
one for dumps and one for parts, available from methods C<get_dumps> and
C<get_parts>.  The hashes are keyed by "tags", which are arbitrary strings.
The dumps and parts are built to look like those produced by
L<Amanda::DB::Catalog>; in particular, a dump has keys

  parts (list of parts indexed by partnum)
  dump_timestamp
  hostname
  diskname
  level
  status
  kb
  orig_kb
  write_timestamp
  message
  nparts
  sec

while a part has keys

  dump (points to the parent dump)
  status
  sec
  kb
  orig_kb
  partnum

a part will also have a C<holding_file> key if it is, indeed, a holding
file.  The C<holding_filename($tag)> method will return the filename of a
holding file.

=head2 Catalog Files

Each file in C<installcheck/catalogs> with the suffix C<.cat> represents a
cached catalog.  Since the Amanda catalog consists of many files (curinfo,
trace logs, index, disklist, tapelist, etc.), each catalog acts as a
container for several other named files.  The file is parsed in a line-based
fashion, with the following conventions:

=over 4

=item A line beginning with C<#> is a comment, and is ignored

=item A line beginning with C<%F> begins a new output file, with the rest of
the line (after whitespace) interpreted as a filename relative to the TESTCONF
configuration directory.  Any intervening directories required will be created.

=item A line beginning with C<%T> begins a new text section.  This is simliar
to C<%F>, but instead of a filename, the rest of the line specifies a text
handle.  The text will not be written to the filesystem on C<install>.

=item A line beginning with C<%H> specifies a holding-disk file.  The rest of
the line is a space-separated list:

  %H tag datestamp hostname pathname level status size

A single-chunk holding-disk file of the appropriate size will be created,
filled with garbage, and the corresponding entries will be made in the dump and
part hashes.

=item A line beginning with C<%D> specifies a dump.  The format, all on one line, is:

  %D tag dump_timestamp write_timestamp hostname diskname level status
    message nparts sec kb orig_kb

=item A line beginning with C<%P> specifies a part.  The format, again all on
one line, is:

  %P tag dumptag label filenum partnum status sec kb orig_kb

where C<dumptag> is the tag of the dump of which this is a part.

=item A line beginning with C<%%> is a custom tag, intended for use by scripts
to define their expectations of the logfile.  The results are available from
the C<get_tags> method.

=item A line beginning with C<\> is copied literally into the current output
file, without the leading C<\>.

=item Blank lines are ignored.

=back

=cut

sub load {
    my ($name) = @_;

    return Installcheck::Catalogs::Catalog->new($name);
}

package Installcheck::Catalogs::Catalog;

use warnings;
use strict;

use Installcheck;
use Amanda::Util;
use Amanda::Paths;
use Amanda::Xfer qw( :constants );
use File::Path qw( mkpath rmtree );

my $holdingdir = "$Installcheck::TMP/holding";

sub new {
    my $class = shift;
    my ($name) = @_;

    my $filename = "$srcdir/catalogs/$name.cat";
    die "no catalog file '$filename'" unless -f $filename;

    my $self = bless {
        files => {},
        texts => {},
        tags => [],
        holding_files => {},
        dumps => {},
        parts => {},
    }, $class;

    $self->_parse($filename);

    return $self;
}

sub _parse {
    my $self = shift;
    my ($filename) = @_;
    my $write_timestamp;
    my $fileref;

    open(my $fh, "<", $filename) or die "could not open '$filename'";
    while (<$fh>) {
        ## comment or blank
        if (/^#/ or /^$/) {
            next;

        ## new output file
        } elsif (/^(%[TF])\s*(.*)$/) {
            my $cur_filename = $2;
            my $kind = ($1 eq '%F')? 'files' : 'texts';
            die "duplicate file '$cur_filename'"
                if exists $self->{$kind}{$cur_filename};
            $self->{$kind}{$cur_filename} = '';
            $fileref = \$self->{$kind}{$cur_filename};

        # holding file
        } elsif (/^%H (\S+) (\S+) (\S+) (\S+) (\d+) (\S+) (\d+)$/) {

            die "dump tag $1 already exists" if exists $self->{'dumps'}{$1};
            die "part tag $1 already exists" if exists $self->{'parts'}{$1};

            my $safe_disk = $4;
            $safe_disk =~ tr{/}{_};
            my $hfile = "$holdingdir/$2/$3.$safe_disk";

            $self->{'holding_files'}->{$1} = [ $hfile, $2, $3, $4, $5, $6, $7 ];

            my $dump = $self->{'dumps'}{$1} = {
                dump_timestamp => $2,
                hostname => $3,
                diskname => $4,
                level => $5+0,
                status => $6,
                kb => $7,
                orig_kb => 0,
                write_timestamp => '00000000000000',
                message => '',
                nparts => 1,
                sec => 0.0,
            };
            my $part = $self->{'parts'}{$1} = {
                holding_file => $hfile,
                dump => $dump,
                status => $dump->{'status'},
                sec => 0.0,
                kb => $dump->{'kb'},
                orig_kb => 0,
                partnum => 1,
            };
            $dump->{'parts'} = [ undef, $part ];

        # dump
        } elsif (/^%D (\S+) (\d+) (\d+) (\S+) (\S+) (\d+) (\S+) (\S+) (\d+) (\S+) (\d+) (\d+)/) {
            die "dump tag $1 already exists" if exists $self->{'dumps'}{$1};
            my $dump = $self->{'dumps'}{$1} = {
                dump_timestamp => $2,
                write_timestamp => $3,
                hostname => $4,
                diskname => $5,
                level => $6+0,
                status => $7,
                message => $8,
                nparts => $9,
                sec => $10+0.0,
                kb => $11,
                orig_kb => $12,
                parts => [ undef ],
            };
            # translate "" to an empty string
            $dump->{'message'} = '' if $dump->{'message'} eq '""';

        # part
        } elsif (/^%P (\S+) (\S+) (\S+) (\d+) (\d+) (\S+) (\S+) (\d+) (\d+)/) {
            die "part tag $1 already exists" if exists $self->{'parts'}{$1};
            die "dump tag $2 does not exist" unless exists $self->{'dumps'}{$2};

            my $part = $self->{'parts'}{$1} = {
                dump => $self->{dumps}{$2},
                label => $3,
                filenum => $4,
                partnum => $5,
                status => $6,
                sec => $7+0.0,
                kb => $8,
                orig_kb => $9
            };
            $self->{'dumps'}->{$2}->{'parts'}->[$5] = $part;

        # processing tag
        } elsif (/^%%\s*(.*)$/) {
            push @{$self->{'tags'}}, $1;

        # bogus directive
        } elsif (/^%/) {
            chomp;
            die "invalid processing instruction '$_'";

        # contents of the file (\-escaped)
        } elsif (/^\\/) {
            s/^\\//;
            $$fileref .= $_;

        # contents of the file (copy)
        } else {
            $$fileref .= $_;
        }
    }
}

sub _make_holding_file {
    my ($filename, $datestamp, $hostname, $diskname, $level, $status, $size) = @_;

    # make the parent dir
    my $dir = $filename;
    $dir =~ s{/[^/]*$}{};
    mkpath($dir);

    # (note that multi-chunk holding files are not used at this point)
    my $hdr = Amanda::Header->new();
    $hdr->{'type'} = $Amanda::Header::F_DUMPFILE;
    $hdr->{'datestamp'} = $datestamp;
    $hdr->{'dumplevel'} = $level+0;
    $hdr->{'name'} = $hostname;
    $hdr->{'disk'} = $diskname;
    $hdr->{'program'} = "INSTALLCHECK";
    $hdr->{'is_partial'} = ($status ne 'OK');

    open(my $fh, ">", $filename) or die("opening '$filename': $!");
    $fh->syswrite($hdr->to_string(32768,32768));

    # transfer some data to that file
    my $xfer = Amanda::Xfer->new([
        Amanda::Xfer::Source::Pattern->new(1024*$size, "+-+-+-+-"),
        Amanda::Xfer::Dest::Fd->new($fh),
    ]);

    $xfer->start(sub {
        my ($src, $msg, $xfer) = @_;
        if ($msg->{type} == $XMSG_ERROR) {
            die $msg->{elt} . " failed: " . $msg->{message};
        } elsif ($msg->{'type'} == $XMSG_DONE) {
            $src->remove();
            Amanda::MainLoop::quit();
        }
    });
    Amanda::MainLoop::run();
    close($fh);
}

sub install {
    my $self = shift;

    # first, remove the logdir
    my $logdir = "$Amanda::Paths::CONFIG_DIR/TESTCONF/log";
    rmtree($logdir) if -e $logdir;

    # write the new config files
    for my $filename (keys %{$self->{'files'}}) {
        my $pathname = "$Amanda::Paths::CONFIG_DIR/TESTCONF/$filename";
        my $dirname = $pathname;
        $dirname =~ s{/[^/]+$}{};

        mkpath($dirname) unless -d $dirname;
        Amanda::Util::burp($pathname, $self->{'files'}{$filename});
    }

    # erase holding and create some new holding files
    rmtree($holdingdir);
    for my $hldinfo (values %{$self->{'holding_files'}}) {
        _make_holding_file(@$hldinfo);
    }
}

sub get_tags {
    my $self = shift;
    return @{$self->{'tags'}};
}

sub get_dumps {
    my $self = shift;
    return %{$self->{'dumps'}};
}

sub get_parts {
    my $self = shift;
    return %{$self->{'parts'}};
}

sub get_text {
    my $self = shift;
    my ($name) = @_;

    return $self->{'texts'}->{$name};
}

sub get_file {
    my $self = shift;
    my ($name) = @_;

    return $self->{'files'}->{$name};
}

sub holding_filename {
    my $self = shift;
    my ($tag) = @_;

    my $fn = $self->{'holding_files'}{$tag}[0];
    return $fn;
}

1;