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

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