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

   1 # Copyright (c) 2008, 2009, 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 => 505;
  20 use File::Path qw( mkpath rmtree );
  21 use Sys::Hostname;
  22 use Carp;
  23 use strict;
  24 use warnings;
  25
  26 use lib "@amperldir@";
  27 use Installcheck;
  28 use Installcheck::Mock;
  29 use Installcheck::Config;
  30 use Amanda::Debug;
  31 use Amanda::Device qw( :constants );
  32 use Amanda::Config qw( :getconf :init );
  33 use Amanda::Xfer qw( :constants );
  34 use Amanda::Header qw( :constants );
  35 use Amanda::Paths;
  36 use Amanda::Util;
  37 use Amanda::MainLoop;
  38 use IO::Socket;
  39
  40 my $dev;
  41 my $dev_name;
  42 my ($vtape1, $vtape2);
  43 my ($input_filename, $output_filename) =
  44     ( "$Installcheck::TMP/input.tmp", "$Installcheck::TMP/output.tmp" );
  45 my $taperoot = "$Installcheck::TMP/Amanda_Device_test_tapes";
  46 my $testconf;
  47
  48 # we'll need some vtapes..
  49 sub mkvtape {
  50     my ($num) = @_;
  51
  52     my $mytape = "$taperoot/$num";
  53     if (-d $mytape) { rmtree($mytape); }
  54     mkpath("$mytape/data");
  55     return $mytape;
  56 }
  57
  58
  59 # make up a fake dumpfile_t to write with
  60 my $dumpfile = Amanda::Header->new();
  61 $dumpfile->{type} = $Amanda::Header::F_DUMPFILE;
  62 $dumpfile->{datestamp} = "20070102030405";
  63 $dumpfile->{dumplevel} = 0;
  64 $dumpfile->{compressed} = 1;
  65 $dumpfile->{name} = "localhost";
  66 $dumpfile->{disk} = "/home";
  67 $dumpfile->{program} = "INSTALLCHECK";
  68
  69 my $write_file_count = 5;
  70 sub write_file {
  71     my ($seed, $length, $filenum) = @_;
  72
  73     $dumpfile->{'datestamp'} = "2000010101010$filenum";
  74
  75     ok($dev->start_file($dumpfile),
  76         "start file $filenum")
  77         or diag($dev->error_or_status());
  78
  79     is($dev->file(), $filenum,
  80         "Device has correct filenum");
  81
  82     croak ("selected file size $length is *way* too big")
  83         unless ($length < 1024*1024*10);
  84     ok(Amanda::Device::write_random_to_device($seed, $length, $dev),
  85         "write random data");
  86
  87     if(ok($dev->in_file(),
  88         "still in_file")) {
  89         ok($dev->finish_file(),
  90             "finish_file")
  91             or diag($dev->error_or_status());
  92     } else {
  93         pass("not in file, so not calling finish_file");
  94     }
  95 }
  96
  97 my $verify_file_count = 4;
  98 sub verify_file {
  99     my ($seed, $length, $filenum) = @_;
 100
 101     ok(my $read_dumpfile = $dev->seek_file($filenum),
 102         "seek to file $filenum")
 103         or diag($dev->error_or_status());
 104     is($dev->file(), $filenum,
 105         "device is really at file $filenum");
 106     ok(header_for($read_dumpfile, $filenum),
 107         "header is correct")
 108         or diag($dev->error_or_status());
 109     ok(Amanda::Device::verify_random_from_device($seed, $length, $dev),
 110         "verified file contents");
 111 }
 112
 113 sub header_for {
 114     my ($hdr, $filenum) = @_;
 115     return ($hdr and $hdr->{'datestamp'} eq "2000010101010$filenum");
 116 }
 117
 118 # properties test
 119
 120 my @common_properties = (
 121     'appendable',
 122     'block_size',
 123     'canonical_name',
 124     'concurrency',
 125     'max_block_size',
 126     'medium_access_type',
 127     'min_block_size',
 128     'partial_deletion',
 129     'full_deletion',
 130     'streaming',
 131 );
 132
 133 sub properties_include {
 134     my ($got, $should_include, $msg) = @_;
 135     my %got = map { $_->{'name'}, 1 } @$got;
 136     my @missing = grep { !defined($got{$_}) } @$should_include;
 137     if (@missing) {
 138         fail($msg);
 139         diag(" Expected properties: " . join(", ", @$should_include));
 140         diag("      Got properties: " . join(", ", @$got));
 141         diag("  Missing properties: " . join(", ", @missing));
 142     } else {
 143         pass($msg);
 144     }
 145 }
 146
 147 ####
 148 ## get stuff set up
 149
 150 $testconf = Installcheck::Config->new();
 151 $testconf->write();
 152 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 153     or die("Could not load configuration");
 154
 155 # put the debug messages somewhere
 156 Amanda::Debug::dbopen("installcheck");
 157 Installcheck::log_test_output();
 158
 159 ####
 160 ## Test errors a little bit
 161
 162 $dev = Amanda::Device->new("foobar:");
 163 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 164     "creation of a bogus 'foobar:' device fails");
 165
 166 $dev = Amanda::Device->new("rait:{{");
 167 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 168     "creation of a bogus 'rait:{{' device fails");
 169
 170 $dev = Amanda::Device->new("rait:{a,b");
 171 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 172     "creation of a bogus 'rait:{a,b' device fails");
 173
 174 ####
 175 ## first, test out the 'null' device.
 176
 177 $dev_name = "null:";
 178
 179 $dev = Amanda::Device->new($dev_name);
 180 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 181     "create null device")
 182     or diag $dev->error_or_status();
 183 ok($dev->start($ACCESS_WRITE, "NULL1", "19780615010203"),
 184     "start null device in write mode")
 185     or diag $dev->error_or_status();
 186
 187 # try properties
 188 properties_include([ $dev->property_list() ], [ @common_properties ],
 189     "necessary properties listed on null device");
 190 is($dev->property_get("canonical_name"), "null:",
 191     "property_get(canonical_name) on null device");
 192 is($dev->property_get("caNONical-name"), "null:",
 193     "property_get(caNONical-name) on null device (case, dash-insensitivity)");
 194 is_deeply([ $dev->property_get("canonical_name") ],
 195     [ "null:", $PROPERTY_SURETY_GOOD, $PROPERTY_SOURCE_DEFAULT ],
 196     "extended property_get returns correct surety/source");
 197 for my $prop ($dev->property_list()) {
 198     next unless $prop->{'name'} eq 'canonical_name';
 199     is($prop->{'description'},
 200         "The most reliable device name to use to refer to this device.",
 201         "property info for canonical name is correct");
 202 }
 203 ok(!$dev->property_get("full_deletion"),
 204     "property_get(full_deletion) on null device");
 205 is($dev->property_get("comment"), undef,
 206     "no comment by default");
 207 ok($dev->property_set("comment", "well, that was silly"),
 208     "set comment property");
 209 is($dev->property_get("comment"), "well, that was silly",
 210     "comment correctly stored");
 211
 212 # and write a file to it
 213 write_file(0xabcde, 1024*256, 1);
 214
 215 # (don't finish the device, testing the finalize method's cleanup)
 216
 217 ####
 218 ## Now some full device tests
 219
 220 ## VFS device
 221
 222 $vtape1 = mkvtape(1);
 223 $dev_name = "file:$vtape1";
 224
 225 $dev = Amanda::Device->new($dev_name);
 226 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 227     "$dev_name: create successful")
 228     or diag($dev->error_or_status());
 229
 230 properties_include([ $dev->property_list() ],
 231     [ @common_properties, 'max_volume_usage' ],
 232     "necessary properties listed on vfs device");
 233
 234 # play with properties a little bit
 235 ok($dev->property_set("comment", 16),
 236     "set an string property to an integer");
 237
 238 ok($dev->property_set("comment", 16.0),
 239     "set an string property to a float");
 240
 241 ok($dev->property_set("comment", "hi mom"),
 242     "set an string property to a string");
 243
 244 ok($dev->property_set("comment", "32768"),
 245     "set an integer property to a simple string");
 246
 247 ok($dev->property_set("comment", "32k"),
 248     "set an integer property to a string with a unit");
 249
 250 ok($dev->property_set("block_size", 32768),
 251     "set an integer property to an integer");
 252
 253 $dev->read_label();
 254 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
 255     "initially unlabeled")
 256     or diag($dev->error_or_status());
 257
 258 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 259     "start in write mode")
 260     or diag($dev->error_or_status());
 261
 262 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 263     "not unlabeled anymore")
 264     or diag($dev->error_or_status());
 265
 266 for (my $i = 1; $i <= 3; $i++) {
 267     write_file(0x2FACE, $dev->block_size()*10+17, $i);
 268 }
 269
 270 ok($dev->finish(),
 271     "finish device after write")
 272     or diag($dev->error_or_status());
 273
 274 $dev->read_label();
 275 ok(!($dev->status()),
 276     "no error, at all, from read_label")
 277     or diag($dev->error_or_status());
 278
 279 # append one more copy, to test ACCESS_APPEND
 280
 281 ok($dev->start($ACCESS_APPEND, undef, undef),
 282     "start in append mode")
 283     or diag($dev->error_or_status());
 284
 285 write_file(0xD0ED0E, $dev->block_size()*4, 4);
 286
 287 ok($dev->finish(),
 288     "finish device after append")
 289     or diag($dev->error_or_status());
 290
 291 # try reading the third file back, creating a new device
 292 # object first, and skipping the read-label step.
 293
 294 $dev = undef;
 295 $dev = Amanda::Device->new($dev_name);
 296 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 297     "$dev_name: re-create successful")
 298     or diag($dev->error_or_status());
 299
 300 ok($dev->start($ACCESS_READ, undef, undef),
 301     "start in read mode")
 302     or diag($dev->error_or_status());
 303
 304 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 305
 306 {
 307     # try two seek_file's in a row
 308     my $hdr = $dev->seek_file(3);
 309     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
 310     $hdr = $dev->seek_file(3);
 311     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
 312 }
 313
 314 ok($dev->finish(),
 315     "finish device after read")
 316     or diag($dev->error_or_status());
 317
 318 # test erase
 319 ok($dev->erase(),
 320    "erase device")
 321     or diag($dev->error_or_status());
 322
 323 ok($dev->erase(),
 324    "erase device (again)")
 325     or diag($dev->error_or_status());
 326
 327 ok($dev->finish(),
 328    "finish device after erase")
 329     or diag($dev->error_or_status());
 330
 331 # test monitor_free_space property (testing the monitoring would require a
 332 # dedicated partition for the tests - it's not worth it)
 333
 334 ok($dev->property_get("monitor_free_space"),
 335     "monitor_free_space property is set by default");
 336
 337 ok($dev->property_set("monitor_free_space", 0),
 338     "monitor_free_space property can be set to false");
 339
 340 ok(!$dev->property_get("monitor_free_space"),
 341     "monitor_free_space property value 'sticks'");
 342
 343 # test the LEOM functionality
 344
 345 $dev = undef;
 346 $dev = Amanda::Device->new($dev_name);
 347 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 348     "$dev_name: re-create successful")
 349     or diag($dev->error_or_status());
 350 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
 351     "set MAX_VOLUME_USAGE to test LEOM");
 352 ok($dev->property_set("LEOM", 1),
 353     "set LEOM");
 354
 355 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
 356     "start in write mode")
 357     or diag($dev->error_or_status());
 358
 359 ok($dev->start_file($dumpfile),
 360     "start file 1")
 361     or diag($dev->error_or_status());
 362
 363 ok(!$dev->is_eom,
 364     "device does not indicate LEOM before writing");
 365
 366 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
 367     "write random data into the early-warning zone");
 368
 369 ok($dev->is_eom,
 370     "device indicates LEOM after writing");
 371
 372 ok($dev->finish_file(),
 373     "..but a finish_file is allowed to complete")
 374     or diag($dev->error_or_status());
 375
 376 ok($dev->finish(),
 377    "finish device after LEOM test")
 378     or diag($dev->error_or_status());
 379
 380 $dev = undef;
 381 $dev = Amanda::Device->new($dev_name);
 382 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 383     "$dev_name: re-create successful")
 384     or diag($dev->error_or_status());
 385 ok($dev->property_set("MAX_VOLUME_USAGE", "160k"),
 386     "set MAX_VOLUME_USAGE to test LEOM while writing the first header");
 387 ok($dev->property_set("LEOM", 1),
 388     "set LEOM");
 389
 390 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
 391     "start in write mode")
 392     or diag($dev->error_or_status());
 393
 394 ok($dev->start_file($dumpfile),
 395     "start file 1")
 396     or diag($dev->error_or_status());
 397
 398 ok($dev->is_eom,
 399     "device indicates LEOM after writing first header");
 400
 401 ok($dev->finish_file(),
 402     "..but a finish_file is allowed to complete")
 403     or diag($dev->error_or_status());
 404
 405 ok($dev->finish(),
 406    "finish device after LEOM test")
 407     or diag($dev->error_or_status());
 408
 409 ####
 410 ## Test a RAIT device of two vfs devices.
 411
 412 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 413 $dev_name = "rait:file:{$vtape1,$vtape2}";
 414
 415 $dev = Amanda::Device->new($dev_name);
 416 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 417    "$dev_name: create successful")
 418     or diag($dev->error_or_status());
 419
 420 ok($dev->configure(1), "configure device");
 421
 422 properties_include([ $dev->property_list() ], [ @common_properties ],
 423     "necessary properties listed on rait device");
 424
 425 is($dev->property_get("block_size"), 32768, # (RAIT default)
 426     "rait device calculates a default block size correctly");
 427
 428 ok($dev->property_set("block_size", 32768*16),
 429     "rait device accepts an explicit block size");
 430
 431 is($dev->property_get("block_size"), 32768*16,
 432     "..and remembers it");
 433
 434 ok($dev->property_set("max_volume_usage", 32768*1000),
 435     "rait device accepts property MAX_VOLUME_USAGE");
 436
 437 is($dev->property_get("max_volume_usage"), 32768*1000,
 438     "..and remembers it");
 439
 440 $dev->read_label();
 441 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
 442    "initially unlabeled")
 443     or diag($dev->error_or_status());
 444
 445 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 446    "start in write mode")
 447     or diag($dev->error_or_status());
 448
 449 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 450    "not unlabeled anymore")
 451     or diag($dev->error_or_status());
 452
 453 for (my $i = 1; $i <= 3; $i++) {
 454     write_file(0x2FACE, $dev->block_size()*10+17, $i);
 455 }
 456
 457 ok($dev->finish(),
 458    "finish device after write")
 459     or diag($dev->error_or_status());
 460
 461 $dev->read_label();
 462 ok(!($dev->status()),
 463    "no error, at all, from read_label")
 464     or diag($dev->error_or_status());
 465
 466 # append one more copy, to test ACCESS_APPEND
 467
 468 ok($dev->start($ACCESS_APPEND, undef, undef),
 469    "start in append mode")
 470     or diag($dev->error_or_status());
 471
 472 write_file(0xD0ED0E, $dev->block_size()*4, 4);
 473
 474 ok($dev->finish(),
 475    "finish device after append")
 476     or diag($dev->error_or_status());
 477
 478 # try reading the third file back, creating a new device
 479 # object first, and skipping the read-label step.
 480
 481 $dev = undef;
 482 $dev = Amanda::Device->new($dev_name);
 483 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 484     "$dev_name: re-create successful")
 485     or diag($dev->error_or_status());
 486
 487 ok($dev->start($ACCESS_READ, undef, undef),
 488    "start in read mode")
 489     or diag($dev->error_or_status());
 490
 491 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 492
 493 ok($dev->finish(),
 494    "finish device after read")
 495     or diag($dev->error_or_status());
 496
 497 ok($dev->start($ACCESS_READ, undef, undef),
 498    "start in read mode after missing volume")
 499     or diag($dev->error_or_status());
 500
 501 # corrupt the device somehow and hope it keeps working
 502 rmtree("$taperoot/1");
 503
 504 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 505 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
 506 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
 507
 508 ok($dev->finish(),
 509    "finish device read after missing volume")
 510     or diag($dev->error_or_status());
 511
 512 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 513    "start in write mode fails with missing volume")
 514     or diag($dev->error_or_status());
 515
 516 undef $dev;
 517
 518 $dev_name = "rait:{file:$vtape2,MISSING}";
 519 $dev = Amanda::Device->new($dev_name);
 520
 521 ok($dev->start($ACCESS_READ, undef, undef),
 522    "start in read mode with MISSING")
 523     or diag($dev->error_or_status());
 524
 525 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 526 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
 527 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
 528
 529 ok($dev->finish(),
 530    "finish device read with MISSING")
 531     or diag($dev->error_or_status());
 532
 533 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 534    "start in write mode fails with MISSING")
 535     or diag($dev->error_or_status());
 536
 537 undef $dev;
 538
 539 $dev = Amanda::Device->new_rait_from_children(
 540     Amanda::Device->new("file:$vtape2"), undef);
 541
 542 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 543    "start a RAIT device in write mode fails, when created with 'undef'")
 544     or diag($dev->error_or_status());
 545
 546 # Make two devices with different labels, should get a
 547 # message accordingly.
 548 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 549
 550 my $n = 13;
 551 for $dev_name ("file:$vtape1", "file:$vtape2") {
 552     my $dev = Amanda::Device->new($dev_name);
 553     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 554        "$dev_name: Open successful")
 555         or diag($dev->error_or_status());
 556     ok($dev->start($ACCESS_WRITE, "TESTCONF$n", undef),
 557         "wrote label 'TESTCONF$n'");
 558     ok($dev->finish(), "finished device");
 559     $n++;
 560 }
 561
 562 $dev = Amanda::Device->new_rait_from_children(
 563     Amanda::Device->new("file:$vtape1"),
 564     Amanda::Device->new("file:$vtape2"));
 565 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 566    "new_rait_from_children: Open successful")
 567     or diag($dev->error_or_status());
 568
 569 $dev->read_label();
 570 ok($dev->status() & $DEVICE_STATUS_VOLUME_ERROR,
 571    "Label mismatch error handled correctly")
 572     or diag($dev->error_or_status());
 573
 574 # Use some config to set a block size on a child device
 575 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 576 $dev_name = "rait:{file:$vtape1,mytape2}";
 577
 578 $testconf = Installcheck::Config->new();
 579 $testconf->add_device("mytape2", [
 580     "tapedev" => "\"file:$vtape2\"",
 581     "device_property" => "\"BLOCK_SIZE\" \"64k\""
 582 ]);
 583 $testconf->write();
 584 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 585     or die("Could not load configuration");
 586
 587 $dev = Amanda::Device->new($dev_name);
 588 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 589    "$dev_name: create successful")
 590     or diag($dev->error_or_status());
 591
 592 ok($dev->configure(1), "configure device");
 593
 594 is($dev->property_get("block_size"), 65536,
 595     "rait device calculates a block size from its children correctly");
 596
 597 # Test an S3 device if the proper environment variables are set
 598 my $S3_SECRET_KEY = $ENV{'INSTALLCHECK_S3_SECRET_KEY'};
 599 my $S3_ACCESS_KEY = $ENV{'INSTALLCHECK_S3_ACCESS_KEY'};
 600 my $DEVPAY_SECRET_KEY = $ENV{'INSTALLCHECK_DEVPAY_SECRET_KEY'};
 601 my $DEVPAY_ACCESS_KEY = $ENV{'INSTALLCHECK_DEVPAY_ACCESS_KEY'};
 602 my $DEVPAY_USER_TOKEN = $ENV{'INSTALLCHECK_DEVPAY_USER_TOKEN'};
 603
 604 my $run_s3_tests = defined $S3_SECRET_KEY && defined $S3_ACCESS_KEY;
 605 my $run_devpay_tests = defined $DEVPAY_SECRET_KEY &&
 606     defined $DEVPAY_ACCESS_KEY && $DEVPAY_USER_TOKEN;
 607
 608 my $s3_make_device_count = 7;
 609 sub s3_make_device($$) {
 610     my ($dev_name, $kind) = @_;
 611     $dev = Amanda::Device->new($dev_name);
 612     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 613        "$dev_name: create successful")
 614         or diag($dev->error_or_status());
 615
 616     my @s3_props = ( 's3_access_key', 's3_secret_key' );
 617     push @s3_props, 's3_user_token' if ($kind eq "devpay");
 618     properties_include([ $dev->property_list() ], [ @common_properties, @s3_props ],
 619         "necessary properties listed on s3 device");
 620
 621     ok($dev->property_set('BLOCK_SIZE', 32768*2),
 622         "set block size")
 623         or diag($dev->error_or_status());
 624
 625     # might as well save a few cents while testing this property..
 626     ok($dev->property_set('S3_STORAGE_CLASS', 'REDUCED_REDUNDANCY'),
 627         "set storage class")
 628         or diag($dev->error_or_status());
 629
 630     if ($kind eq "s3") {
 631         # use regular S3 credentials
 632         ok($dev->property_set('S3_ACCESS_KEY', $S3_ACCESS_KEY),
 633            "set S3 access key")
 634         or diag($dev->error_or_status());
 635
 636         ok($dev->property_set('S3_SECRET_KEY', $S3_SECRET_KEY),
 637            "set S3 secret key")
 638             or diag($dev->error_or_status());
 639
 640         pass("(placeholder)");
 641     } elsif ($kind eq "devpay") {
 642         # use devpay credentials
 643         ok($dev->property_set('S3_ACCESS_KEY', $DEVPAY_ACCESS_KEY),
 644            "set devpay access key")
 645         or diag($dev->error_or_status());
 646
 647         ok($dev->property_set('S3_SECRET_KEY', $DEVPAY_SECRET_KEY),
 648            "set devpay secret key")
 649             or diag($dev->error_or_status());
 650
 651         ok($dev->property_set('S3_USER_TOKEN', $DEVPAY_USER_TOKEN),
 652            "set devpay user token")
 653             or diag($dev->error_or_status());
 654     } else {
 655         croak("didn't recognize the device kind, so no credentials were set");
 656     }
 657     return $dev;
 658 }
 659
 660 my $base_name;
 661
 662 SKIP: {
 663     skip "define \$INSTALLCHECK_S3_{SECRET,ACCESS}_KEY to run S3 tests",
 664             71 +
 665             1 * $verify_file_count +
 666             4 * $write_file_count +
 667             10 * $s3_make_device_count
 668         unless $run_s3_tests;
 669
 670     $dev_name = "s3:";
 671     $dev = Amanda::Device->new($dev_name);
 672     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 673          "creating $dev_name fails miserably");
 674
 675     $dev_name = "s3:foo";
 676     $dev = Amanda::Device->new($dev_name);
 677
 678     ok($dev->property_get("full_deletion"),
 679        "property_get(full_deletion) on s3 device");
 680
 681     ok($dev->property_get("leom"),
 682        "property_get(leom) on s3 device");
 683
 684     # test parsing of boolean values
 685     # (s3 is the only device driver that has a writable boolean property at the
 686     # moment)
 687
 688     my @verbose_vals = (
 689         {'val' => '1', 'true' => 1},
 690         {'val' => '0', 'true' => 0},
 691         {'val' => 't', 'true' => 1},
 692         {'val' => 'true', 'true' => 1},
 693         {'val' => 'f', 'true' => 0},
 694         {'val' => 'false', 'true' => 0},
 695         {'val' => 'y', 'true' => 1},
 696         {'val' => 'yes', 'true' => 1},
 697         {'val' => 'n', 'true' => 0},
 698         {'val' => 'no', 'true' => 0},
 699         {'val' => 'on', 'true' => 1},
 700         {'val' => 'off', 'true' => 0},
 701         {'val' => 'oFf', 'true' => 0},
 702         );
 703
 704     foreach my $v (@verbose_vals) {
 705         $dev_name = "s3:foo";
 706         $dev = Amanda::Device->new($dev_name);
 707
 708         $testconf = Installcheck::Config->new();
 709         $testconf->add_param("device_property", "\"verbose\" \"$v->{'val'}\"");
 710         $testconf->write();
 711         config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 712             or die("Could not load configuration");
 713
 714         ok($dev->configure(1),
 715            "configured device with verbose set to $v->{'val'}")
 716             or diag($dev->error_or_status());
 717
 718         my $get_val = $dev->property_get('verbose');
 719         # see if truth-iness matches
 720         my $expec = $v->{'true'}? "true" : "false";
 721         is(!!$dev->property_get('verbose'), !!$v->{'true'},
 722            "device_property 'VERBOSE' '$v->{'val'}' => property_get(verbose) returning $expec");
 723     }
 724
 725     # test unparsable property
 726     $dev_name = "s3:foo";
 727     $dev = Amanda::Device->new($dev_name);
 728
 729     $testconf = Installcheck::Config->new();
 730     $testconf->add_param("device_property", "\"verbose\" \"foo\"");
 731     $testconf->write();
 732     config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 733         or die("Could not load configuration");
 734
 735     ok(!$dev->configure(1),
 736        "failed to configure device with verbose set to foo");
 737
 738     like($dev->error_or_status(), qr/'verbose'/,
 739          "error message mentions property name");
 740
 741     like($dev->error_or_status(), qr/'foo'/,
 742          "error message mentions property value");
 743
 744     like($dev->error_or_status(), qr/gboolean/,
 745          "error message mentions property type");
 746
 747     my $hostname  = hostname();
 748     $hostname =~ s/\./-/g;
 749     $base_name = "$S3_ACCESS_KEY-installcheck-$hostname";
 750     $dev_name = "s3:$base_name-s3";
 751     $dev = s3_make_device($dev_name, "s3");
 752     $dev->read_label();
 753     my $status = $dev->status();
 754     # this test appears very liberal, but catches the case where setup_handle fails without
 755     # giving false positives
 756     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 757        "status is either OK or possibly unlabeled")
 758         or diag($dev->error_or_status());
 759
 760     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 761        "start in write mode")
 762         or diag($dev->error_or_status());
 763
 764     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 765        "it's labeled now")
 766         or diag($dev->error_or_status());
 767
 768     for (my $i = 1; $i <= 3; $i++) {
 769         write_file(0x2FACE, $dev->block_size()*10, $i);
 770     }
 771
 772     ok($dev->finish(),
 773        "finish device after write")
 774         or diag($dev->error_or_status());
 775
 776     $dev->read_label();
 777     ok(!($dev->status()),
 778        "no error, at all, from read_label")
 779         or diag($dev->error_or_status());
 780
 781     # append one more copy, to test ACCESS_APPEND
 782
 783     ok($dev->start($ACCESS_APPEND, undef, undef),
 784        "start in append mode")
 785         or diag($dev->error_or_status());
 786
 787     write_file(0xD0ED0E, $dev->block_size()*10, 4);
 788
 789     ok($dev->finish(),
 790        "finish device after append")
 791         or diag($dev->error_or_status());
 792
 793     # try reading the third file back
 794
 795     ok($dev->start($ACCESS_READ, undef, undef),
 796        "start in read mode")
 797         or diag($dev->error_or_status());
 798
 799     verify_file(0x2FACE, $dev->block_size()*10, 3);
 800
 801     # test EOT indications on reading
 802     my $hdr = $dev->seek_file(4);
 803     is($hdr->{'type'}, $Amanda::Header::F_DUMPFILE,
 804         "file 4 has correct type F_DUMPFILE");
 805
 806     $hdr = $dev->seek_file(5);
 807     is($hdr->{'type'}, $Amanda::Header::F_TAPEEND,
 808         "file 5 has correct type F_TAPEEND");
 809
 810     $hdr = $dev->seek_file(6);
 811     is($hdr, undef, "seek_file returns undef for file 6");
 812
 813     ok($dev->finish(),
 814        "finish device after read")
 815         or diag($dev->error_or_status());    # (note: we don't use write_max_size here,
 816                                              # as the maximum for S3 is very large)
 817
 818     ok($dev->erase(),
 819        "erase device")
 820        or diag($dev->error_or_status());
 821
 822     ok($dev->erase(),
 823        "erase device (again)")
 824        or diag($dev->error_or_status());
 825
 826     ok($dev->finish(),
 827        "finish device after erase")
 828         or diag($dev->error_or_status());
 829
 830     $dev->read_label();
 831     $status = $dev->status();
 832     ok($status & $DEVICE_STATUS_VOLUME_UNLABELED,
 833        "status is unlabeled after an erase")
 834         or diag($dev->error_or_status());
 835
 836     $dev = s3_make_device($dev_name, "s3");
 837
 838     ok($dev->erase(),
 839        "erase device right after creation")
 840        or diag($dev->error_or_status());
 841
 842     # try with empty user token
 843     $dev_name = lc("s3:$base_name-s3");
 844     $dev = s3_make_device($dev_name, "s3");
 845     ok($dev->property_set('S3_USER_TOKEN', ''),
 846        "set devpay user token")
 847         or diag($dev->error_or_status());
 848
 849     $dev->read_label();
 850     $status = $dev->status();
 851     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 852        "status is either OK or possibly unlabeled")
 853         or diag($dev->error_or_status());
 854
 855     $dev->finish();
 856
 857     ok($dev->erase(),
 858        "erase device")
 859        or diag($dev->error_or_status());
 860
 861     # try a eu-constrained bucket
 862     $dev_name = lc("s3:$base_name-s3-eu");
 863     $dev = s3_make_device($dev_name, "s3");
 864     ok($dev->property_set('S3_BUCKET_LOCATION', 'EU'),
 865        "set S3 bucket location to 'EU'")
 866         or diag($dev->error_or_status());
 867
 868     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 869        "start in write mode")
 870         or diag($dev->error_or_status());
 871
 872     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 873        "status is OK")
 874         or diag($dev->error_or_status());
 875
 876     $dev->finish();
 877
 878     ok($dev->erase(),
 879        "erase device")
 880        or diag($dev->error_or_status());
 881
 882     # try a wildcard-constrained bucket
 883     $dev_name = lc("s3:$base_name-s3-wild");
 884     $dev = s3_make_device($dev_name, "s3");
 885     ok($dev->property_set('S3_BUCKET_LOCATION', '*'),
 886        "set S3 bucket location to ''")
 887         or diag($dev->error_or_status());
 888
 889     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 890        "start in write mode")
 891         or diag($dev->error_or_status());
 892
 893     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 894        "status is OK")
 895         or diag($dev->error_or_status());
 896
 897     $dev->finish();
 898
 899     # test again with invalid ca_info
 900     $dev = s3_make_device($dev_name, "s3");
 901     SKIP: {
 902         skip "SSL not supported; can't check SSL_CA_INFO", 2
 903             unless $dev->property_get('S3_SSL');
 904
 905         ok($dev->property_set('SSL_CA_INFO', '/dev/null'),
 906            "set invalid SSL/TLS CA certificate")
 907             or diag($dev->error_or_status());
 908
 909         ok(!$dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 910            "start in write mode")
 911             or diag($dev->error_or_status());
 912
 913         isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 914            "status is OK")
 915             or diag($dev->error_or_status());
 916
 917         $dev->finish();
 918     }
 919
 920     # test again with our own CA bundle
 921     $dev = s3_make_device($dev_name, "s3");
 922     SKIP: {
 923         skip "SSL not supported; can't check SSL_CA_INFO", 4
 924             unless $dev->property_get('S3_SSL');
 925         ok($dev->property_set('SSL_CA_INFO', "$srcdir/data/aws-bundle.crt"),
 926            "set our own SSL/TLS CA certificate bundle")
 927             or diag($dev->error_or_status());
 928
 929         ok($dev->erase(),
 930            "erase device")
 931             or diag($dev->error_or_status());
 932
 933         ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 934            "start in write mode")
 935             or diag($dev->error_or_status());
 936
 937         is($dev->status(), $DEVICE_STATUS_SUCCESS,
 938            "status is OK")
 939             or diag($dev->error_or_status());
 940
 941         $dev->finish();
 942     }
 943
 944     ok($dev->erase(),
 945        "erase device")
 946        or diag($dev->error_or_status());
 947
 948     # bucket names incompatible with location constraint
 949     $dev_name = "s3:-$base_name-s3-eu";
 950     $dev = s3_make_device($dev_name, "s3");
 951
 952     ok($dev->property_set('S3_BUCKET_LOCATION', ''),
 953        "should be able to set an empty S3 bucket location with an incompatible name")
 954         or diag($dev->error_or_status());
 955
 956     $dev_name = "s3:$base_name-s3.eu";
 957     $dev = s3_make_device($dev_name, "s3");
 958
 959     ok($dev->property_set('S3_BUCKET_LOCATION', ''),
 960        "should be able to set an empty S3 bucket location with an incompatible name")
 961         or diag($dev->error_or_status());
 962
 963     $dev_name = "s3:-$base_name-s3-eu";
 964     $dev = s3_make_device($dev_name, "s3");
 965
 966     ok(!$dev->property_set('S3_BUCKET_LOCATION', 'EU'),
 967        "should not be able to set S3 bucket location with an incompatible name")
 968         or diag($dev->error_or_status());
 969 }
 970
 971 SKIP: {
 972     # in this case, most of our code has already been exercised
 973     # just make sure that authentication works as a basic sanity check
 974     skip "skipping abbreviated devpay tests", $s3_make_device_count + 1
 975         unless $run_devpay_tests;
 976     $dev_name = "s3:$base_name-devpay";
 977     $dev = s3_make_device($dev_name, "devpay");
 978     $dev->read_label();
 979     my $status = $dev->status();
 980     # this test appears very liberal, but catches the case where setup_handle fails without
 981     # giving false positives
 982     ok(($status == 0) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 983        "status is either OK or possibly unlabeled")
 984         or diag($dev->error_or_status());
 985 }
 986
 987 # Test a tape device if the proper environment variables are set
 988 my $TAPE_DEVICE = $ENV{'INSTALLCHECK_TAPE_DEVICE'};
 989 my $run_tape_tests = defined $TAPE_DEVICE;
 990 SKIP: {
 991     skip "define \$INSTALLCHECK_TAPE_DEVICE to run tape tests",
 992             30 +
 993             7 * $verify_file_count +
 994             5 * $write_file_count
 995         unless $run_tape_tests;
 996
 997     $dev_name = "tape:$TAPE_DEVICE";
 998     $dev = Amanda::Device->new($dev_name);
 999     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1000         "$dev_name: create successful")
