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

   1 # vim:ft=perl
   2 # Copyright (c) 2008-2012 Zmanda, Inc.  All Rights Reserved.
   3 #
   4 # This program is free software; you can redistribute it and/or
   5 # modify it under the terms of the GNU General Public License
   6 # as published by the Free Software Foundation; either version 2
   7 # of the License, or (at your option) any later version.
   8 #
   9 # This program is distributed in the hope that it will be useful, but
  10 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  11 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  12 # for more details.
  13 #
  14 # You should have received a copy of the GNU General Public License along
  15 # with this program; if not, write to the Free Software Foundation, Inc.,
  16 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  17 #
  18 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  19 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  20
  21 package Installcheck::Run;
  22
  23 =head1 NAME
  24
  25 Installcheck::Run - utilities to set up and run amanda dumps and restores
  26
  27 =head1 SYNOPSIS
  28
  29   use Installcheck::Run;
  30
  31   my $testconf = Installcheck::Run::setup();
  32   # make any modifications you'd like to the configuration
  33   $testconf->write();
  34
  35   ok(Installcheck::Run::run('amdump', 'TESTCONF'), "amdump completes successfully");
  36
  37   # It's generally polite to clean up your mess, although the test
  38   # framework will clean up if your tests crash
  39   Installcheck::Run::cleanup();
  40
  41   SKIP: {
  42     skip "Expect.pm not installed", 7
  43         unless $Installcheck::Run::have_expect;
  44
  45     my $exp = Installcheck::Run::run_expect('amflush', 'TESTCONF');
  46     $exp->expect(..);
  47     # ..
  48   }
  49
  50 =head1 USAGE
  51
  52 High-level tests generally depend on a full-scale run of Amanda --
  53 a fairly messy project.  This module simplifies that process by
  54 abstracting away the mess.  It takes care of:
  55
  56 =over
  57
  58 =item Setting up a holding disk;
  59
  60 =item Setting up several vtapes; and
  61
  62 =item Setting up a DLE pointing to a reasonably-sized subdirectory of the build directory.
  63
  64 =back
  65
  66 Most of this magic is in C<setup()>, which returns a configuration object from
  67 C<Installcheck::Config>, allowing the test to modify that configuration before
  68 writing it out.  The hostname for the DLE is "localhost", and the disk name is
  69 available in C<$Installcheck::Run::diskname>.  This DLE has a subdirectory
  70 C<dir> which can be used as a secondary, smaller DLE if needed.
  71
  72 This module also provides a convenient Perlish interface for running Amanda
  73 commands: C<run($app, $args, ...)>.  This function runs $app (from $sbindir if
  74 $app is not an absolute path), and returns true if the application exited with
  75 a status of zero.  The stdout and stderr of the application are left in
  76 C<$Installcheck::Run::stdout> and C<stderr>, respectively.
  77
  78 To check that a run is successful, and return its stdout (chomped), use
  79 C<run_get($app, $args, ...)>.  This function returns C<''> if the application
  80 returns a nonzero exit status.  Since many Amanda applications send normal
  81 output to stderr, use C<run_get_err($app, $args, ...)> to check that a run is
  82 successful and return its stderr.  Similarly, C<run_err> checks that a run
  83 returns a nonzero exit status, and then returns its stderr, chomped.  If you
  84 need both, use a bare C<run> and then check C<$stderr> and C<$stdout> as needed.
  85
  86 C<run> and friends can be used whether or not this module's C<setup>
  87 was invoked.
  88
  89 Finally, C<cleanup()> cleans up from a run, deleting all backed-up
  90 data, holding disks, and configuration.  It's just good-neighborly
  91 to call this before your test script exits.
  92
  93 =head2 VTAPES
  94
  95 This module sets up a configuration with three 30M vtapes, replete with
  96 the proper vtape directories.  These are controlled by C<chg-disk>.
  97 The tapes are not labeled, and C<autolabel> is not set by
  98 default, although C<labelstr> is set to C<TESTCONF[0-9][0-9]>.
  99
 100 The vtapes are created in <$Installcheck::Run::taperoot>, a subdirectory of
 101 C<$Installcheck::TMP> for ease of later deletion.  The subdirectory for each
 102 slot is available from C<vtape_dir($slot)>, while the parent directory is
 103 available from C<vtape_dir()>.  C<load_vtape($slot)> will "load" the indicated
 104 slot just like chg-disk would, and return the resulting path.
 105
 106 =head2 HOLDING
 107
 108 The holding disk is C<$Installcheck::Run::holdingdir>.  It is a 15M holding disk,
 109 with a chunksize of 1M (to help exercise the chunker).
 110
 111 =head2 DISKLIST
 112
 113 The disklist is empty by default.  Use something like the following
 114 to add an entry:
 115
 116   $testconf->add_dle("localhost $diskname installcheck-test");
 117
 118 The C<installcheck-test> dumptype specifies
 119   auth "local"
 120   compress none
 121   program "GNUTAR"
 122
 123 but of course, it can be modified by the test module.
 124
 125 =head2 INTERACTIVE APPLICATIONS
 126
 127 This package provides a rudimentary wrapper around C<Expect.pm>, which is not
 128 typically included in a perl installation.  Consult C<$have_expect> to see if
 129 this module is installed, and skip any Expect-based tests if it is not.
 130
 131 Otherwise, C<run_expect> takes arguments just like C<run>, but returns an Expect
 132 object which you can use as you would like.
 133
 134 =head2 DIAGNOSTICS
 135
 136 If your test runs 'amdump', a nonzero exit status may not be very helpful.  The
 137 function C<amdump_diag> will attempt to figure out what went wrong and display
 138 useful information for the user via diag().  If it is given an argument, then
 139 it will C<BAIL_OUT> with that message, causing L<Test::Harness> to stop running
 140 tests.  Otherwise, it will simply die(), which will only terminate this
 141 particular test script.
 142
 143 =cut
 144
 145 use Installcheck;
 146 use Installcheck::Config;
 147 use Amanda::Paths;
 148 use File::Path;
 149 use IPC::Open3;
 150 use Cwd qw(abs_path getcwd);
 151 use Carp;
 152 use POSIX qw( WIFEXITED );
 153 use Test::More;
 154 use Amanda::Config qw( :init );
 155 use Amanda::Util qw(slurp);
 156
 157 require Exporter;
 158
 159 @ISA = qw(Exporter);
 160 @EXPORT_OK = qw(setup
 161     run run_get run_get_err run_err
 162     cleanup
 163     $diskname $taperoot $holdingdir
 164     $stdout $stderr $exit_code
 165     load_vtape vtape_dir
 166     amdump_diag run_expect );
 167 @EXPORT = qw(exp_continue exp_continue_timeout);
 168
 169 # global variables
 170 our $stdout = '';
 171 our $stderr = '';
 172
 173 our $have_expect;
 174
 175 BEGIN {
 176     eval "use Expect;";
 177     if ($@) {
 178         $have_expect = 0;
 179         sub ignore() { };
 180         *exp_continue = *ignore;
 181         *exp_continue_timeout = *ignore;
 182     } else {
 183         $have_expect = 1;
 184     }
 185 };
 186
 187 # common paths (note that Installcheck::Dumpcache assumes these do not change)
 188 our $diskname = "$Installcheck::TMP/backmeup";
 189 our $taperoot = "$Installcheck::TMP/vtapes";
 190 our $holdingdir ="$Installcheck::TMP/holding";
 191
 192 sub setup {
 193     my $new_vtapes = shift;
 194     my $nb_slot = shift;
 195     my $testconf = Installcheck::Config->new();
 196
 197     $nb_slot = 3 if !defined $nb_slot;
 198     (-d $diskname) or setup_backmeup();
 199     if ($new_vtapes) {
 200         setup_new_vtapes($testconf, $nb_slot);
 201     } else {
 202         setup_vtapes($testconf, $nb_slot);
 203     }
 204     setup_holding($testconf, 25);
 205     setup_disklist($testconf);
 206
 207     return $testconf;
 208 }
 209
 210 # create the 'backmeup' data
 211 sub setup_backmeup {
 212     my $dir_structure = {
 213         '1megabyte' => 1024*1024,
 214         '1kilobyte' => 1024,
 215         '1byte' => 1,
 216         'dir' => {
 217             'ff' => 182,
 218             'gg' => 2748,
 219             'subdir' => {
 220                 'subsubdir' => {
 221                     '10k' => 1024*10,
 222                 },
 223             },
 224         },
 225     };
 226
 227     rmtree($diskname);
 228     mkpath($diskname) or die("Could not create $name");
 229
 230     # pick a file for 'random' data -- /dev/urandom or, failing that,
 231     # Amanda's ChangeLog.
 232     my $randomfile = "/dev/urandom";
 233     if (!-r $randomfile) {
 234         $randomfile = "../ChangeLog";
 235     }
 236
 237     my $rfd;
 238     $create = sub {
 239         my ($parent, $contents) = @_;
 240         while (my ($name, $val) = each(%$contents)) {
 241             my $name = "$parent/$name";
 242             if (ref($val) eq 'HASH') {
 243                 mkpath($name) or die("Could not create $name");
 244                 $create->($name, $val);
 245             } else {
 246                 my $bytes_needed = $val+0;
 247                 open(my $wfd, ">", $name) or die("Could not open $name: $!");
 248
 249                 # read bytes from a source file as a source of "random" data..
 250                 while ($bytes_needed) {
 251                     my $buf;
 252                     if (!defined($rfd)) {
 253                         open($rfd, "<", "$randomfile") or die("Could not open $randomfile");
 254                     }
 255                     my $to_read = $bytes_needed>10240? 10240:$bytes_needed;
 256                     my $bytes_read = sysread($rfd, $buf, $to_read);
 257                     print $wfd $buf;
 258                     if ($bytes_read < $to_read) {
 259                         close($rfd);
 260                         $rfd = undef;
 261                     }
 262
 263                     $bytes_needed -= $bytes_read;
 264                 }
 265             }
 266         }
 267     };
 268
 269     $create->($diskname, $dir_structure);
 270 }
 271
 272 sub setup_vtapes {
 273     my ($testconf, $ntapes) = @_;
 274     if (-d $taperoot) {
 275         rmtree($taperoot);
 276     }
 277
 278     # make each of the tape directories
 279     for (my $i = 1; $i < $ntapes+1; $i++) {
 280         my $tapepath = "$taperoot/slot$i";
 281         mkpath("$tapepath");
 282     }
 283
 284     load_vtape(1);
 285
 286     # set up the appropriate configuration
 287     $testconf->add_param("tapedev", "\"file:$taperoot\"");
 288     $testconf->add_param("tpchanger", "\"chg-disk\"");
 289     $testconf->add_param("changerfile", "\"$CONFIG_DIR/TESTCONF/ignored-filename\"");
 290     $testconf->add_param("labelstr", "\"TESTCONF[0-9][0-9]\"");
 291     $testconf->add_param("tapecycle", "$ntapes");
 292
 293     # this overwrites the existing TEST-TAPE tapetype
 294     $testconf->add_tapetype('TEST-TAPE', [
 295         'length' => '30 mbytes',
 296         'filemark' => '4 kbytes',
 297     ]);
 298 }
 299
 300 sub setup_new_vtapes {
 301     my ($testconf, $ntapes) = @_;
 302     if (-d $taperoot) {
 303         rmtree($taperoot);
 304     }
 305
 306     # make each of the tape directories
 307     for (my $i = 1; $i < $ntapes+1; $i++) {
 308         my $tapepath = "$taperoot/slot$i";
 309         mkpath("$tapepath");
 310     }
 311
 312     load_vtape(1);
 313
 314     # set up the appropriate configuration
 315     $testconf->add_param("tpchanger", "\"chg-disk:$taperoot\"");
 316     $testconf->add_param("labelstr", "\"TESTCONF[0-9][0-9]\"");
 317     $testconf->add_param("tapecycle", "$ntapes");
 318
 319     # this overwrites the existing TEST-TAPE tapetype
 320     $testconf->add_tapetype('TEST-TAPE', [
 321         'length' => '30 mbytes',
 322         'filemark' => '4 kbytes',
 323     ]);
 324 }
 325
 326 sub setup_holding {
 327     my ($testconf, $mbytes) = @_;
 328
 329     if (-d $holdingdir) {
 330         rmtree($holdingdir);
 331     }
 332     mkpath($holdingdir);
 333
 334     $testconf->add_holdingdisk("hd1", [
 335         'directory' => "\"$holdingdir\"",
 336         'use' => "$mbytes mbytes",
 337         'chunksize' => "1 mbyte",
 338     ]);
 339 }
 340
 341 sub setup_disklist {
 342     my ($testconf) = @_;
 343
 344     $testconf->add_dumptype("installcheck-test", [
 345         'auth' => '"local"',
 346         'compress' => 'none',
 347         'program' => '"GNUTAR"',
 348     ]);
 349 }
 350
 351 sub vtape_dir {
 352     my ($slot) = @_;
 353     if (defined($slot)) {
 354         return "$taperoot/slot$slot";
 355     } else {
 356         return "$taperoot";
 357     }
 358 }
 359
 360 sub load_vtape {
 361     my ($slot) = @_;
 362
 363     # make the data/ symlink from our taperoot
 364     unlink("$taperoot/data");
 365     symlink(vtape_dir($slot), "$taperoot/data")
 366         or die("Could not create 'data' symlink: $!");
 367
 368     return $taperoot;
 369 }
 370
 371 sub run {
 372     my $app = shift;
 373     my @args = @_;
 374     my $errtempfile = "$Installcheck::TMP/stderr$$.out";
 375
 376     # use a temporary file for error output -- this eliminates synchronization
 377     # problems between reading stderr and stdout
 378     local (*INFH, *OUTFH, *ERRFH);
 379     open(ERRFH, ">", $errtempfile);
 380
 381     $app = "$sbindir/$app" unless ($app =~ qr{/});
 382     my $pid = IPC::Open3::open3("INFH", "OUTFH", ">&ERRFH",
 383         "$app", @args);
 384
 385     # immediately close the child's stdin
 386     close(INFH);
 387
 388     # read from stdout until it's closed
 389     $stdout = do { local $/; <OUTFH> };
 390     close(OUTFH);
 391
 392     # and wait for the kid to die
 393     waitpid $pid, 0 or croak("Error waiting for child process to die: $@");
 394     my $status = $?;
 395     close(ERRFH);
 396
 397     # fetch stderr from the temporary file
 398     $stderr = slurp($errtempfile);
 399     unlink($errtempfile);
 400
 401     # and return true if the exit status was zero
 402     $exit_code = $status >> 8;
 403     return WIFEXITED($status) && $exit_code == 0;
 404 }
 405
 406 sub run_get {
 407     if (!run @_) {
 408         my $detail = '';
 409         # prefer to put stderr in the output
 410         if ($stderr) {
 411             $detail .= "\nstderr is:\n$stderr";
 412         } else {
 413             if ($stdout and length($stdout) < 1024) {
 414                 $detail .= "\nstdout is:\n$stdout";
 415             }
 416         }
 417         Test::More::diag("run unexpectedly failed; no output to compare$detail");
 418         return '';
 419     }
 420
 421     my $ret = $stdout;
 422     chomp($ret);
 423     return $ret;
 424 }
 425
 426 sub run_get_err {
 427     if (!run @_) {
 428         my $detail = "\nstderr is:\n$stderr";
 429         Test::More::diag("run unexpectedly failed; no output to compare$detail");
 430         return '';
 431     }
 432
 433     my $ret = $stderr;
 434     chomp($ret);
 435     return $ret;
 436 }
 437
 438 sub run_err {
 439     if (run @_) {
 440         Test::More::diag("run unexpectedly succeeded; no output to compare");
 441         return '';
 442     }
 443
 444     my $ret = $stderr;
 445     chomp($ret);
 446     return $ret;
 447 }
 448
 449 sub cleanup {
 450     Installcheck::Config::cleanup();
 451
 452     if (-d $taperoot) {
 453         rmtree($taperoot);
 454     }
 455     if (-d $holdingdir) {
 456         rmtree($holdingdir);
 457     }
 458 }
 459
 460 sub run_expect {
 461     my $app = shift;
 462     my @args = @_;
 463
 464     die "Expect.pm not found" unless $have_expect;
 465
 466     $app = "$sbindir/$app" unless ($app =~ qr{^/});
 467     my $exp = Expect->new("$app", @args);
 468
 469     return $exp;
 470 }
 471
 472 sub amdump_diag {
 473     my ($msg) = @_;
 474
 475     # try running amreport
 476     my $report = "failure-report.txt";
 477     unlink($report);
 478     my @logfiles = <$CONFIG_DIR/TESTCONF/log/log.*>;
 479     if (@logfiles > 0) {
 480         run('amreport', 'TESTCONF', '-f', $report, '-l', $logfiles[$#logfiles]);
 481         if (-f $report) {
 482             open(my $fh, "<", $report) or return;
 483             for my $line (<$fh>) {
 484                 Test::More::diag($line);
 485             }
 486             unlink($report);
 487             goto bail;
 488         }
 489     }
 490
 491     # maybe there was a config error
 492     config_init($CONFIG_INIT_EXPLICIT_NAME, "TESTCONF");
 493     my ($cfgerr_level, @cfgerr_errors) = config_errors();
 494     if ($cfgerr_level >= $CFGERR_WARNINGS) {
 495         foreach (@cfgerr_errors) {
 496             Test::More::diag($_);
 497         }
 498         goto bail;
 499     }
 500
 501     # huh.
 502     Test::More::diag("no amreport available, and no config errors");
 503
 504 bail:
 505     if ($msg) {
 506         Test::More::BAIL_OUT($msg);
 507     } else {
 508         die("amdump failed; cannot continue");
 509     }
 510 }
 511
 512 1;