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 => 593;
  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 ok(!($dev->property_set("invalid-property-name", 32768)),
 254     "set an invalid-property-name");
 255
 256 $dev->read_label();
 257 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
 258     "initially unlabeled")
 259     or diag($dev->error_or_status());
 260
 261 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 262     "start in write mode")
 263     or diag($dev->error_or_status());
 264
 265 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 266     "not unlabeled anymore")
 267     or diag($dev->error_or_status());
 268
 269 for (my $i = 1; $i <= 3; $i++) {
 270     write_file(0x2FACE, $dev->block_size()*10+17, $i);
 271 }
 272
 273 ok($dev->finish(),
 274     "finish device after write")
 275     or diag($dev->error_or_status());
 276
 277 $dev->read_label();
 278 ok(!($dev->status()),
 279     "no error, at all, from read_label")
 280     or diag($dev->error_or_status());
 281
 282 # append one more copy, to test ACCESS_APPEND
 283
 284 ok($dev->start($ACCESS_APPEND, undef, undef),
 285     "start in append mode")
 286     or diag($dev->error_or_status());
 287
 288 write_file(0xD0ED0E, $dev->block_size()*4, 4);
 289
 290 ok($dev->finish(),
 291     "finish device after append")
 292     or diag($dev->error_or_status());
 293
 294 # try reading the third file back, creating a new device
 295 # object first, and skipping the read-label step.
 296
 297 $dev = undef;
 298 $dev = Amanda::Device->new($dev_name);
 299 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 300     "$dev_name: re-create successful")
 301     or diag($dev->error_or_status());
 302
 303 ok($dev->start($ACCESS_READ, undef, undef),
 304     "start in read mode")
 305     or diag($dev->error_or_status());
 306
 307 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 308
 309 {
 310     # try two seek_file's in a row
 311     my $hdr = $dev->seek_file(3);
 312     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
 313     $hdr = $dev->seek_file(3);
 314     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
 315 }
 316
 317 ok($dev->finish(),
 318     "finish device after read")
 319     or diag($dev->error_or_status());
 320
 321 # test erase
 322 ok($dev->erase(),
 323    "erase device")
 324     or diag($dev->error_or_status());
 325
 326 ok($dev->erase(),
 327    "erase device (again)")
 328     or diag($dev->error_or_status());
 329
 330 ok($dev->finish(),
 331    "finish device after erase")
 332     or diag($dev->error_or_status());
 333
 334 # test monitor_free_space property (testing the monitoring would require a
 335 # dedicated partition for the tests - it's not worth it)
 336
 337 ok($dev->property_get("monitor_free_space"),
 338     "monitor_free_space property is set by default");
 339
 340 ok($dev->property_set("monitor_free_space", 0),
 341     "monitor_free_space property can be set to false");
 342
 343 ok(!$dev->property_get("monitor_free_space"),
 344     "monitor_free_space property value 'sticks'");
 345
 346 # test the LEOM functionality
 347
 348 $dev = undef;
 349 $dev = Amanda::Device->new($dev_name);
 350 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 351     "$dev_name: re-create successful")
 352     or diag($dev->error_or_status());
 353 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
 354     "set MAX_VOLUME_USAGE to test LEOM");
 355 ok($dev->property_set("LEOM", 1),
 356     "set LEOM");
 357 ok($dev->property_set("ENFORCE_MAX_VOLUME_USAGE", 0),
 358     "set ENFORCE_MAX_VOLUME_USAGE");
 359
 360 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
 361     "start in write mode")
 362     or diag($dev->error_or_status());
 363
 364 ok($dev->start_file($dumpfile),
 365     "start file 1")
 366     or diag($dev->error_or_status());
 367
 368 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
 369     "write random data into the early-warning zone");
 370
 371 ok(!$dev->is_eom,
 372     "device does not indicates LEOM after writing when ENFORCE_MAX_VOLUME_USAGE is FALSE");
 373
 374 ok($dev->finish_file(),
 375     "..but a finish_file is allowed to complete")
 376     or diag($dev->error_or_status());
 377
 378 ok($dev->finish(),
 379    "finish device after LEOM test")
 380     or diag($dev->error_or_status());
 381
 382 $dev = undef;
 383 $dev = Amanda::Device->new($dev_name);
 384 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 385     "$dev_name: re-create successful")
 386     or diag($dev->error_or_status());
 387 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
 388     "set MAX_VOLUME_USAGE to test LEOM");
 389 ok($dev->property_set("LEOM", 1),
 390     "set LEOM");
 391 ok($dev->property_set("ENFORCE_MAX_VOLUME_USAGE", 1),
 392     "set ENFORCE_MAX_VOLUME_USAGE");
 393
 394 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
 395     "start in write mode")
 396     or diag($dev->error_or_status());
 397
 398 ok($dev->start_file($dumpfile),
 399     "start file 1")
 400     or diag($dev->error_or_status());
 401
 402 ok(!$dev->is_eom,
 403     "device does not indicate LEOM before writing");
 404
 405 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
 406     "write random data into the early-warning zone");
 407
 408 ok($dev->is_eom,
 409     "device indicates LEOM after writing");
 410
 411 ok($dev->finish_file(),
 412     "..but a finish_file is allowed to complete")
 413     or diag($dev->error_or_status());
 414
 415 ok($dev->finish(),
 416    "finish device after LEOM test")
 417     or diag($dev->error_or_status());
 418
 419 $dev = undef;
 420 $dev = Amanda::Device->new($dev_name);
 421 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 422     "$dev_name: re-create successful")
 423     or diag($dev->error_or_status());
 424 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
 425     "set MAX_VOLUME_USAGE to test LEOM");
 426 ok($dev->property_set("LEOM", 1),
 427     "set LEOM");
 428
 429 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
 430     "start in write mode")
 431     or diag($dev->error_or_status());
 432
 433 ok($dev->start_file($dumpfile),
 434     "start file 1")
 435     or diag($dev->error_or_status());
 436
 437 ok(!$dev->is_eom,
 438     "device does not indicate LEOM before writing");
 439
 440 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
 441     "write random data into the early-warning zone");
 442
 443 ok($dev->is_eom,
 444     "device indicates LEOM after writing as default value of ENFORCE_MAX_VOLUME_USAGE is true for vfs device");
 445
 446 ok($dev->finish_file(),
 447     "..but a finish_file is allowed to complete")
 448     or diag($dev->error_or_status());
 449
 450 ok($dev->finish(),
 451    "finish device after LEOM test")
 452     or diag($dev->error_or_status());
 453
 454 $dev = undef;
 455 $dev = Amanda::Device->new($dev_name);
 456 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 457     "$dev_name: re-create successful")
 458     or diag($dev->error_or_status());
 459 ok($dev->property_set("MAX_VOLUME_USAGE", "160k"),
 460     "set MAX_VOLUME_USAGE to test LEOM while writing the first header");
 461 ok($dev->property_set("LEOM", 1),
 462     "set LEOM");
 463
 464 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
 465     "start in write mode")
 466     or diag($dev->error_or_status());
 467
 468 ok($dev->start_file($dumpfile),
 469     "start file 1")
 470     or diag($dev->error_or_status());
 471
 472 ok($dev->is_eom,
 473     "device indicates LEOM after writing first header");
 474
 475 ok($dev->finish_file(),
 476     "..but a finish_file is allowed to complete")
 477     or diag($dev->error_or_status());
 478
 479 ok($dev->finish(),
 480    "finish device after LEOM test")
 481     or diag($dev->error_or_status());
 482
 483 ####
 484 ## Test a RAIT device of two vfs devices.
 485
 486 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 487 $dev_name = "rait:file:{$vtape1,$vtape2}";
 488
 489 $dev = Amanda::Device->new($dev_name);
 490 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 491    "$dev_name: create successful")
 492     or diag($dev->error_or_status());
 493
 494 ok($dev->configure(1), "configure device");
 495
 496 properties_include([ $dev->property_list() ], [ @common_properties ],
 497     "necessary properties listed on rait device");
 498
 499 is($dev->property_get("block_size"), 32768, # (RAIT default)
 500     "rait device calculates a default block size correctly");
 501
 502 ok($dev->property_set("block_size", 32768*16),
 503     "rait device accepts an explicit block size");
 504
 505 is($dev->property_get("block_size"), 32768*16,
 506     "..and remembers it");
 507
 508 ok($dev->property_set("max_volume_usage", 32768*1000),
 509     "rait device accepts property MAX_VOLUME_USAGE");
 510
 511 is($dev->property_get("max_volume_usage"), 32768*1000,
 512     "..and remembers it");
 513
 514 $dev->read_label();
 515 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
 516    "initially unlabeled")
 517     or diag($dev->error_or_status());
 518
 519 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 520    "start in write mode")
 521     or diag($dev->error_or_status());
 522
 523 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 524    "not unlabeled anymore")
 525     or diag($dev->error_or_status());
 526
 527 for (my $i = 1; $i <= 3; $i++) {
 528     write_file(0x2FACE, $dev->block_size()*10+17, $i);
 529 }
 530
 531 ok($dev->finish(),
 532    "finish device after write")
 533     or diag($dev->error_or_status());
 534
 535 $dev->read_label();
 536 ok(!($dev->status()),
 537    "no error, at all, from read_label")
 538     or diag($dev->error_or_status());
 539
 540 # append one more copy, to test ACCESS_APPEND
 541
 542 ok($dev->start($ACCESS_APPEND, undef, undef),
 543    "start in append mode")
 544     or diag($dev->error_or_status());
 545
 546 write_file(0xD0ED0E, $dev->block_size()*4, 4);
 547
 548 ok($dev->finish(),
 549    "finish device after append")
 550     or diag($dev->error_or_status());
 551
 552 # try reading the third file back, creating a new device
 553 # object first, and skipping the read-label step.
 554
 555 $dev = undef;
 556 $dev = Amanda::Device->new($dev_name);
 557 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 558     "$dev_name: re-create successful")
 559     or diag($dev->error_or_status());
 560
 561 ok($dev->start($ACCESS_READ, undef, undef),
 562    "start in read mode")
 563     or diag($dev->error_or_status());
 564
 565 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 566
 567 ok($dev->finish(),
 568    "finish device after read")
 569     or diag($dev->error_or_status());
 570
 571 ok($dev->start($ACCESS_READ, undef, undef),
 572    "start in read mode after missing volume")
 573     or diag($dev->error_or_status());
 574
 575 # corrupt the device somehow and hope it keeps working
 576 rmtree("$taperoot/1");
 577
 578 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 579 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
 580 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
 581
 582 ok($dev->finish(),
 583    "finish device read after missing volume")
 584     or diag($dev->error_or_status());
 585
 586 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 587    "start in write mode fails with missing volume")
 588     or diag($dev->error_or_status());
 589
 590 undef $dev;
 591
 592 $dev_name = "rait:{file:$vtape2,MISSING}";
 593 $dev = Amanda::Device->new($dev_name);
 594
 595 ok($dev->start($ACCESS_READ, undef, undef),
 596    "start in read mode with MISSING")
 597     or diag($dev->error_or_status());
 598
 599 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 600 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
 601 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
 602
 603 ok($dev->finish(),
 604    "finish device read with MISSING")
 605     or diag($dev->error_or_status());
 606
 607 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 608    "start in write mode fails with MISSING")
 609     or diag($dev->error_or_status());
 610
 611 undef $dev;
 612
 613 $dev = Amanda::Device->new_rait_from_children(
 614     Amanda::Device->new("file:$vtape2"), undef);
 615
 616 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 617    "start a RAIT device in write mode fails, when created with 'undef'")
 618     or diag($dev->error_or_status());
 619
 620 # Make two devices with different labels, should get a
 621 # message accordingly.
 622 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 623
 624 my $n = 13;
 625 for $dev_name ("file:$vtape1", "file:$vtape2") {
 626     my $dev = Amanda::Device->new($dev_name);
 627     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 628        "$dev_name: Open successful")
 629         or diag($dev->error_or_status());
 630     ok($dev->start($ACCESS_WRITE, "TESTCONF$n", undef),
 631         "wrote label 'TESTCONF$n'");
 632     ok($dev->finish(), "finished device");
 633     $n++;
 634 }
 635
 636 $dev = Amanda::Device->new_rait_from_children(
 637     Amanda::Device->new("file:$vtape1"),
 638     Amanda::Device->new("file:$vtape2"));
 639 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 640    "new_rait_from_children: Open successful")
 641     or diag($dev->error_or_status());
 642
 643 $dev->read_label();
 644 ok($dev->status() & $DEVICE_STATUS_VOLUME_ERROR,
 645    "Label mismatch error handled correctly")
 646     or diag($dev->error_or_status());
 647
 648 # Use some config to set a block size on a child device
 649 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 650 $dev_name = "rait:{file:$vtape1,mytape2}";
 651
 652 $testconf = Installcheck::Config->new();
 653 $testconf->add_device("mytape2", [
 654     "tapedev" => "\"file:$vtape2\"",
 655     "device_property" => "\"BLOCK_SIZE\" \"64k\""
 656 ]);
 657 $testconf->write();
 658 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 659     or die("Could not load configuration");
 660
 661 $dev = Amanda::Device->new($dev_name);
 662 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 663    "$dev_name: create successful")
 664     or diag($dev->error_or_status());
 665
 666 ok($dev->configure(1), "configure device");
 667
 668 is($dev->property_get("block_size"), 65536,
 669     "rait device calculates a block size from its children correctly");
 670
 671 # Test an S3 device if the proper environment variables are set
 672 my $S3_SECRET_KEY = $ENV{'INSTALLCHECK_S3_SECRET_KEY'};
 673 my $S3_ACCESS_KEY = $ENV{'INSTALLCHECK_S3_ACCESS_KEY'};
 674 my $DEVPAY_SECRET_KEY = $ENV{'INSTALLCHECK_DEVPAY_SECRET_KEY'};
 675 my $DEVPAY_ACCESS_KEY = $ENV{'INSTALLCHECK_DEVPAY_ACCESS_KEY'};
 676 my $DEVPAY_USER_TOKEN = $ENV{'INSTALLCHECK_DEVPAY_USER_TOKEN'};
 677
 678 my $run_s3_tests = defined $S3_SECRET_KEY && defined $S3_ACCESS_KEY;
 679 my $run_devpay_tests = defined $DEVPAY_SECRET_KEY &&
 680     defined $DEVPAY_ACCESS_KEY && $DEVPAY_USER_TOKEN;
 681
 682 my $s3_make_device_count = 7;
 683 sub s3_make_device($$) {
 684     my ($dev_name, $kind) = @_;
 685     $dev = Amanda::Device->new($dev_name);
 686     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 687        "$dev_name: create successful")
 688         or diag($dev->error_or_status());
 689
 690     my @s3_props = ( 's3_access_key', 's3_secret_key' );
 691     push @s3_props, 's3_user_token' if ($kind eq "devpay");
 692     properties_include([ $dev->property_list() ], [ @common_properties, @s3_props ],
 693         "necessary properties listed on s3 device");
 694
 695     ok($dev->property_set('BLOCK_SIZE', 32768*2),
 696         "set block size")
 697         or diag($dev->error_or_status());
 698
 699     # might as well save a few cents while testing this property..
 700     ok($dev->property_set('S3_STORAGE_CLASS', 'REDUCED_REDUNDANCY'),
 701         "set storage class")
 702         or diag($dev->error_or_status());
 703
 704     if ($kind eq "s3") {
 705         # use regular S3 credentials
 706         ok($dev->property_set('S3_ACCESS_KEY', $S3_ACCESS_KEY),
 707            "set S3 access key")
 708         or diag($dev->error_or_status());
 709
 710         ok($dev->property_set('S3_SECRET_KEY', $S3_SECRET_KEY),
 711            "set S3 secret key")
 712             or diag($dev->error_or_status());
 713
 714         pass("(placeholder)");
 715     } elsif ($kind eq "devpay") {
 716         # use devpay credentials
 717         ok($dev->property_set('S3_ACCESS_KEY', $DEVPAY_ACCESS_KEY),
 718            "set devpay access key")
 719         or diag($dev->error_or_status());
 720
 721         ok($dev->property_set('S3_SECRET_KEY', $DEVPAY_SECRET_KEY),
 722            "set devpay secret key")
 723             or diag($dev->error_or_status());
 724
 725         ok($dev->property_set('S3_USER_TOKEN', $DEVPAY_USER_TOKEN),
 726            "set devpay user token")
 727             or diag($dev->error_or_status());
 728     } else {
 729         croak("didn't recognize the device kind, so no credentials were set");
 730     }
 731     return $dev;
 732 }
 733
 734 my $base_name;
 735
 736 SKIP: {
 737     skip "define \$INSTALLCHECK_S3_{SECRET,ACCESS}_KEY to run S3 tests",
 738             101 +
 739             1 * $verify_file_count +
 740             7 * $write_file_count +
 741             13 * $s3_make_device_count
 742         unless $run_s3_tests;
 743
 744     $dev_name = "s3:";
 745     $dev = Amanda::Device->new($dev_name);
 746     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 747          "creating $dev_name fails miserably");
 748
 749     $dev_name = "s3:foo";
 750     $dev = Amanda::Device->new($dev_name);
 751
 752     ok($dev->property_get("full_deletion"),
 753        "property_get(full_deletion) on s3 device");
 754
 755     ok($dev->property_get("leom"),
 756        "property_get(leom) on s3 device");
 757
 758     # test parsing of boolean values
 759     # (s3 is the only device driver that has a writable boolean property at the
 760     # moment)
 761
 762     my @verbose_vals = (
 763         {'val' => '1', 'true' => 1},
 764         {'val' => '0', 'true' => 0},
 765         {'val' => 't', 'true' => 1},
 766         {'val' => 'true', 'true' => 1},
 767         {'val' => 'f', 'true' => 0},
 768         {'val' => 'false', 'true' => 0},
 769         {'val' => 'y', 'true' => 1},
 770         {'val' => 'yes', 'true' => 1},
 771         {'val' => 'n', 'true' => 0},
 772         {'val' => 'no', 'true' => 0},
 773         {'val' => 'on', 'true' => 1},
 774         {'val' => 'off', 'true' => 0},
 775         {'val' => 'oFf', 'true' => 0},
 776         );
 777
 778     foreach my $v (@verbose_vals) {
 779         $dev_name = "s3:foo";
 780         $dev = Amanda::Device->new($dev_name);
 781
 782         $testconf = Installcheck::Config->new();
 783         $testconf->add_param("device_property", "\"verbose\" \"$v->{'val'}\"");
 784         $testconf->write();
 785         config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 786             or die("Could not load configuration");
 787
 788         ok($dev->configure(1),
 789            "configured device with verbose set to $v->{'val'}")
 790             or diag($dev->error_or_status());
 791
 792         my $get_val = $dev->property_get('verbose');
 793         # see if truth-iness matches
 794         my $expec = $v->{'true'}? "true" : "false";
 795         is(!!$dev->property_get('verbose'), !!$v->{'true'},
 796            "device_property 'VERBOSE' '$v->{'val'}' => property_get(verbose) returning $expec");
 797     }
 798
 799     # test unparsable property
 800     $dev_name = "s3:foo";
 801     $dev = Amanda::Device->new($dev_name);
 802
 803     $testconf = Installcheck::Config->new();
 804     $testconf->add_param("device_property", "\"verbose\" \"foo\"");
 805     $testconf->write();
 806     config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 807         or die("Could not load configuration");
 808
 809     ok(!$dev->configure(1),
 810        "failed to configure device with verbose set to foo");
 811
 812     like($dev->error_or_status(), qr/'verbose'/,
 813          "error message mentions property name");
 814
 815     like($dev->error_or_status(), qr/'foo'/,
 816          "error message mentions property value");
 817
 818     like($dev->error_or_status(), qr/gboolean/,
 819          "error message mentions property type");
 820
 821     my $hostname  = hostname();
 822     $hostname =~ s/\./-/g;
 823     $base_name = "$S3_ACCESS_KEY-installcheck-$hostname";
 824     $dev_name = "s3:$base_name-s3";
 825     $dev = s3_make_device($dev_name, "s3");
 826     $dev->read_label();
 827     my $status = $dev->status();
 828     # this test appears very liberal, but catches the case where setup_handle fails without
 829     # giving false positives
 830     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 831        "status is either OK or possibly unlabeled")
 832         or diag($dev->error_or_status());
 833
 834     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 835        "start in write mode")
 836         or diag($dev->error_or_status());
 837
 838     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 839        "it's labeled now")
 840         or diag($dev->error_or_status());
 841
 842     for (my $i = 1; $i <= 3; $i++) {
 843         write_file(0x2FACE, $dev->block_size()*10, $i);
 844     }
 845
 846     ok($dev->finish(),
 847        "finish device after write")
 848         or diag($dev->error_or_status());
 849
 850     $dev->read_label();
 851     ok(!($dev->status()),
 852        "no error, at all, from read_label")
 853         or diag($dev->error_or_status());
 854
 855     # append one more copy, to test ACCESS_APPEND
 856
 857     ok($dev->start($ACCESS_APPEND, undef, undef),
 858        "start in append mode")
 859         or diag($dev->error_or_status());
 860
 861     write_file(0xD0ED0E, $dev->block_size()*10, 4);
 862
 863     ok($dev->finish(),
 864        "finish device after append")
 865         or diag($dev->error_or_status());
 866
 867     # try reading the third file back
 868
 869     ok($dev->start($ACCESS_READ, undef, undef),
 870        "start in read mode")
 871         or diag($dev->error_or_status());
 872
 873     verify_file(0x2FACE, $dev->block_size()*10, 3);
 874
 875     # test EOT indications on reading
 876     my $hdr = $dev->seek_file(4);
 877     is($hdr->{'type'}, $Amanda::Header::F_DUMPFILE,
 878         "file 4 has correct type F_DUMPFILE");
 879
 880     $hdr = $dev->seek_file(5);
 881     is($hdr->{'type'}, $Amanda::Header::F_TAPEEND,
 882         "file 5 has correct type F_TAPEEND");
 883
 884     $hdr = $dev->seek_file(6);
 885     is($hdr, undef, "seek_file returns undef for file 6");
 886
 887     ok($dev->finish(),
 888        "finish device after read")
 889         or diag($dev->error_or_status());    # (note: we don't use write_max_size here,
 890                                              # as the maximum for S3 is very large)
 891
 892     ok($dev->erase(),
 893        "erase device")
 894        or diag($dev->error_or_status());
 895
 896     ok($dev->erase(),
 897        "erase device (again)")
 898        or diag($dev->error_or_status());
 899
 900     ok($dev->finish(),
 901        "finish device after erase")
 902         or diag($dev->error_or_status());
 903
 904     $dev->read_label();
 905     $status = $dev->status();
 906     ok($status & $DEVICE_STATUS_VOLUME_UNLABELED,
 907        "status is unlabeled after an erase")
 908         or diag($dev->error_or_status());
 909
 910     $dev = s3_make_device($dev_name, "s3");
 911
 912     ok($dev->erase(),
 913        "erase device right after creation")
 914        or diag($dev->error_or_status());
 915
 916     $dev = s3_make_device($dev_name, "s3");
 917
 918     # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=false
 919     ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
 920        "set MAX_VOLUME_USAGE to test LEOM");
 921
 922     ok($dev->property_set("LEOM", 1),
 923         "set LEOM");
 924
 925     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 926        "start in write mode")
 927         or diag($dev->error_or_status());
 928
 929     write_file(0x2FACE, 440*1024, 1);
 930
 931     ok(!$dev->is_eom,
 932         "device does not indicate LEOM after writing as property ENFORCE_MAX_VOLUME_USAGE not set and its default value is false");
 933
 934     ok($dev->finish(),
 935        "finish device after LEOM test")
 936        or diag($dev->error_or_status());
 937
 938     ok($dev->erase(),
 939        "erase device")
 940        or diag($dev->error_or_status());
 941
 942     $dev = s3_make_device($dev_name, "s3");
 943
 944     # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=true
 945     ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
 946        "set MAX_VOLUME_USAGE to test LEOM");
 947
 948     ok($dev->property_set('ENFORCE_MAX_VOLUME_USAGE', 1 ),
 949        "set ENFORCE_MAX_VOLUME_USAGE");
 950
 951     ok($dev->property_set("LEOM", 1),
 952         "set LEOM");
 953
 954     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 955        "start in write mode")
 956         or diag($dev->error_or_status());
 957
 958     write_file(0x2FACE, 440*1024, 1);
 959
 960     ok($dev->is_eom,
 961         "device indicates LEOM after writing, when property ENFORCE_MAX_VOLUME_USAGE set to true");
 962
 963     ok($dev->finish(),
 964        "finish device after LEOM test")
 965        or diag($dev->error_or_status());
 966
 967     ok($dev->erase(),
 968        "erase device")
 969        or diag($dev->error_or_status());
 970
 971     $dev = s3_make_device($dev_name, "s3");
 972
 973     # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=false
 974     ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
 975        "set MAX_VOLUME_USAGE to test LEOM");
 976
 977     ok($dev->property_set('ENFORCE_MAX_VOLUME_USAGE', 0 ),
 978        "set ENFORCE_MAX_VOLUME_USAGE");
 979
 980     ok($dev->property_set("LEOM", 1),
 981         "set LEOM");
 982
 983     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 984        "start in write mode")
 985         or diag($dev->error_or_status());
 986
 987     write_file(0x2FACE, 440*1024, 1);
 988
 989     ok(!$dev->is_eom,
 990         "device does not indicate LEOM after writing, when property ENFORCE_MAX_VOLUME_USAGE set to false");
 991
 992     ok($dev->finish(),
 993        "finish device after LEOM test")
 994        or diag($dev->error_or_status());
 995
 996     ok($dev->erase(),
 997        "erase device")
 998        or diag($dev->error_or_status());
 999
