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