1001         or diag($dev->error_or_status());
1002
1003     my $status = $dev->read_label();
1004     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1005        "status is either OK or possibly unlabeled")
1006         or diag($dev->error_or_status());
1007
1008     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1009         "start in write mode")
1010         or diag($dev->error_or_status());
1011
1012     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
1013         "not unlabeled anymore")
1014         or diag($dev->error_or_status());
1015
1016     for (my $i = 1; $i <= 4; $i++) {
1017         write_file(0x2FACE+$i, $dev->block_size()*10+17, $i);
1018     }
1019
1020     ok($dev->finish(),
1021         "finish device after write")
1022         or diag($dev->error_or_status());
1023
1024     $dev->read_label();
1025     ok(!($dev->status()),
1026         "no error, at all, from read_label")
1027         or diag($dev->error_or_status());
1028
1029     is($dev->volume_label(), "TESTCONF13",
1030         "read_label reads the correct label")
1031         or diag($dev->error_or_status());
1032
1033     # append one more copy, to test ACCESS_APPEND
1034
1035     # if final_filemarks is 1, then the tape device will use F_NOOP,
1036     # inserting an extra file, and we'll be appending at file number 6.
1037     my $append_fileno = ($dev->property_get("FINAL_FILEMARKS") == 2)? 5:6;
1038
1039     SKIP: {
1040         skip "APPEND not supported", $write_file_count + 2
1041             unless $dev->property_get("APPENDABLE");
1042
1043         ok($dev->start($ACCESS_APPEND, undef, undef),
1044             "start in append mode")
1045             or diag($dev->error_or_status());
1046
1047         write_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1048
1049         ok($dev->finish(),
1050             "finish device after append")
1051             or diag($dev->error_or_status());
1052     }
1053
1054     # try reading the second and third files back, creating a new
1055     # device object first, and skipping the read-label step.
1056
1057     $dev = undef;
1058     $dev = Amanda::Device->new($dev_name);
1059     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1060         "$dev_name: re-create successful")
1061         or diag($dev->error_or_status());
1062
1063     # use a big read_block_size, checking that it's also settable
1064     # via read_buffer_size
1065     ok($dev->property_set("read_buffer_size", 256*1024),
1066         "can set read_buffer_size");
1067     is($dev->property_get("read_block_size"), 256*1024,
1068         "and its value is reflected in read_block_size");
1069     ok($dev->property_set("read_block_size", 32*1024),
1070         "can set read_block_size");
1071
1072     ok($dev->start($ACCESS_READ, undef, undef),
1073         "start in read mode")
1074         or diag($dev->error_or_status());
1075
1076     # now verify those files in a particular order to trigger all of the
1077     # seeking edge cases
1078
1079     verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
1080     verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1081     verify_file(0x2FACE+4, $dev->block_size()*10+17, 4);
1082     verify_file(0x2FACE+3, $dev->block_size()*10+17, 3);
1083     verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
1084
1085     # try re-seeking to the same file
1086     ok(header_for($dev->seek_file(2), 2), "seek to file 2 the first time");
1087     verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1088     ok(header_for($dev->seek_file(2), 2), "seek to file 2 the third time");
1089
1090     # and seek through the same pattern *without* reading to EOF
1091     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1092     ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1093     ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1094     ok(header_for($dev->seek_file(3), 3), "seek to file 3");
1095     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1096
1097     SKIP: {
1098         skip "APPEND not supported", $verify_file_count
1099             unless $dev->property_get("APPENDABLE");
1100         verify_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1101     }
1102
1103     ok($dev->finish(),
1104         "finish device after read")
1105         or diag($dev->error_or_status());
1106
1107     # tickle a regression in improperly closing fd's
1108     ok($dev->finish(),
1109         "finish device again after read")
1110         or diag($dev->error_or_status());
1111
1112     ok($dev->read_label() == $DEVICE_STATUS_SUCCESS,
1113         "read_label after second finish (used to fail)")
1114         or diag($dev->error_or_status());
1115
1116     # finally, run the device with FSF and BSF set to "no", to test the
1117     # fallback schemes for this condition
1118
1119     $dev = undef;
1120     $dev = Amanda::Device->new($dev_name);
1121     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1122         "$dev_name: re-create successful")
1123         or diag($dev->error_or_status());
1124     $dev->property_set("fsf", "no");
1125     $dev->property_set("bsf", "no");
1126
1127     ok($dev->start($ACCESS_READ, undef, undef),
1128         "start in read mode")
1129         or diag($dev->error_or_status());
1130
1131     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1132     ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1133     ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1134
1135     ok($dev->finish(),
1136         "finish device after read")
1137         or diag($dev->error_or_status());
1138 }
1139
1140 SKIP: {
1141     skip "not built with ndmp and server", 78 unless
1142         Amanda::Util::built_with_component("ndmp") and
1143         Amanda::Util::built_with_component("server");
1144
1145     my $dev;
1146     my $testconf = Installcheck::Config->new();
1147     $testconf->write();
1148
1149     my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
1150     if ($cfg_result != $CFGERR_OK) {
1151         my ($level, @errors) = Amanda::Config::config_errors();
1152         die(join "\n", @errors);
1153     }
1154
1155     my $ndmp = Installcheck::Mock::NdmpServer->new();
1156     my $ndmp_port = $ndmp->{'port'};
1157     my $drive = $ndmp->{'drive'};
1158     pass("started ndmjob in daemon mode");
1159
1160     # set up a header for use below
1161     my $hdr = Amanda::Header->new();
1162     $hdr->{type} = $Amanda::Header::F_DUMPFILE;
1163     $hdr->{datestamp} = "20070102030405";
1164     $hdr->{dumplevel} = 0;
1165     $hdr->{compressed} = 1;
1166     $hdr->{name} = "localhost";
1167     $hdr->{disk} = "/home";
1168     $hdr->{program} = "INSTALLCHECK";
1169
1170     $dev = Amanda::Device->new("ndmp:127.0.0.1:9i1\@foo");
1171     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1172         "creation of an ndmp device fails with invalid port");
1173
1174     $dev = Amanda::Device->new("ndmp:127.0.0.1:90000\@foo");
1175     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1176         "creation of an ndmp device fails with too-large port");
1177
1178     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port");
1179     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1180         "creation of an ndmp device fails without ..\@device_name");
1181
1182     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1183     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1184         "creation of an ndmp device succeeds with correct syntax");
1185
1186     ok($dev->property_set("ndmp_username", "foo"),
1187         "set ndmp_username property");
1188     is($dev->property_get("ndmp_username"), "foo",
1189         "..and get the value back");
1190     ok($dev->property_set("ndmp_password", "bar"),
1191         "set ndmp_password property");
1192     is($dev->property_get("ndmp_password"), "bar",
1193         "..and get the value back");
1194
1195     ok($dev->property_set("verbose", 1),
1196         "set VERBOSE");
1197
1198     # set 'em back to the defaults
1199     $dev->property_set("ndmp_username", "ndmp");
1200     $dev->property_set("ndmp_password", "ndmp");
1201
1202     # use a big read_block_size, checking that it's also settable
1203     # via read_buffer_size
1204     ok($dev->property_set("read_block_size", 256*1024),
1205     "can set read_block_size");
1206     is($dev->property_get("read_block_size"), 256*1024,
1207     "and its value is reflected");
1208     ok($dev->property_set("read_block_size", 64*1024),
1209     "set read_block_size back to something smaller");
1210
1211     # ok, let's fire the thing up
1212     ok($dev->start($ACCESS_WRITE, "TEST1", "20090915000000"),
1213         "start device in write mode")
1214         or diag $dev->error_or_status();
1215
1216     ok($dev->start_file($hdr),
1217         "start_file");
1218
1219     {   # write to the file
1220         my $xfer = Amanda::Xfer->new([
1221                 Amanda::Xfer::Source::Random->new(32768*21, 0xBEEFEE00),
1222                 Amanda::Xfer::Dest::Device->new($dev, 0) ]);
1223         $xfer->start(make_cb(xmsg_cb => sub {
1224             my ($src, $msg, $xfer) = @_;
1225             if ($msg->{'type'} == $XMSG_ERROR) {
1226                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1227             } elsif ($msg->{'type'} == $XMSG_DONE) {
1228                 Amanda::MainLoop::quit();
1229             }
1230         }));
1231
1232         Amanda::MainLoop::run();
1233         pass("wrote 21 blocks");
1234     }
1235
1236     ok($dev->finish(),
1237         "finish device")
1238         or diag $dev->error_or_status();
1239
1240     is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1241         "read label from (same) device")
1242         or diag $dev->error_or_status();
1243
1244     is($dev->volume_label, "TEST1",
1245         "volume label read back correctly");
1246
1247     ## label a device and check the label, but open a new device in between
1248
1249     # Write a label
1250     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1251     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1252         "creation of an ndmp device succeeds with correct syntax");
1253     $dev->property_set("ndmp_username", "ndmp");
1254     $dev->property_set("ndmp_password", "ndmp");
1255     $dev->property_set("verbose", 1);
1256
1257     # Write the label
1258     ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1259         "start device in write mode")
1260         or diag $dev->error_or_status();
1261     ok($dev->finish(),
1262         "finish device")
1263         or diag $dev->error_or_status();
1264
1265     # Read the label with a new device.
1266     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1267     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1268         "creation of an ndmp device succeeds with correct syntax");
1269     $dev->property_set("ndmp_username", "ndmp");
1270     $dev->property_set("ndmp_password", "ndmp");
1271     $dev->property_set("verbose", 1);
1272
1273     # read the label
1274     is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1275         "read label from device")
1276         or diag $dev->error_or_status();
1277     is($dev->volume_label, "TEST2",
1278         "volume label read back correctly");
1279     ok($dev->finish(),
1280         "finish device")
1281         or diag $dev->error_or_status();
1282
1283     #
1284     # test the directtcp-target implementation
1285     #
1286
1287     ok($dev->directtcp_supported(), "is a directtcp target");
1288     for my $dev_use ('initiator', 'listener') {
1289         my ($xfer, $addrs, $dest_elt);
1290         if ($dev_use eq 'listener') {
1291             $addrs = $dev->listen(1);
1292             ok($addrs, "listen returns successfully") or die($dev->error_or_status());
1293
1294             # set up an xfer to write to the device
1295             $dest_elt = Amanda::Xfer::Dest::DirectTCPConnect->new($addrs);
1296         } else {
1297             # set up an xfer to write to the device
1298             $dest_elt = Amanda::Xfer::Dest::DirectTCPListen->new();
1299         }
1300         $xfer = Amanda::Xfer->new([
1301                 Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
1302                 $dest_elt,
1303             ]);
1304
1305         my @messages;
1306         $xfer->start(make_cb(xmsg_cb => sub {
1307             my ($src, $msg, $xfer) = @_;
1308             if ($msg->{'type'} == $XMSG_ERROR) {
1309                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1310             } elsif ($msg->{'type'} == $XMSG_DONE) {
1311                 Amanda::MainLoop::quit();
1312             }
1313         }));
1314
1315         # write files from the connection until EOF
1316         my $num_files;
1317         my $conn;
1318         my ($finish_connection, $start_device, $write_file_cb);
1319
1320
1321         $finish_connection = make_cb(finish_connection => sub {
1322             if ($dev_use eq 'listener') {
1323                 $conn = $dev->accept();
1324             } else {
1325                 $addrs = $dest_elt->get_addrs();
1326                 $conn = $dev->connect(1, $addrs);
1327             }
1328             Amanda::MainLoop::call_later($start_device);
1329         });
1330
1331
1332         $start_device = make_cb(start_device => sub {
1333             ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1334                 "start device in write mode")
1335                 or diag $dev->error_or_status();
1336
1337             Amanda::MainLoop::call_later($write_file_cb);
1338         });
1339
1340         $write_file_cb = make_cb(write_file_cb => sub {
1341             ++$num_files < 20 or die "I seem to be in a loop!";
1342
1343             ok($dev->start_file($hdr), "start file $num_files for writing");
1344             is($dev->file, $num_files, "..file number is correct");
1345
1346             my ($ok, $size) = $dev->write_from_connection(32768*15);
1347             push @messages, sprintf("WRITE-%s-%d-%s-%s",
1348                 $ok?"OK":"ERR", $size,
1349                 $dev->is_eof()? "EOF":"!eof",
1350                 $dev->is_eom()? "EOM":"!eom");
1351             ok($ok, "..write from connection succeeds");
1352             my $eof = $dev->is_eof();
1353
1354             ok($dev->finish_file(), "..finish file after writing");
1355
1356             if (!$eof) {
1357                 Amanda::MainLoop::call_later($write_file_cb);
1358             }
1359         });
1360
1361         Amanda::MainLoop::call_later($finish_connection);
1362         Amanda::MainLoop::run();
1363         is_deeply([@messages], [
1364                 'WRITE-OK-491520-!eof-!eom',
1365                 'WRITE-OK-491520-!eof-!eom',
1366                 'WRITE-OK-131072-EOF-!eom',
1367             ],
1368             "a sequence of write_from_connection calls works correctly");
1369
1370         $dev->finish();
1371
1372         if (my $err = $conn->close()) {
1373             die $err;
1374         }
1375     }
1376
1377     # now try reading that back piece by piece
1378
1379     {
1380         my $filename = "$Installcheck::TMP/Amanda_Device_ndmp.tmp";
1381         open(my $dest_fh, ">", $filename);
1382
1383         ok($dev->start($ACCESS_READ, undef, undef),
1384             "start device in read mode")
1385             or diag $dev->error_or_status();
1386
1387         my $file;
1388         for ($file = 1; $file <= 3; $file++) {
1389             ok($dev->seek_file($file),
1390                 "seek_file $file");
1391             is($dev->file, $file, "..file num is correct");
1392             is($dev->block, 0, "..block num is correct");
1393
1394             # read the file, writing to our temp file.  We'll check that the byte
1395             # sequence is correct later
1396             my $xfer = Amanda::Xfer->new([
1397                     Amanda::Xfer::Source::Device->new($dev),
1398                     Amanda::Xfer::Dest::Fd->new($dest_fh) ]);
1399
1400             $xfer->start(make_cb(xmsg_cb => sub {
1401                 my ($src, $msg, $xfer) = @_;
1402                 if ($msg->{'type'} == $XMSG_ERROR) {
1403                     die $msg->{'elt'} . " failed: " . $msg->{'message'};
1404                 } elsif ($msg->{'type'} == $XMSG_DONE) {
1405                     Amanda::MainLoop::quit();
1406                 }
1407             }));
1408             Amanda::MainLoop::run();
1409
1410             pass("read back file " . $file);
1411         }
1412
1413         $dev->finish();
1414         close $dest_fh;
1415
1416         # now read back and verify that file
1417         open(my $src_fh, "<", $filename);
1418         my $xfer = Amanda::Xfer->new([
1419                 Amanda::Xfer::Source::Fd->new($src_fh),
1420                 Amanda::Xfer::Dest::Null->new(0xB00) ]);
1421
1422         $xfer->start(make_cb(xmsg_cb => sub {
1423             my ($src, $msg, $xfer) = @_;
1424             if ($msg->{'type'} == $XMSG_ERROR) {
1425                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1426             } elsif ($msg->{'type'} == $XMSG_DONE) {
1427                 Amanda::MainLoop::quit();
1428             }
1429         }));
1430         Amanda::MainLoop::run();
1431
1432         pass("data in the three parts is correct");
1433         unlink $filename;
1434     }
1435
1436     ####
1437     # Test read_to_connection
1438     #
1439     # This requires something that can connect to a device and read from
1440     # it; the XFA does not have an XFER_MECH_DIRECTTCP_CONNECT, so we fake
1441     # it by manually connecting and then setting up an xfer with a regular
1442     # XferSourceFd.  This works because the NDMP server will accept an
1443     # incoming connection before the Device API accept() method is called;
1444     # this trick may not work with other DirectTCP-capable devices.  Also,
1445     # this doesn't work so well if there's an error in the xfer (e.g., a
1446     # random value mismatch).  But tests are supposed to succeed!
1447
1448     sub test_read2conn {
1449         my ($finished_cb) = @_;
1450         my @events;
1451         my $file = 1;
1452         my ($conn, $sock);
1453
1454         my $steps = define_steps
1455             cb_ref => \$finished_cb;
1456
1457         step setup => sub {
1458             my $addrs = $dev->listen(0);
1459
1460             # now connect to that
1461             $sock = IO::Socket::INET->new(
1462                 Proto => "tcp",
1463                 PeerHost => $addrs->[0][0],
1464                 PeerPort => $addrs->[0][1],
1465                 Blocking => 1,
1466             );
1467
1468             # and set up a transfer to read from that socket
1469             my $xfer = Amanda::Xfer->new([
1470                     Amanda::Xfer::Source::Fd->new($sock),
1471                     Amanda::Xfer::Dest::Null->new(0xB00) ]);
1472
1473             $xfer->start(make_cb(xmsg_cb => sub {
1474                 my ($src, $msg, $xfer) = @_;
1475                 if ($msg->{'type'} == $XMSG_ERROR) {
1476                     die $msg->{'elt'} . " failed: " . $msg->{'message'};
1477                 }
1478                 if ($msg->{'type'} == $XMSG_DONE) {
1479                     push @events, "DONE";
1480                     $steps->{'quit'}->();
1481                 }
1482             }));
1483
1484             $steps->{'accept'}->();
1485         };
1486
1487         step accept => sub {
1488             $conn = $dev->accept();
1489             die $dev->error_or_status() unless ($conn);
1490
1491             Amanda::MainLoop::call_later($steps->{'start_dev'});
1492         };
1493
1494         step start_dev => sub {
1495             ok($dev->start($ACCESS_READ, undef, undef),
1496                 "start device in read mode")
1497                 or diag $dev->error_or_status();
1498
1499             Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1500         };
1501
1502         step read_part_cb => sub {
1503             my $hdr = $dev->seek_file($file);
1504             die $dev->error_or_status() unless ($hdr);
1505             my $size = $dev->read_to_connection(0);
1506             push @events, "READ-$size";
1507
1508             if (++$file <= 3) {
1509                 Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1510             } else {
1511                 # close the connection, which will end the xfer, which will
1512                 # result in a call to finished_cb.  So there.
1513                 push @events, "CLOSE";
1514                 $conn->close();
1515             }
1516         };
1517
1518         step quit => sub {
1519             close $sock or die "close: $!";
1520
1521             is_deeply([@events],
1522                 [ "READ-491520", "READ-491520", "READ-131072", "CLOSE", "DONE" ],
1523                 "sequential read_to_connection operations read the right amounts " .
1524                 "and bytestream matches");
1525
1526             $finished_cb->();
1527         };
1528     }
1529     test_read2conn(\&Amanda::MainLoop::quit);
1530     Amanda::MainLoop::run();
1531
1532     # try two seek_file's in a row
1533     $hdr = $dev->seek_file(2);
1534     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
1535     $hdr = $dev->seek_file(2);
1536     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
1537
1538     ## test seek_file's handling of EOM
1539
1540     $hdr = $dev->seek_file(3);
1541     is($hdr->{type}, $Amanda::Header::F_DUMPFILE, "file 3 is a dumpfile");
1542     $hdr = $dev->seek_file(4);
1543     is($hdr->{type}, $Amanda::Header::F_TAPEEND, "file 4 is tapeend");
1544     $hdr = $dev->seek_file(5);
1545     is($hdr, undef, "file 5 is an error");
1546     $hdr = $dev->seek_file(6);
1547     is($hdr, undef, "file 6 is an error");
1548
1549     $ndmp->cleanup();
1550 }
1551 unlink($input_filename);
1552 unlink($output_filename);
1553 rmtree($taperoot);