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