1000     # try with empty user token
1001     $dev_name = lc("s3:$base_name-s3");
1002     $dev = s3_make_device($dev_name, "s3");
1003     ok($dev->property_set('S3_USER_TOKEN', ''),
1004        "set devpay user token")
1005         or diag($dev->error_or_status());
1006
1007     $dev->read_label();
1008     $status = $dev->status();
1009     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1010        "status is either OK or possibly unlabeled")
1011         or diag($dev->error_or_status());
1012
1013     $dev->finish();
1014
1015     ok($dev->erase(),
1016        "erase device")
1017        or diag($dev->error_or_status());
1018
1019     # try a eu-constrained bucket
1020     $dev_name = lc("s3:$base_name-s3-eu");
1021     $dev = s3_make_device($dev_name, "s3");
1022     ok($dev->property_set('S3_BUCKET_LOCATION', 'EU'),
1023        "set S3 bucket location to 'EU'")
1024         or diag($dev->error_or_status());
1025
1026     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1027        "start in write mode")
1028         or diag($dev->error_or_status());
1029
1030     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1031        "status is OK")
1032         or diag($dev->error_or_status());
1033
1034     $dev->finish();
1035
1036     ok($dev->erase(),
1037        "erase device")
1038        or diag($dev->error_or_status());
1039
1040     # try a wildcard-constrained bucket
1041     $dev_name = lc("s3:$base_name-s3-wild");
1042     $dev = s3_make_device($dev_name, "s3");
1043     ok($dev->property_set('S3_BUCKET_LOCATION', '*'),
1044        "set S3 bucket location to ''")
1045         or diag($dev->error_or_status());
1046
1047     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1048        "start in write mode")
1049         or diag($dev->error_or_status());
1050
1051     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1052        "status is OK")
1053         or diag($dev->error_or_status());
1054
1055     $dev->finish();
1056
1057     # test again with invalid ca_info
1058     $dev = s3_make_device($dev_name, "s3");
1059     SKIP: {
1060         skip "SSL not supported; can't check SSL_CA_INFO", 2
1061             unless $dev->property_get('S3_SSL');
1062
1063         ok($dev->property_set('SSL_CA_INFO', '/dev/null'),
1064            "set invalid SSL/TLS CA certificate")
1065             or diag($dev->error_or_status());
1066
1067         ok(!$dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1068            "start in write mode")
1069             or diag($dev->error_or_status());
1070
1071         isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1072            "status is OK")
1073             or diag($dev->error_or_status());
1074
1075         $dev->finish();
1076     }
1077
1078     # test again with our own CA bundle
1079     $dev = s3_make_device($dev_name, "s3");
1080     SKIP: {
1081         skip "SSL not supported; can't check SSL_CA_INFO", 4
1082             unless $dev->property_get('S3_SSL');
1083         ok($dev->property_set('SSL_CA_INFO', "$srcdir/data/aws-bundle.crt"),
1084            "set our own SSL/TLS CA certificate bundle")
1085             or diag($dev->error_or_status());
1086
1087         ok($dev->erase(),
1088            "erase device")
1089             or diag($dev->error_or_status());
1090
1091         ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1092            "start in write mode")
1093             or diag($dev->error_or_status());
1094
1095         is($dev->status(), $DEVICE_STATUS_SUCCESS,
1096            "status is OK")
1097             or diag($dev->error_or_status());
1098
1099         $dev->finish();
1100     }
1101
1102     ok($dev->erase(),
1103        "erase device")
1104        or diag($dev->error_or_status());
1105
1106     # bucket names incompatible with location constraint
1107     $dev_name = "s3:-$base_name-s3-eu";
1108     $dev = s3_make_device($dev_name, "s3");
1109
1110     ok($dev->property_set('S3_BUCKET_LOCATION', ''),
1111        "should be able to set an empty S3 bucket location with an incompatible name")
1112         or diag($dev->error_or_status());
1113
1114     $dev_name = "s3:$base_name-s3.eu";
1115     $dev = s3_make_device($dev_name, "s3");
1116
1117     ok($dev->property_set('S3_BUCKET_LOCATION', ''),
1118        "should be able to set an empty S3 bucket location with an incompatible name")
1119         or diag($dev->error_or_status());
1120
1121     $dev_name = "s3:-$base_name-s3-eu";
1122     $dev = s3_make_device($dev_name, "s3");
1123
1124     ok(!$dev->property_set('S3_BUCKET_LOCATION', 'EU'),
1125        "should not be able to set S3 bucket location with an incompatible name")
1126         or diag($dev->error_or_status());
1127
1128     $dev_name = lc("s3:$base_name-s3-eu");
1129     $dev = s3_make_device($dev_name, "s3");
1130     ok($dev->property_set('S3_BUCKET_LOCATION', 'XYZ'),
1131        "should be able to set S3 bucket location with a compatible name")
1132         or diag($dev->error_or_status());
1133     $dev->read_label();
1134     $status = $dev->status();
1135     ok(($status == $DEVICE_STATUS_DEVICE_ERROR),
1136        "status is DEVICE_STATUS_DEVICE_ERROR")
1137         or diag($dev->error_or_status());
1138     my $error_msg = $dev->error_or_status();
1139     ok(($dev->error_or_status() == "While creating new S3 bucket: The specified location-constraint is not valid (Unknown) (HTTP 400)"),
1140        "invalid location-constraint")
1141        or diag("bad error: " . $dev->error_or_status());
1142
1143 }
1144
1145 SKIP: {
1146     # in this case, most of our code has already been exercised
1147     # just make sure that authentication works as a basic sanity check
1148     skip "skipping abbreviated devpay tests", $s3_make_device_count + 1
1149         unless $run_devpay_tests;
1150     $dev_name = "s3:$base_name-devpay";
1151     $dev = s3_make_device($dev_name, "devpay");
1152     $dev->read_label();
1153     my $status = $dev->status();
1154     # this test appears very liberal, but catches the case where setup_handle fails without
1155     # giving false positives
1156     ok(($status == 0) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1157        "status is either OK or possibly unlabeled")
1158         or diag($dev->error_or_status());
1159 }
1160
1161 # Test a tape device if the proper environment variables are set
1162 my $TAPE_DEVICE = $ENV{'INSTALLCHECK_TAPE_DEVICE'};
1163 my $run_tape_tests = defined $TAPE_DEVICE;
1164 SKIP: {
1165     skip "define \$INSTALLCHECK_TAPE_DEVICE to run tape tests",
1166             30 +
1167             7 * $verify_file_count +
1168             5 * $write_file_count
1169         unless $run_tape_tests;
1170
1171     $dev_name = "tape:$TAPE_DEVICE";
1172     $dev = Amanda::Device->new($dev_name);
1173     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1174         "$dev_name: create successful")
1175         or diag($dev->error_or_status());
1176
1177     my $status = $dev->read_label();
1178     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1179        "status is either OK or possibly unlabeled")
1180         or diag($dev->error_or_status());
1181
1182     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1183         "start in write mode")
1184         or diag($dev->error_or_status());
1185
1186     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
1187         "not unlabeled anymore")
1188         or diag($dev->error_or_status());
1189
1190     for (my $i = 1; $i <= 4; $i++) {
1191         write_file(0x2FACE+$i, $dev->block_size()*10+17, $i);
1192     }
1193
1194     ok($dev->finish(),
1195         "finish device after write")
1196         or diag($dev->error_or_status());
1197
1198     $dev->read_label();
1199     ok(!($dev->status()),
1200         "no error, at all, from read_label")
1201         or diag($dev->error_or_status());
1202
1203     is($dev->volume_label(), "TESTCONF13",
1204         "read_label reads the correct label")
1205         or diag($dev->error_or_status());
1206
1207     # append one more copy, to test ACCESS_APPEND
1208
1209     # if final_filemarks is 1, then the tape device will use F_NOOP,
1210     # inserting an extra file, and we'll be appending at file number 6.
1211     my $append_fileno = ($dev->property_get("FINAL_FILEMARKS") == 2)? 5:6;
1212
1213     SKIP: {
1214         skip "APPEND not supported", $write_file_count + 2
1215             unless $dev->property_get("APPENDABLE");
1216
1217         ok($dev->start($ACCESS_APPEND, undef, undef),
1218             "start in append mode")
1219             or diag($dev->error_or_status());
1220
1221         write_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1222
1223         ok($dev->finish(),
1224             "finish device after append")
1225             or diag($dev->error_or_status());
1226     }
1227
1228     # try reading the second and third files back, creating a new
1229     # device object first, and skipping the read-label step.
1230
1231     $dev = undef;
1232     $dev = Amanda::Device->new($dev_name);
1233     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1234         "$dev_name: re-create successful")
1235         or diag($dev->error_or_status());
1236
1237     # use a big read_block_size, checking that it's also settable
1238     # via read_buffer_size
1239     ok($dev->property_set("read_buffer_size", 256*1024),
1240         "can set read_buffer_size");
1241     is($dev->property_get("read_block_size"), 256*1024,
1242         "and its value is reflected in read_block_size");
1243     ok($dev->property_set("read_block_size", 32*1024),
1244         "can set read_block_size");
1245
1246     ok($dev->start($ACCESS_READ, undef, undef),
1247         "start in read mode")
1248         or diag($dev->error_or_status());
1249
1250     # now verify those files in a particular order to trigger all of the
1251     # seeking edge cases
1252
1253     verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
1254     verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1255     verify_file(0x2FACE+4, $dev->block_size()*10+17, 4);
1256     verify_file(0x2FACE+3, $dev->block_size()*10+17, 3);
1257     verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
1258
1259     # try re-seeking to the same file
1260     ok(header_for($dev->seek_file(2), 2), "seek to file 2 the first time");
1261     verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1262     ok(header_for($dev->seek_file(2), 2), "seek to file 2 the third time");
1263
1264     # and seek through the same pattern *without* reading to EOF
1265     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1266     ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1267     ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1268     ok(header_for($dev->seek_file(3), 3), "seek to file 3");
1269     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1270
1271     SKIP: {
1272         skip "APPEND not supported", $verify_file_count
1273             unless $dev->property_get("APPENDABLE");
1274         verify_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1275     }
1276
1277     ok($dev->finish(),
1278         "finish device after read")
1279         or diag($dev->error_or_status());
1280
1281     # tickle a regression in improperly closing fd's
1282     ok($dev->finish(),
1283         "finish device again after read")
1284         or diag($dev->error_or_status());
1285
1286     ok($dev->read_label() == $DEVICE_STATUS_SUCCESS,
1287         "read_label after second finish (used to fail)")
1288         or diag($dev->error_or_status());
1289
1290     # finally, run the device with FSF and BSF set to "no", to test the
1291     # fallback schemes for this condition
1292
1293     $dev = undef;
1294     $dev = Amanda::Device->new($dev_name);
1295     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1296         "$dev_name: re-create successful")
1297         or diag($dev->error_or_status());
1298     $dev->property_set("fsf", "no");
1299     $dev->property_set("bsf", "no");
1300
1301     ok($dev->start($ACCESS_READ, undef, undef),
1302         "start in read mode")
1303         or diag($dev->error_or_status());
1304
1305     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1306     ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1307     ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1308
1309     ok($dev->finish(),
1310         "finish device after read")
1311         or diag($dev->error_or_status());
1312 }
1313
1314 SKIP: {
1315     skip "not built with ndmp and server", 78 unless
1316         Amanda::Util::built_with_component("ndmp") and
1317         Amanda::Util::built_with_component("server");
1318
1319     my $dev;
1320     my $testconf = Installcheck::Config->new();
1321     $testconf->write();
1322
1323     my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
1324     if ($cfg_result != $CFGERR_OK) {
1325         my ($level, @errors) = Amanda::Config::config_errors();
1326         die(join "\n", @errors);
1327     }
1328
1329     my $ndmp = Installcheck::Mock::NdmpServer->new();
1330     my $ndmp_port = $ndmp->{'port'};
1331     my $drive = $ndmp->{'drive'};
1332     pass("started ndmjob in daemon mode");
1333
1334     # set up a header for use below
1335     my $hdr = Amanda::Header->new();
1336     $hdr->{type} = $Amanda::Header::F_DUMPFILE;
1337     $hdr->{datestamp} = "20070102030405";
1338     $hdr->{dumplevel} = 0;
1339     $hdr->{compressed} = 1;
1340     $hdr->{name} = "localhost";
1341     $hdr->{disk} = "/home";
1342     $hdr->{program} = "INSTALLCHECK";
1343
1344     $dev = Amanda::Device->new("ndmp:127.0.0.1:9i1\@foo");
1345     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1346         "creation of an ndmp device fails with invalid port");
1347
1348     $dev = Amanda::Device->new("ndmp:127.0.0.1:90000\@foo");
1349     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1350         "creation of an ndmp device fails with too-large port");
1351
1352     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port");
1353     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1354         "creation of an ndmp device fails without ..\@device_name");
1355
1356     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1357     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1358         "creation of an ndmp device succeeds with correct syntax");
1359
1360     ok($dev->property_set("ndmp_username", "foo"),
1361         "set ndmp_username property");
1362     is($dev->property_get("ndmp_username"), "foo",
1363         "..and get the value back");
1364     ok($dev->property_set("ndmp_password", "bar"),
1365         "set ndmp_password property");
1366     is($dev->property_get("ndmp_password"), "bar",
1367         "..and get the value back");
1368
1369     ok($dev->property_set("verbose", 1),
1370         "set VERBOSE");
1371
1372     # set 'em back to the defaults
1373     $dev->property_set("ndmp_username", "ndmp");
1374     $dev->property_set("ndmp_password", "ndmp");
1375
1376     # use a big read_block_size, checking that it's also settable
1377     # via read_buffer_size
1378     ok($dev->property_set("read_block_size", 256*1024),
1379     "can set read_block_size");
1380     is($dev->property_get("read_block_size"), 256*1024,
1381     "and its value is reflected");
1382     ok($dev->property_set("read_block_size", 64*1024),
1383     "set read_block_size back to something smaller");
1384
1385     # ok, let's fire the thing up
1386     ok($dev->start($ACCESS_WRITE, "TEST1", "20090915000000"),
1387         "start device in write mode")
1388         or diag $dev->error_or_status();
1389
1390     ok($dev->start_file($hdr),
1391         "start_file");
1392
1393     {   # write to the file
1394         my $xfer = Amanda::Xfer->new([
1395                 Amanda::Xfer::Source::Random->new(32768*21, 0xBEEFEE00),
1396                 Amanda::Xfer::Dest::Device->new($dev, 0) ]);
1397         $xfer->start(make_cb(xmsg_cb => sub {
1398             my ($src, $msg, $xfer) = @_;
1399             if ($msg->{'type'} == $XMSG_ERROR) {
1400                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1401             } elsif ($msg->{'type'} == $XMSG_DONE) {
1402                 Amanda::MainLoop::quit();
1403             }
1404         }));
1405
1406         Amanda::MainLoop::run();
1407         pass("wrote 21 blocks");
1408     }
1409
1410     ok($dev->finish(),
1411         "finish device")
1412         or diag $dev->error_or_status();
1413
1414     is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1415         "read label from (same) device")
1416         or diag $dev->error_or_status();
1417
1418     is($dev->volume_label, "TEST1",
1419         "volume label read back correctly");
1420
1421     ## label a device and check the label, but open a new device in between
1422
1423     # Write a label
1424     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1425     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1426         "creation of an ndmp device succeeds with correct syntax");
1427     $dev->property_set("ndmp_username", "ndmp");
1428     $dev->property_set("ndmp_password", "ndmp");
1429     $dev->property_set("verbose", 1);
1430
1431     # Write the label
1432     ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1433         "start device in write mode")
1434         or diag $dev->error_or_status();
1435     ok($dev->finish(),
1436         "finish device")
1437         or diag $dev->error_or_status();
1438
1439     # Read the label with a new device.
1440     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1441     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1442         "creation of an ndmp device succeeds with correct syntax");
1443     $dev->property_set("ndmp_username", "ndmp");
1444     $dev->property_set("ndmp_password", "ndmp");
1445     $dev->property_set("verbose", 1);
1446
1447     # read the label
1448     is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1449         "read label from device")
1450         or diag $dev->error_or_status();
1451     is($dev->volume_label, "TEST2",
1452         "volume label read back correctly");
1453     ok($dev->finish(),
1454         "finish device")
1455         or diag $dev->error_or_status();
1456
1457     #
1458     # test the directtcp-target implementation
1459     #
1460
1461     ok($dev->directtcp_supported(), "is a directtcp target");
1462     for my $dev_use ('initiator', 'listener') {
1463         my ($xfer, $addrs, $dest_elt);
1464         if ($dev_use eq 'listener') {
1465             $addrs = $dev->listen(1);
1466             ok($addrs, "listen returns successfully") or die($dev->error_or_status());
1467
1468             # set up an xfer to write to the device
1469             $dest_elt = Amanda::Xfer::Dest::DirectTCPConnect->new($addrs);
1470         } else {
1471             # set up an xfer to write to the device
1472             $dest_elt = Amanda::Xfer::Dest::DirectTCPListen->new();
1473         }
1474         $xfer = Amanda::Xfer->new([
1475                 Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
1476                 $dest_elt,
1477             ]);
1478
1479         my @messages;
1480         $xfer->start(make_cb(xmsg_cb => sub {
1481             my ($src, $msg, $xfer) = @_;
1482             if ($msg->{'type'} == $XMSG_ERROR) {
1483                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1484             } elsif ($msg->{'type'} == $XMSG_DONE) {
1485                 Amanda::MainLoop::quit();
1486             }
1487         }));
1488
1489         # write files from the connection until EOF
1490         my $num_files;
1491         my $conn;
1492         my ($finish_connection, $start_device, $write_file_cb);
1493
1494
1495         $finish_connection = make_cb(finish_connection => sub {
1496             if ($dev_use eq 'listener') {
1497                 $conn = $dev->accept();
1498             } else {
1499                 $addrs = $dest_elt->get_addrs();
1500                 $conn = $dev->connect(1, $addrs);
1501             }
1502             Amanda::MainLoop::call_later($start_device);
1503         });
1504
1505
1506         $start_device = make_cb(start_device => sub {
1507             ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1508                 "start device in write mode")
1509                 or diag $dev->error_or_status();
1510
1511             Amanda::MainLoop::call_later($write_file_cb);
1512         });
1513
1514         $write_file_cb = make_cb(write_file_cb => sub {
1515             ++$num_files < 20 or die "I seem to be in a loop!";
1516
1517             ok($dev->start_file($hdr), "start file $num_files for writing");
1518             is($dev->file, $num_files, "..file number is correct");
1519
1520             my ($ok, $size) = $dev->write_from_connection(32768*15);
1521             push @messages, sprintf("WRITE-%s-%d-%s-%s",
1522                 $ok?"OK":"ERR", $size,
1523                 $dev->is_eof()? "EOF":"!eof",
1524                 $dev->is_eom()? "EOM":"!eom");
1525             ok($ok, "..write from connection succeeds");
1526             my $eof = $dev->is_eof();
1527
1528             ok($dev->finish_file(), "..finish file after writing");
1529
1530             if (!$eof) {
1531                 Amanda::MainLoop::call_later($write_file_cb);
1532             }
1533         });
1534
1535         Amanda::MainLoop::call_later($finish_connection);
1536         Amanda::MainLoop::run();
1537         is_deeply([@messages], [
1538                 'WRITE-OK-491520-!eof-!eom',
1539                 'WRITE-OK-491520-!eof-!eom',
1540                 'WRITE-OK-131072-EOF-!eom',
1541             ],
1542             "a sequence of write_from_connection calls works correctly");
1543
1544         $dev->finish();
1545
1546         if (my $err = $conn->close()) {
1547             die $err;
1548         }
1549     }
1550
1551     # now try reading that back piece by piece
1552
1553     {
1554         my $filename = "$Installcheck::TMP/Amanda_Device_ndmp.tmp";
1555         open(my $dest_fh, ">", $filename);
1556
1557         ok($dev->start($ACCESS_READ, undef, undef),
1558             "start device in read mode")
1559             or diag $dev->error_or_status();
1560
1561         my $file;
1562         for ($file = 1; $file <= 3; $file++) {
1563             ok($dev->seek_file($file),
1564                 "seek_file $file");
1565             is($dev->file, $file, "..file num is correct");
1566             is($dev->block, 0, "..block num is correct");
1567
1568             # read the file, writing to our temp file.  We'll check that the byte
1569             # sequence is correct later
1570             my $xfer = Amanda::Xfer->new([
1571                     Amanda::Xfer::Source::Device->new($dev),
1572                     Amanda::Xfer::Dest::Fd->new($dest_fh) ]);
1573
1574             $xfer->start(make_cb(xmsg_cb => sub {
1575                 my ($src, $msg, $xfer) = @_;
1576                 if ($msg->{'type'} == $XMSG_ERROR) {
1577                     die $msg->{'elt'} . " failed: " . $msg->{'message'};
1578                 } elsif ($msg->{'type'} == $XMSG_DONE) {
1579                     Amanda::MainLoop::quit();
1580                 }
1581             }));
1582             Amanda::MainLoop::run();
1583
1584             pass("read back file " . $file);
1585         }
1586
1587         $dev->finish();
1588         close $dest_fh;
1589
1590         # now read back and verify that file
1591         open(my $src_fh, "<", $filename);
1592         my $xfer = Amanda::Xfer->new([
1593                 Amanda::Xfer::Source::Fd->new($src_fh),
1594                 Amanda::Xfer::Dest::Null->new(0xB00) ]);
1595
1596         $xfer->start(make_cb(xmsg_cb => sub {
1597             my ($src, $msg, $xfer) = @_;
1598             if ($msg->{'type'} == $XMSG_ERROR) {
1599                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1600             } elsif ($msg->{'type'} == $XMSG_DONE) {
1601                 Amanda::MainLoop::quit();
1602             }
1603         }));
1604         Amanda::MainLoop::run();
1605
1606         pass("data in the three parts is correct");
1607         unlink $filename;
1608     }
1609
1610     ####
1611     # Test read_to_connection
1612     #
1613     # This requires something that can connect to a device and read from
1614     # it; the XFA does not have an XFER_MECH_DIRECTTCP_CONNECT, so we fake
1615     # it by manually connecting and then setting up an xfer with a regular
1616     # XferSourceFd.  This works because the NDMP server will accept an
1617     # incoming connection before the Device API accept() method is called;
1618     # this trick may not work with other DirectTCP-capable devices.  Also,
1619     # this doesn't work so well if there's an error in the xfer (e.g., a
1620     # random value mismatch).  But tests are supposed to succeed!
1621
1622     sub test_read2conn {
1623         my ($finished_cb) = @_;
1624         my @events;
1625         my $file = 1;
1626         my ($conn, $sock);
1627
1628         my $steps = define_steps
1629             cb_ref => \$finished_cb;
1630
1631         step setup => sub {
1632             my $addrs = $dev->listen(0);
1633
1634             # now connect to that
1635             $sock = IO::Socket::INET->new(
1636                 Proto => "tcp",
1637                 PeerHost => $addrs->[0][0],
1638                 PeerPort => $addrs->[0][1],
1639                 Blocking => 1,
1640             );
1641
1642             # and set up a transfer to read from that socket
1643             my $xfer = Amanda::Xfer->new([
1644                     Amanda::Xfer::Source::Fd->new($sock),
1645                     Amanda::Xfer::Dest::Null->new(0xB00) ]);
1646
1647             $xfer->start(make_cb(xmsg_cb => sub {
1648                 my ($src, $msg, $xfer) = @_;
1649                 if ($msg->{'type'} == $XMSG_ERROR) {
1650                     die $msg->{'elt'} . " failed: " . $msg->{'message'};
1651                 }
1652                 if ($msg->{'type'} == $XMSG_DONE) {
1653                     push @events, "DONE";
1654                     $steps->{'quit'}->();
1655                 }
1656             }));
1657
1658             $steps->{'accept'}->();
1659         };
1660
1661         step accept => sub {
1662             $conn = $dev->accept();
1663             die $dev->error_or_status() unless ($conn);
1664
1665             Amanda::MainLoop::call_later($steps->{'start_dev'});
1666         };
1667
1668         step start_dev => sub {
1669             ok($dev->start($ACCESS_READ, undef, undef),
1670                 "start device in read mode")
1671                 or diag $dev->error_or_status();
1672
1673             Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1674         };
1675
1676         step read_part_cb => sub {
1677             my $hdr = $dev->seek_file($file);
1678             die $dev->error_or_status() unless ($hdr);
1679             my $size = $dev->read_to_connection(0);
1680             push @events, "READ-$size";
1681
1682             if (++$file <= 3) {
1683                 Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1684             } else {
1685                 # close the connection, which will end the xfer, which will
1686                 # result in a call to finished_cb.  So there.
1687                 push @events, "CLOSE";
1688                 $conn->close();
1689             }
1690         };
1691
1692         step quit => sub {
1693             close $sock or die "close: $!";
1694
1695             is_deeply([@events],
1696                 [ "READ-491520", "READ-491520", "READ-131072", "CLOSE", "DONE" ],
1697                 "sequential read_to_connection operations read the right amounts " .
1698                 "and bytestream matches");
1699
1700             $finished_cb->();
1701         };
1702     }
1703     test_read2conn(\&Amanda::MainLoop::quit);
1704     Amanda::MainLoop::run();
1705
1706     # try two seek_file's in a row
1707     $hdr = $dev->seek_file(2);
1708     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
1709     $hdr = $dev->seek_file(2);
1710     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
1711
1712     ## test seek_file's handling of EOM
1713
1714     $hdr = $dev->seek_file(3);
1715     is($hdr->{type}, $Amanda::Header::F_DUMPFILE, "file 3 is a dumpfile");
1716     $hdr = $dev->seek_file(4);
1717     is($hdr->{type}, $Amanda::Header::F_TAPEEND, "file 4 is tapeend");
1718     $hdr = $dev->seek_file(5);
1719     is($hdr, undef, "file 5 is an error");
1720     $hdr = $dev->seek_file(6);
1721     is($hdr, undef, "file 6 is an error");
1722
1723     $ndmp->cleanup();
1724 }
1725 unlink($input_filename);
1726 unlink($output_filename);
1727 rmtree($taperoot);