git.gag.com Git - debian/amanda/blob - installcheck/amidxtaped.pl

   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 use Test::More tests => 105;
  21
  22 use strict;
  23 use warnings;
  24 use File::Path;
  25 use Data::Dumper;
  26 use Carp;
  27 use POSIX;
  28
  29 use lib '@amperldir@';
  30 use Installcheck;
  31 use Installcheck::Run qw( $diskname $holdingdir );
  32 use Installcheck::Dumpcache;
  33 use Installcheck::ClientService qw( :constants );
  34 use Amanda::Debug;
  35 use Amanda::MainLoop;
  36 use Amanda::Header;
  37 use Amanda::Feature;
  38 use Amanda::Paths;
  39 use Amanda::Util qw( slurp burp );
  40
  41 Amanda::Debug::dbopen("installcheck");
  42 Installcheck::log_test_output();
  43 my $debug = !exists $ENV{'HARNESS_ACTIVE'};
  44
  45 # parameters:
  46 #   emulate - inetd or amandad (default)
  47 #   datapath -
  48 #       none: do not send fe_amidxtaped_datapath
  49 #       amanda: send fe_amidxtaped_datapath and do datapath negotiation, but send AMANDA
  50 #       directtcp: send fe_amidxtaped_datapath and do datapath negotiation and send both
  51 #               (expects an answer of AMANDA, too)
  52 #   header - send HEADER and expect a header
  53 #   splits - send fe_recover_splits (value is 0, 'basic' (one part; default), or 'parts' (multiple))
  54 #   digit_end - end command with digits instead of 'END'
  55 #   dumpspec - include DISK=, HOST=, (but not DATESTAMP=) that match the dump (default 1)
  56 #   feedme - send a bad device initially, and expect FEEDME response
  57 #   holding - filename of holding file to recover from
  58 #   bad_auth - send incorrect auth in OPTIONS (amandad only)
  59 #   holding_err - 'could not open' error from bogus holding file
  60 #   holding_no_colon_zero - do not append a :0 to the holding filename in DEVICE=
  61 #   no_tapespec - do not send a tapespec in LABEL=, and send the first partnum in FSF=
  62 #       no_fsf - or don't send the first partnum in FSF= and leave amidxtaped to guess
  63 #   ndmp - using NDMP device (so expect directtcp connection)
  64 #   bad_cmd - send a bogus command line and expect an error
  65 #   bad_quoting - send a bogus DISK= without fe_amrecover_correct_disk_quoting
  66 #   recovery_limit - set a non-matching recovery-limit config
  67 #   no_peer_name - do not set AMANDA_AUTHENTICATED_PEER
  68 sub run_amidxtaped {
  69     my %params = @_;
  70     my $service;
  71     my $datasize = -1; # -1 means EOF never arrived
  72     my $hdr;
  73     my $expect_error;
  74     my $chg_name;
  75     my $testmsg;
  76     my ($data_stream, $cmd_stream);
  77     my @events;
  78     my $old_disklist;
  79     my $disklist_file = "$CONFIG_DIR/TESTCONF/disklist";
  80
  81     my $event = sub {
  82         my ($evt) = @_;
  83         diag($evt) if $debug;
  84         push @events, $evt;
  85     };
  86
  87     my $steps = define_steps
  88         cb_ref => \$params{'finished_cb'};
  89
  90     # walk the service through its paces, using the Expect functionality from
  91     # ClientService. This has lots of $params conditionals, so it can be a bit
  92     # difficult to read!
  93
  94     step setup => sub {
  95         # sort out the parameters
  96         $params{'emulate'} ||= 'amandad';
  97         $params{'datapath'} ||= 'none';
  98         $params{'splits'} = 'basic' unless exists $params{'splits'};
  99         $params{'dumpspec'} = 1 unless exists $params{'dumpspec'};
 100
 101         # ignore some incompatible combinations
 102         return $params{'finished_cb'}->()
 103             if ($params{'datapath'} ne 'none' and not $params{'splits'});
 104         return $params{'finished_cb'}->()
 105             if ($params{'bad_auth'} and $params{'emulate'} ne 'amandad');
 106         return $params{'finished_cb'}->()
 107             if ($params{'feedme'} and not $params{'splits'});
 108         return $params{'finished_cb'}->()
 109             if ($params{'feedme'} and $params{'holding'});
 110         return $params{'finished_cb'}->()
 111             if ($params{'holding_err'} and not $params{'holding'});
 112         return $params{'finished_cb'}->()
 113             if ($params{'emulate'} eq 'amandad' and not $params{'splits'});
 114         return $params{'finished_cb'}->()
 115             if ($params{'holding_no_colon_zero'} and not $params{'holding'});
 116
 117         $expect_error = ($params{'bad_auth'}
 118                          or $params{'holding_err'}
 119                          or $params{'bad_cmd'});
 120
 121         if ($params{'ndmp'}) {
 122             $chg_name = "ndmp_server"; # changer name from ndmp dumpcache
 123         } else {
 124             $chg_name = "chg-disk:" . Installcheck::Run::vtape_dir();
 125         }
 126
 127         alarm(120);
 128         local $SIG{'ALRM'} = sub {
 129             diag "TIMEOUT";
 130             $service->kill();
 131         };
 132
 133         $testmsg = $params{'emulate'} . " ";
 134         $testmsg .= $params{'header'}? "header " : "no-header ";
 135         $testmsg .= "datapath($params{'datapath'}) ";
 136         $testmsg .= $params{'splits'}? "fe-splits($params{splits}) " : "!fe-splits ";
 137         $testmsg .= $params{'feedme'}? "feedme " : "!feedme ";
 138         $testmsg .= $params{'holding'}? "holding " : "media ";
 139         $testmsg .= $params{'dumpspec'}? "dumpspec " : "";
 140         $testmsg .= $params{'digit_end'}? "digits " : "";
 141         $testmsg .= $params{'bad_auth'}? "bad_auth " : "";
 142         $testmsg .= $params{'holding_err'}? "holding_err " : "";
 143         $testmsg .= $params{'ndmp'}? "ndmp " : "";
 144         $testmsg .= $params{'holding_no_colon_zero'}? "holding-no-:0 " : "";
 145         $testmsg .= $params{'no_tapespec'}? "no-tapespec " : "";
 146         $testmsg .= $params{'no_fsf'}? "no-fsf " : "";
 147         $testmsg .= $params{'bad_cmd'}? "bad_cmd " : "";
 148         $testmsg .= $params{'bad_quoting'}? "bad_quoting " : "";
 149         $testmsg .= $params{'recovery_limit'}? "recovery_limit " : "";
 150         $testmsg .= $params{'no_peer_name'}? "no_peer_name " : "";
 151
 152         # "hack" the disklist to check recovery_limit
 153         if ($params{'recovery_limit'}) {
 154             $old_disklist = slurp($disklist_file);
 155             my $new_disklist = "localhost $diskname {\n installcheck-test\n".
 156                     "recovery-limit \"some-other-host\"\n}\n";
 157             burp($disklist_file, $new_disklist);
 158         }
 159
 160         diag("starting $testmsg") if $debug;
 161
 162         $service = Installcheck::ClientService->new(
 163                 emulate => $params{'emulate'},
 164                 service => 'amidxtaped',
 165                 auth_peer =>
 166                     ($params{'emulate'} eq 'amandad' && !$params{'no_peer_name'})?
 167                         "localhost" : undef,
 168                 process_done => $steps->{'process_done'});
 169
 170         $steps->{'start'}->();
 171     };
 172
 173     step start => sub {
 174         $cmd_stream = 'main';
 175         if ($params{'emulate'} eq 'inetd') {
 176             # send security line
 177             $service->send('main', "SECURITY USER installcheck\r\n");
 178             $event->("MAIN-SECURITY");
 179             $steps->{'send_cmd1'}->();
 180         } else {
 181             # send REQ packet
 182             my $featstr = Amanda::Feature::Set->mine()->as_string();
 183             my $auth = $params{'bad_auth'}? 'bogus' : 'bsdtcp';
 184             $service->send('main', "OPTIONS features=$featstr;auth=$auth;");
 185             $service->close('main', 'w');
 186             $event->('SENT-REQ');
 187             $steps->{'expect_rep'}->();
 188         }
 189     };
 190
 191     step expect_rep => sub {
 192         my $ctl_hdl = DATA_FD_OFFSET;
 193         my $data_hdl = DATA_FD_OFFSET+1;
 194         $service->expect('main',
 195             [ re => qr/^CONNECT CTL $ctl_hdl DATA $data_hdl\n\n/, $steps->{'got_rep'} ],
 196             [ re => qr/^ERROR .*\n/, $steps->{'got_rep_err'} ]);
 197     };
 198
 199     step got_rep => sub {
 200         $event->('GOT-REP');
 201         $cmd_stream = 'stream1';
 202         $service->expect('main',
 203             [ eof => $steps->{'send_cmd1'} ]);
 204     };
 205
 206     step got_rep_err => sub {
 207         die "$_[0]" unless $expect_error;
 208         $event->('GOT-REP-ERR');
 209     };
 210
 211     step send_cmd1 => sub {
 212         # note that the earlier features are ignored..
 213         my $sendfeat = Amanda::Feature::Set->mine();
 214         if ($params{'datapath'} eq 'none') {
 215             $sendfeat->remove($Amanda::Feature::fe_amidxtaped_datapath);
 216         }
 217         if ($params{'bad_quoting'}) {
 218             $sendfeat->remove($Amanda::Feature::fe_amrecover_correct_disk_quoting);
 219         }
 220         unless ($params{'splits'}) {
 221             $sendfeat->remove($Amanda::Feature::fe_recover_splits);
 222         }
 223         if (!$params{'holding'}) {
 224             if ($params{'splits'} eq 'parts') {
 225                 # nine-part dump
 226                 if ($params{'no_tapespec'}) {
 227                     $service->send($cmd_stream, "LABEL=TESTCONF01\r\n");
 228                 } else {
 229                     $service->send($cmd_stream, "LABEL=TESTCONF01:1,2,3,4,5,6,7,8,9\r\n");
 230                 }
 231             } else {
 232                 # single-part dump
 233                 $service->send($cmd_stream, "LABEL=TESTCONF01:1\r\n");
 234             }
 235         }
 236         if (!$params{'no_fsf'}) {
 237             if ($params{'no_tapespec'}) {
 238                 $service->send($cmd_stream, "FSF=1\r\n");
 239             } else {
 240                 $service->send($cmd_stream, "FSF=0\r\n");
 241             }
 242         }
 243         if ($params{'bad_cmd'}) {
 244             $service->send($cmd_stream, "AWESOMENESS=11\r\n");
 245             return $steps->{'expect_err_message'}->();
 246         }
 247         $service->send($cmd_stream, "HEADER\r\n") if $params{'header'};
 248         $service->send($cmd_stream, "FEATURES=" . $sendfeat->as_string() . "\r\n");
 249         $event->("SEND-FEAT");
 250
 251         # the feature line looks different depending on what we're emulating
 252         if ($params{'emulate'} eq 'inetd') {
 253             # note that this has no trailing newline.  Rather than rely on the
 254             # TCP connection to feed us all the bytes and no more, we just look
 255             # for the exact feature sequence we expect.
 256             my $mine = Amanda::Feature::Set->mine()->as_string();
 257             $service->expect($cmd_stream,
 258                 [ re => qr/^$mine/, $steps->{'got_feat'} ]);
 259         } else {
 260             $service->expect($cmd_stream,
 261                 [ re => qr/^FEATURES=[0-9a-f]+\r\n/, $steps->{'got_feat'} ]);
 262         }
 263     };
 264
 265     step got_feat => sub {
 266         $event->("GOT-FEAT");
 267
 268         # continue sending the command
 269         if ($params{'holding'}) {
 270             my $safe = $params{'holding'};
 271             $safe =~ s/([\\:;,])/\\$1/g;
 272             $safe .= ':0' unless $params{'holding_no_colon_zero'};
 273             $service->send($cmd_stream, "DEVICE=$safe\r\n");
 274         } elsif ($params{'feedme'}) {
 275             # bogus device name
 276             $service->send($cmd_stream, "DEVICE=file:/does/not/exist\r\n");
 277         } else {
 278             $service->send($cmd_stream, "DEVICE=$chg_name\r\n");
 279         }
 280         if ($params{'dumpspec'}) {
 281             $service->send($cmd_stream, "HOST=^localhost\$\r\n");
 282             if ($params{'bad_quoting'}) {
 283                 $service->send($cmd_stream, "DISK=^/foo/bar\$\r\n");
 284             } else {
 285                 $service->send($cmd_stream, "DISK=^$Installcheck::Run::diskname\$\r\n");
 286             }
 287             if ($params{'holding'}) {
 288                 $service->send($cmd_stream, "DATESTAMP=^20111111090909\$\r\n");
 289             } else {
 290                 my $timestamp = $Installcheck::Dumpcache::timestamps[0];
 291                 $service->send($cmd_stream, "DATESTAMP=^$timestamp\$\r\n");
 292             }
 293         }
 294         $service->send($cmd_stream, "CONFIG=TESTCONF\r\n");
 295         if ($params{'digit_end'}) {
 296             $service->send($cmd_stream, "999\r\n"); # dunno why this works..
 297         } else {
 298             $service->send($cmd_stream, "END\r\n");
 299         }
 300         $event->("SENT-CMD");
 301
 302         $steps->{'expect_connect'}->();
 303     };
 304
 305     step expect_connect => sub {
 306         if ($params{'splits'}) {
 307             if ($params{'emulate'} eq 'inetd') {
 308                 $service->expect($cmd_stream,
 309                     [ re => qr/^CONNECT \d+\n/, $steps->{'got_connect'} ]);
 310             } else {
 311                 $data_stream = 'stream2';
 312                 $steps->{'expect_feedme'}->();
 313             }
 314         } else {
 315             # with no split parts, data comes on the command stream
 316             $data_stream = $cmd_stream;
 317             $steps->{'expect_feedme'}->();
 318         }
 319     };
 320
 321     step got_connect => sub {
 322         my ($port) = ($_[0] =~ /CONNECT (\d+)/);
 323         $event->("GOT-CONNECT");
 324
 325         $service->connect('data', $port);
 326         $data_stream = 'data';
 327         $service->send($data_stream, "SECURITY USER installcheck\r\n");
 328         $event->("DATA-SECURITY");
 329
 330         $steps->{'expect_feedme'}->();
 331     };
 332
 333     step expect_feedme => sub  {
 334         Amanda::Debug::debug("HERE");
 335         if ($params{'feedme'}) {
 336             $service->expect($cmd_stream,
 337                 [ re => qr/^FEEDME TESTCONF01\r\n/, $steps->{'got_feedme'} ],
 338                 [ re => qr/^MESSAGE [^\r]*\r\n/, $steps->{'got_message'} ]);
 339         } elsif ($params{'holding_err'} || $params{'recovery_limit'}) {
 340             $steps->{'expect_err_message'}->();
 341         } else {
 342             $steps->{'expect_header'}->();
 343         }
 344     };
 345
 346     step got_message => sub {
 347         # this is usually an error message
 348         $event->('GOT-MESSAGE');
 349         # loop back to expect a feedme..
 350         $steps->{'expect_feedme'}->();
 351     };
 352
 353     step got_feedme => sub {
 354         $event->('GOT-FEEDME');
 355         my $dev_name = "file:" . Installcheck::Run::vtape_dir();
 356         $service->send($cmd_stream, "TAPE $dev_name\r\n");
 357         $steps->{'expect_header'}->();
 358     };
 359
 360     step expect_header => sub {
 361         if ($params{'header'}) {
 362             $service->expect($data_stream,
 363                 [ bytes => 32768, $steps->{'got_header'} ]);
 364         } else {
 365             $steps->{'expect_datapath'}->();
 366         }
 367     };
 368
 369     step got_header => sub {
 370         my ($buf) = @_;
 371         $event->("GOT-HEADER");
 372
 373         if ($params{'datapath'} ne 'none') {
 374             $service->expect($data_stream,
 375                 [ bytes => 1, $steps->{'got_early_bytes'} ]);
 376         }
 377         $hdr = Amanda::Header->from_string($buf);
 378         $steps->{'expect_datapath'}->();
 379     };
 380
 381     step got_early_bytes => sub {
 382         $event->("GOT-EARLY-BYTES");
 383     };
 384
 385     step expect_datapath => sub {
 386         if ($params{'datapath'} ne 'none') {
 387             my $dp = ($params{'datapath'} eq 'amanda')? 'AMANDA' : 'AMANDA DIRECT-TCP';
 388             $service->send($cmd_stream, "AVAIL-DATAPATH $dp\r\n");
 389             $event->("SENT-DATAPATH");
 390
 391             $service->expect($cmd_stream,
 392                 [ re => qr/^USE-DATAPATH .*\r\n/, $steps->{'got_dp'} ]);
 393         } else {
 394             $steps->{'expect_data'}->();
 395         }
 396     };
 397
 398     step got_dp => sub {
 399         my ($dp, $addrs) = ($_[0] =~ /USE-DATAPATH (\S+)(.*)\r\n/);
 400         $event->("GOT-DP-$dp");
 401
 402         # if this is a direct-tcp connection, then we need to connect to
 403         # it and expect the data across it
 404         if ($dp eq 'DIRECT-TCP') {
 405             my ($port) = ($addrs =~ / 127.0.0.1:(\d+).*/);
 406             die "invalid DIRECT-TCP reply $addrs" unless ($port);
 407             #remove got_early_bytes on $data_stream
 408             $service->expect($data_stream,
 409                 [ eof => $steps->{'do_nothing'} ]);
 410
 411             $service->connect('directtcp', $port);
 412             $data_stream = 'directtcp';
 413         }
 414
 415         $steps->{'expect_data'}->();
 416     };
 417
 418     step do_nothing => sub {
 419     };
 420
 421     step expect_data => sub {
 422         $service->expect($data_stream,
 423             [ bytes_to_eof => $steps->{'got_data'} ]);
 424         # note that we ignore EOF on the control connection,
 425         # as its timing is not very predictable
 426
 427         if ($params{'datapath'} ne 'none') {
 428             $service->send($cmd_stream, "DATAPATH-OK\r\n");
 429             $event->("SENT-DATAPATH-OK");
 430         }
 431
 432     };
 433
 434     step got_data => sub {
 435         my ($bytes) = @_;
 436
 437         $datasize = $bytes;
 438         $event->("DATA-TO-EOF");
 439     };
 440
 441     # expected errors jump right to this
 442     step expect_err_message => sub {
 443         $expect_error = 1;
 444         $service->expect($cmd_stream,
 445             [ re => qr/^MESSAGE.*\r\n/, $steps->{'got_err_message'} ])
 446     };
 447
 448     step got_err_message => sub {
 449         my ($line) = @_;
 450         if ($line =~ /^MESSAGE invalid command.*/) {
 451             $event->("ERR-INVAL-CMD");
 452         } elsif ($line =~ /^MESSAGE could not open.*/) {
 453             $event->('GOT-HOLDING-ERR');
 454         } elsif ($line =~ /^MESSAGE No matching dumps found.*/) {
 455             $event->('GOT-NOMATCH');
 456         } else {
 457             $event->('UNKNOWN-MSG');
 458         }
 459
 460         # process should exit now
 461     };
 462
 463     step process_done => sub {
 464         my ($w) = @_;
 465         my $exitstatus = POSIX::WIFEXITED($w)? POSIX::WEXITSTATUS($w) : -1;
 466         $event->("EXIT-$exitstatus");
 467         $steps->{'verify'}->();
 468     };
 469
 470     step verify => sub {
 471         # reset the alarm - the risk of deadlock has passed
 472         alarm(0);
 473
 474         # reset the disklist, if necessary
 475         if ($old_disklist) {
 476             burp($disklist_file, $old_disklist);
 477         }
 478
 479         # do a little bit of gymnastics to only treat this as one test
 480
 481         my $ok = 1;
 482
 483         if ($ok and !$expect_error and $params{'header'}) {
 484             if ($hdr->{'name'} ne 'localhost' or $hdr->{'disk'} ne $diskname) {
 485                 $ok = 0;
 486                 is_deeply([ $hdr->{'name'}, $hdr->{'disk'} ],
 487                           [ 'localhost',    $diskname ],
 488                     "$testmsg (header mismatch; header logged to debug log)")
 489                     or $hdr->debug_dump();
 490             }
 491         }
 492
 493         if ($ok and !$expect_error) {
 494             if ($params{'holding'}) {
 495                 $ok = 0 if ($datasize != 131072);
 496                 diag("got $datasize bytes of data but expected exactly 128k from holding file")
 497                     unless $ok;
 498             } else {
 499                 # get the original size from the header and calculate the size we
 500                 # read, rounded up to the next kilobyte
 501                 my $orig_size = $hdr? $hdr->{'orig_size'} : 0;
 502                 my $got_kb = int($datasize / 1024);
 503
 504                 if ($orig_size) {
 505                     my $diff = abs($got_kb - $orig_size);
 506
 507                     # allow 32k of "slop" here, for rounding, etc.
 508                     $ok = 0 if $diff > 32;
 509                     diag("got $got_kb kb; expected about $orig_size kb based on header")
 510                         unless $ok;
 511                 } else {
 512                     $ok = 0 if $got_kb < 64;
 513                     diag("got $got_kb; expected at least 64k")
 514                         unless $ok;
 515                 }
 516             }
 517
 518             if (!$ok) {
 519                 fail($testmsg);
 520             }
 521         }
 522
 523         if ($ok) {
 524             my $inetd = $params{'emulate'} eq 'inetd';
 525
 526             my @sec_evts = $inetd? ('MAIN-SECURITY') : ('SENT-REQ', 'GOT-REP'),
 527             my @datapath_evts;
 528             if ($params{'datapath'} eq 'amanda') {
 529                 @datapath_evts = ('SENT-DATAPATH', 'GOT-DP-AMANDA', 'SENT-DATAPATH-OK');
 530             } elsif ($params{'datapath'} eq 'directtcp' and not $params{'ndmp'}) {
 531                 @datapath_evts = ('SENT-DATAPATH', 'GOT-DP-AMANDA', 'SENT-DATAPATH-OK');
 532             } elsif ($params{'datapath'} eq 'directtcp' and $params{'ndmp'}) {
 533                 @datapath_evts = ('SENT-DATAPATH', 'GOT-DP-DIRECT-TCP', 'SENT-DATAPATH-OK');
 534             }
 535
 536             my @exp_events = (
 537                         @sec_evts,
 538                         'SEND-FEAT', 'GOT-FEAT', 'SENT-CMD',
 539                         ($inetd and $params{'splits'})? ('GOT-CONNECT', 'DATA-SECURITY') : (),
 540                         $params{'feedme'}? ('GOT-MESSAGE', 'GOT-FEEDME') : (),
 541                         $params{'header'}? ('GOT-HEADER') : (),
 542                         @datapath_evts,
 543                         'DATA-TO-EOF', 'EXIT-0', );
 544             # handle a few error conditions differently
 545             if ($params{'bad_cmd'}) {
 546                 @exp_events = ( @sec_evts, 'ERR-INVAL-CMD', 'EXIT-0' );
 547             }
 548             if ($params{'bad_auth'}) {
 549                 @exp_events = ( 'SENT-REQ', 'GOT-REP-ERR', 'EXIT-1' );
 550             }
 551             if ($params{'holding_err'}) {
 552                 @exp_events = (
 553                         @sec_evts,
 554                         'SEND-FEAT', 'GOT-FEAT', 'SENT-CMD',
 555                         ($inetd and $params{'splits'})? ('GOT-CONNECT', 'DATA-SECURITY') : (),
 556                         'GOT-HOLDING-ERR', 'EXIT-0' );
 557             }
 558             if ($params{'recovery_limit'}) {
 559                 @exp_events = (
 560                         @sec_evts,
 561                         'SEND-FEAT', 'GOT-FEAT', 'SENT-CMD',
 562                         'GOT-NOMATCH', 'EXIT-0' );
 563             }
 564             $ok = is_deeply([@events], [@exp_events],
 565                 $testmsg);
 566         }
 567
 568         diag(Dumper([@events])) if not $ok;
 569
 570         $params{'finished_cb'}->();
 571     };
 572 }
 573
 574 sub test {
 575     my %params = @_;
 576     $params{'finished_cb'} = \&Amanda::MainLoop::quit;
 577     run_amidxtaped(%params);
 578     Amanda::MainLoop::run();
 579 }
 580
 581 sub make_holding_file {
 582
 583     my $hdir = "$holdingdir/20111111090909";
 584     my $safe_diskname = Amanda::Util::sanitise_filename($diskname);
 585     my $filename = "$hdir/localhost.$safe_diskname.3";
 586
 587     mkpath($hdir) or die("Could not create $hdir");
 588     open(my $fh, ">", $filename) or die "opening '$filename': $!";
 589
 590     # header plus 128k
 591
 592     my $hdr = Amanda::Header->new();
 593     $hdr->{'type'} = $Amanda::Header::F_DUMPFILE;
 594     $hdr->{'datestamp'} = '20111111090909';
 595     $hdr->{'dumplevel'} = 3;
 596     $hdr->{'compressed'} = 0;
 597     $hdr->{'comp_suffix'} = ".foo";
 598     $hdr->{'name'} = 'localhost';
 599     $hdr->{'disk'} = "$diskname";
 600     $hdr->{'program'} = "INSTALLCHECK";
 601     $fh->syswrite($hdr->to_string(32768,32768), 32768);
 602
 603     my $bytes_to_write = 131072;
 604     my $bufbase = substr((('='x127)."\n".('-'x127)."\n") x 4, 8, -3) . "1K\n";
 605     die length($bufbase) unless length($bufbase) == 1024-8;
 606     my $k = 0;
 607     while ($bytes_to_write > 0) {
 608         my $buf = sprintf("%08x", $k++).$bufbase;
 609         my $written = $fh->syswrite($buf, $bytes_to_write);
 610         if (!defined($written)) {
 611             die "writing holding file: $!";
 612         }
 613         $bytes_to_write -= $written;
 614     }
 615     close($fh);
 616
 617     return $filename;
 618 }
 619
 620 ## normal operation
 621
 622 Installcheck::Dumpcache::load('basic');
 623 my $loaded_dumpcache = 'basic';
 624 my $holdingfile;
 625 my $emulate;
 626
 627 for my $splits (0, 'basic', 'parts') { # two flavors of 'true'
 628     if ($splits and $splits ne $loaded_dumpcache) {
 629         Installcheck::Dumpcache::load($splits);
 630         $loaded_dumpcache = $splits;
 631     }
 632     for $emulate ('inetd', 'amandad') {
 633         # note that 'directtcp' here expects amidxtaped to reply with AMANDA
 634         for my $datapath ('none', 'amanda', 'directtcp') {
 635             for my $header (0, 1) {
 636                 for my $feedme (0, 1) {
 637                     for my $holding (0, 1) {
 638                         if ($holding and (!$holdingfile or ! -e $holdingfile)) {
 639                             $holdingfile = make_holding_file();
 640                         }
 641                         test(
 642                             emulate => $emulate,
 643                             datapath => $datapath,
 644                             header => $header,
 645                             splits => $splits,
 646                             feedme => $feedme,
 647                             $holding? (holding => $holdingfile):(),
 648                         );
 649                     }
 650                 }
 651             }
 652         }
 653
 654         # dumps from media can omit the tapespec in the label (amrecover-2.4.5 does
 655         # this).  We try it with multiple
 656         test(emulate => $emulate, splits => $splits, no_tapespec => 1);
 657
 658         # and may even omit the FSF! (not sure what does this, but it's testable)
 659         test(emulate => $emulate, splits => $splits, no_tapespec => 1, no_fsf => 1);
 660     }
 661 }
 662
 663 Installcheck::Dumpcache::load("basic");
 664 $holdingfile = make_holding_file();
 665 $loaded_dumpcache = 'basic';
 666
 667 ## miscellaneous edge cases
 668
 669 for $emulate ('inetd', 'amandad') {
 670     # can send something beginning with a digit instead of "END\r\n"
 671     test(emulate => $emulate, digit_end => 1);
 672
 673     # missing dumpspec doesn't cause an error
 674     test(emulate => $emulate, dumpspec => 0);
 675
 676     # missing holding generates error message
 677     test(emulate => $emulate,
 678          holding => "$Installcheck::TMP/no-such-file", holding_err => 1);
 679
 680     # holding can omit the :0 suffix (amrecover-2.4.5 does this)
 681     test(emulate => $emulate, holding => $holdingfile,
 682          holding_no_colon_zero => 1);
 683 }
 684
 685 # missing peer name is not normally a problem
 686 test(emulate => 'amandad', no_peer_name => 1);
 687
 688 # if the recovery_limit is given and not matching, we get an error..
 689 test(emulate => 'amandad', recovery_limit => 1);
 690
 691 # bad authentication triggers an error message
 692 test(emulate => 'amandad', bad_auth => 1);
 693
 694 # bad quoting should work just fine, with the proper feature missing
 695 test(emulate => 'amandad', bad_quoting => 1);
 696
 697 # and a bad command triggers an error
 698 test(emulate => 'amandad', bad_cmd => 1);
 699
 700 ## check decompression
 701
 702 Installcheck::Dumpcache::load('compress');
 703
 704 test(dumpspec => 0, emulate => 'amandad',
 705      datapath => 'none', header => 1,
 706      splits => 'basic', feedme => 0, holding => 0);
 707
 708 ## directtcp device (NDMP)
 709
 710 SKIP: {
 711     skip "not built with ndmp and server", 5 unless
 712         Amanda::Util::built_with_component("ndmp") and
 713         Amanda::Util::built_with_component("server");
 714
 715     my $ndmp = Installcheck::Mock::NdmpServer->new();
 716     Installcheck::Dumpcache::load('ndmp');
 717     $ndmp->edit_config();
 718
 719     # test a real directtcp transfer both with and without a header
 720     test(emulate => 'amandad', splits => 'basic',
 721         datapath => 'directtcp', header => 1, ndmp => $ndmp);
 722     test(emulate => 'amandad', splits => 'basic',
 723         datapath => 'directtcp', header => 0, ndmp => $ndmp);
 724
 725     # and likewise an amanda transfer with a directtcp device
 726     test(emulate => 'amandad', splits => 'basic',
 727         datapath => 'amanda', header => 1, ndmp => $ndmp);
 728     test(emulate => 'amandad', splits => 'basic',
 729         datapath => 'amanda', header => 0, ndmp => $ndmp);
 730
 731     # and finally a datapath-free transfer with such a device
 732     test(emulate => 'amandad', splits => 'basic',
 733         datapath => 'none', header => 1, ndmp => $ndmp);
 734 }
 735
 736 ## cleanup
 737
 738 unlink($holdingfile);
 739 Installcheck::Run::cleanup();