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

   1 # Copyright (c) 2005-2008 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 Mathlida Ave, Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 use Test::More tests => 301;
  20 use File::Path qw( mkpath rmtree );
  21 use Sys::Hostname;
  22 use Carp;
  23 use strict;
  24
  25 use lib "@amperldir@";
  26 use Installcheck::Config;
  27 use Amanda::Debug;
  28 use Amanda::Device qw( :constants );
  29 use Amanda::Config qw( :getconf :init );
  30 use Amanda::Types;
  31 use Amanda::Paths;
  32 use Amanda::Tests;
  33
  34 my $dev;
  35 my $dev_name;
  36 my ($vtape1, $vtape2);
  37 my ($input_filename, $output_filename) =
  38     ( "$AMANDA_TMPDIR/input.tmp", "$AMANDA_TMPDIR/output.tmp" );
  39 my $taperoot = "$AMANDA_TMPDIR/Amanda_Device_test_tapes";
  40 my $testconf;
  41 my $queue_fd;
  42
  43 # we'll need some vtapes..
  44 sub mkvtape {
  45     my ($num) = @_;
  46
  47     my $mytape = "$taperoot/$num";
  48     if (-d $mytape) { rmtree($mytape); }
  49     mkpath("$mytape/data");
  50     return $mytape;
  51 }
  52
  53
  54 # make up a fake dumpfile_t to write with
  55 my $dumpfile = Amanda::Types::dumpfile_t->new();
  56 $dumpfile->{type} = $Amanda::Types::F_DUMPFILE;
  57 $dumpfile->{datestamp} = "20070102030405";
  58 $dumpfile->{dumplevel} = 0;
  59 $dumpfile->{compressed} = 1;
  60 $dumpfile->{name} = "localhost";
  61 $dumpfile->{disk} = "/home";
  62 $dumpfile->{program} = "INSTALLCHECK";
  63
  64 # function to set up a queue_fd for a filename
  65 sub make_queue_fd {
  66     my ($filename, $mode) = @_;
  67
  68     open(my $fd, $mode, $filename) or die("Could not open $filename: $!");
  69     return $fd, Amanda::Device::queue_fd_t->new(fileno($fd));
  70 }
  71
  72 my $write_file_count = 5;
  73 sub write_file {
  74     my ($seed, $length, $filenum) = @_;
  75
  76     croak ("selected file size $length is *way* too big")
  77         unless ($length < 1024*1024*10);
  78     Amanda::Tests::write_random_file($seed, $length, $input_filename);
  79
  80     ok($dev->start_file($dumpfile),
  81         "start file $filenum")
  82         or diag($dev->error_or_status());
  83
  84     is($dev->file(), $filenum,
  85         "Device has correct filenum");
  86
  87     my ($input, $queue_fd) = make_queue_fd($input_filename, "<");
  88     ok($dev->write_from_fd($queue_fd),
  89         "write some data")
  90         or diag($dev->error_or_status());
  91     close($input) or die("Error closing $input_filename");
  92
  93     if(ok($dev->in_file(),
  94         "still in_file")) {
  95         ok($dev->finish_file(),
  96             "finish_file")
  97             or diag($dev->error_or_status());
  98     } else {
  99         pass("not in file, so not calling finish_file");
 100     }
 101 }
 102
 103 my $verify_file_count = 5;
 104 sub verify_file {
 105     my ($seed, $length, $filenum) = @_;
 106
 107     ok(my $read_dumpfile = $dev->seek_file($filenum),
 108         "seek to file $filenum")
 109         or diag($dev->error_or_status());
 110     is($dev->file(), $filenum,
 111         "device is really at file $filenum");
 112     is($read_dumpfile->{name}, "localhost",
 113         "header looks vaguely familiar")
 114         or diag($dev->error_or_status());
 115
 116     my ($output, $queue_fd) = make_queue_fd($output_filename, ">");
 117     ok($dev->read_to_fd($queue_fd),
 118         "read data from file $filenum")
 119         or diag($dev->error_or_status());
 120     close($output) or die("Error closing $output_filename");
 121
 122     ok(Amanda::Tests::verify_random_file($seed, $length, $output_filename, 0),
 123         "verified file contents");
 124 }
 125
 126 # properties test
 127
 128 my @common_properties = (
 129     'appendable',
 130     'block_size',
 131     'canonical_name',
 132     'concurrency',
 133     'max_block_size',
 134     'medium_access_type',
 135     'min_block_size',
 136     'partial_deletion',
 137     'streaming',
 138 );
 139
 140 sub properties_include {
 141     my ($got, $should_include, $msg) = @_;
 142     my %got = map { $_->{'name'}, 1 } @$got;
 143     my @missing = grep { !defined($got{$_}) } @$should_include;
 144     if (@missing) {
 145         fail($msg);
 146         diag(" Expected properties: " . join(", ", @$should_include));
 147         diag("      Got properties: " . join(", ", @$got));
 148         diag("  Missing properties: " . join(", ", @missing));
 149     } else {
 150         pass($msg);
 151     }
 152 }
 153
 154 ####
 155 ## get stuff set up
 156
 157 $testconf = Installcheck::Config->new();
 158 $testconf->write();
 159 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 160     or die("Could not load configuration");
 161
 162 # put the debug messages somewhere
 163 Amanda::Debug::dbopen("installcheck");
 164
 165 ####
 166 ## Test errors a little bit
 167
 168 $dev = Amanda::Device->new("foobar:");
 169 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 170     "creation of a bogus 'foobar:' device fails");
 171
 172 $dev = Amanda::Device->new("rait:{{");
 173 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 174     "creation of a bogus 'rait:{{' device fails");
 175
 176 $dev = Amanda::Device->new("rait:{a,b");
 177 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
 178     "creation of a bogus 'rait:{a,b' device fails");
 179
 180 ####
 181 ## first, test out the 'null' device.
 182
 183 $dev_name = "null:";
 184
 185 $dev = Amanda::Device->new($dev_name);
 186 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 187     "create null device")
 188     or diag $dev->error_or_status();
 189 ok($dev->start($ACCESS_WRITE, "NULL1", "19780615010203"),
 190     "start null device in write mode")
 191     or diag $dev->error_or_status();
 192
 193 # try properties
 194 properties_include([ $dev->property_list() ], [ @common_properties ],
 195     "necessary properties listed on null device");
 196 is($dev->property_get("canonical_name"), "null:",
 197     "property_get(canonical_name) on null device");
 198 is($dev->property_get("caNONical-name"), "null:",
 199     "property_get(caNONical-name) on null device (case, dash-insensitivity)");
 200 is_deeply([ $dev->property_get("canonical_name") ],
 201     [ "null:", $PROPERTY_SURETY_GOOD, $PROPERTY_SOURCE_DEFAULT ],
 202     "extended property_get returns correct surety/source");
 203 for my $prop ($dev->property_list()) {
 204     next unless $prop->{'name'} eq 'canonical_name';
 205     is($prop->{'description'},
 206         "The most reliable device name to use to refer to this device.",
 207         "property info for canonical name is correct");
 208 }
 209
 210 # and write a file to it
 211 write_file(0xabcde, 1024*256, 1);
 212
 213 # (don't finish the device, testing the finalize method's cleanup)
 214
 215 ####
 216 ## Now some full device tests
 217
 218 ## VFS device
 219
 220 $vtape1 = mkvtape(1);
 221 $dev_name = "file:$vtape1";
 222
 223 $dev = Amanda::Device->new($dev_name);
 224 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 225     "$dev_name: create successful")
 226     or diag($dev->error_or_status());
 227
 228 properties_include([ $dev->property_list() ],
 229     [ @common_properties, 'max_volume_usage' ],
 230     "necessary properties listed on vfs device");
 231
 232 $dev->read_label();
 233 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
 234     "initially unlabeled")
 235     or diag($dev->error_or_status());
 236
 237 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 238     "start in write mode")
 239     or diag($dev->error_or_status());
 240
 241 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 242     "not unlabeled anymore")
 243     or diag($dev->error_or_status());
 244
 245 for (my $i = 1; $i <= 3; $i++) {
 246     write_file(0x2FACE, $dev->block_size()*10+17, $i);
 247 }
 248
 249 ok($dev->finish(),
 250     "finish device after write")
 251     or diag($dev->error_or_status());
 252
 253 $dev->read_label();
 254 ok(!($dev->status()),
 255     "no error, at all, from read_label")
 256     or diag($dev->error_or_status());
 257
 258 # append one more copy, to test ACCESS_APPEND
 259
 260 ok($dev->start($ACCESS_APPEND, undef, undef),
 261     "start in append mode")
 262     or diag($dev->error_or_status());
 263
 264 write_file(0xD0ED0E, $dev->block_size()*4, 4);
 265
 266 ok($dev->finish(),
 267     "finish device after append")
 268     or diag($dev->error_or_status());
 269
 270 # try reading the third file back, creating a new device
 271 # object first, and skipping the read-label step.
 272
 273 $dev = undef;
 274 $dev = Amanda::Device->new($dev_name);
 275 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 276     "$dev_name: re-create successful")
 277     or diag($dev->error_or_status());
 278
 279 ok($dev->start($ACCESS_READ, undef, undef),
 280     "start in read mode")
 281     or diag($dev->error_or_status());
 282
 283 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 284
 285 ok($dev->finish(),
 286     "finish device after read")
 287     or diag($dev->error_or_status());
 288
 289 ####
 290 ## Test a RAIT device of two vfs devices.
 291
 292 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 293 $dev_name = "rait:file:{$vtape1,$vtape2}";
 294
 295 $dev = Amanda::Device->new($dev_name);
 296 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 297    "$dev_name: create successful")
 298     or diag($dev->error_or_status());
 299
 300 ok($dev->configure(1), "configure device");
 301
 302 properties_include([ $dev->property_list() ], [ @common_properties ],
 303     "necessary properties listed on rait device");
 304
 305 is($dev->property_get("block_size"), 32768, # (RAIT default)
 306     "rait device calculates a default block size correctly");
 307
 308 ok($dev->property_set("block_size", 32768*16),
 309     "rait device accepts an explicit block size");
 310
 311 is($dev->property_get("block_size"), 32768*16,
 312     "..and remembers it");
 313
 314 $dev->read_label();
 315 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
 316    "initially unlabeled")
 317     or diag($dev->error_or_status());
 318
 319 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 320    "start in write mode")
 321     or diag($dev->error_or_status());
 322
 323 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 324    "not unlabeled anymore")
 325     or diag($dev->error_or_status());
 326
 327 for (my $i = 1; $i <= 3; $i++) {
 328     write_file(0x2FACE, $dev->block_size()*10+17, $i);
 329 }
 330
 331 ok($dev->finish(),
 332    "finish device after write")
 333     or diag($dev->error_or_status());
 334
 335 $dev->read_label();
 336 ok(!($dev->status()),
 337    "no error, at all, from read_label")
 338     or diag($dev->error_or_status());
 339
 340 # append one more copy, to test ACCESS_APPEND
 341
 342 ok($dev->start($ACCESS_APPEND, undef, undef),
 343    "start in append mode")
 344     or diag($dev->error_or_status());
 345
 346 write_file(0xD0ED0E, $dev->block_size()*4, 4);
 347
 348 ok($dev->finish(),
 349    "finish device after append")
 350     or diag($dev->error_or_status());
 351
 352 # try reading the third file back, creating a new device
 353 # object first, and skipping the read-label step.
 354
 355 $dev = undef;
 356 $dev = Amanda::Device->new($dev_name);
 357 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 358     "$dev_name: re-create successful")
 359     or diag($dev->error_or_status());
 360
 361 ok($dev->start($ACCESS_READ, undef, undef),
 362    "start in read mode")
 363     or diag($dev->error_or_status());
 364
 365 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 366
 367 ok($dev->finish(),
 368    "finish device after read")
 369     or diag($dev->error_or_status());
 370
 371 ok($dev->start($ACCESS_READ, undef, undef),
 372    "start in read mode after missing volume")
 373     or diag($dev->error_or_status());
 374
 375 # corrupt the device somehow and hope it keeps working
 376 rmtree("$taperoot/1");
 377
 378 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 379 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
 380 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
 381
 382 ok($dev->finish(),
 383    "finish device read after missing volume")
 384     or diag($dev->error_or_status());
 385
 386 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 387    "start in write mode fails with missing volume")
 388     or diag($dev->error_or_status());
 389
 390 undef $dev;
 391
 392 $dev_name = "rait:{MISSING,file:$vtape2}";
 393 $dev = Amanda::Device->new($dev_name);
 394
 395 ok($dev->start($ACCESS_READ, undef, undef),
 396    "start in read mode with MISSING")
 397     or diag($dev->error_or_status());
 398
 399 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 400 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
 401 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
 402
 403 ok($dev->finish(),
 404    "finish device read with MISSING")
 405     or diag($dev->error_or_status());
 406
 407 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
 408    "start in write mode fails with MISSING")
 409     or diag($dev->error_or_status());
 410
 411 undef $dev;
 412
 413 # Make two devices with different labels, should get a
 414 # message accordingly.
 415 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 416
 417 my $n = 13;
 418 for $dev_name ("file:$vtape1", "file:$vtape2") {
 419     my $dev = Amanda::Device->new($dev_name);
 420     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 421        "$dev_name: Open successful")
 422         or diag($dev->error_or_status());
 423     ok($dev->start($ACCESS_WRITE, "TESTCONF$n", undef),
 424         "wrote label 'TESTCONF$n'");
 425     ok($dev->finish(), "finished device");
 426     $n++;
 427 }
 428
 429 $dev_name = "rait:{file:$vtape1,file:$vtape2}";
 430 $dev = Amanda::Device->new($dev_name);
 431 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 432    "$dev_name: Open successful")
 433     or diag($dev->error_or_status());
 434
 435 $dev->read_label();
 436 ok($dev->status() & $DEVICE_STATUS_VOLUME_ERROR,
 437    "Label mismatch error handled correctly")
 438     or diag($dev->error_or_status());
 439
 440 # Use some config to set a block size on a child device
 441 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
 442 $dev_name = "rait:{file:$vtape1,mytape2}";
 443
 444 $testconf = Installcheck::Config->new();
 445 $testconf->add_device("mytape2", [
 446     "tapedev" => "\"file:$vtape2\"",
 447     "device_property" => "\"BLOCK_SIZE\" \"64k\""
 448 ]);
 449 $testconf->write();
 450 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
 451     or die("Could not load configuration");
 452
 453 $dev = Amanda::Device->new($dev_name);
 454 is($dev->status(), $DEVICE_STATUS_SUCCESS,
 455    "$dev_name: create successful")
 456     or diag($dev->error_or_status());
 457
 458 ok($dev->configure(1), "configure device");
 459
 460 is($dev->property_get("block_size"), 65536,
 461     "rait device calculates a block size from its children correctly");
 462
 463 # Test an S3 device if the proper environment variables are set
 464 my $S3_SECRET_KEY = $ENV{'INSTALLCHECK_S3_SECRET_KEY'};
 465 my $S3_ACCESS_KEY = $ENV{'INSTALLCHECK_S3_ACCESS_KEY'};
 466 my $DEVPAY_SECRET_KEY = $ENV{'INSTALLCHECK_DEVPAY_SECRET_KEY'};
 467 my $DEVPAY_ACCESS_KEY = $ENV{'INSTALLCHECK_DEVPAY_ACCESS_KEY'};
 468 my $DEVPAY_USER_TOKEN = $ENV{'INSTALLCHECK_DEVPAY_USER_TOKEN'};
 469
 470 my $run_s3_tests = defined $S3_SECRET_KEY && defined $S3_ACCESS_KEY;
 471 my $run_devpay_tests = defined $DEVPAY_SECRET_KEY &&
 472     defined $DEVPAY_ACCESS_KEY && $DEVPAY_USER_TOKEN;
 473
 474 my $dev_base_name;
 475 my $hostname  = hostname();
 476
 477 my $s3_make_device_count = 6;
 478 sub s3_make_device($) {
 479     my $dev_name = shift @_;
 480     $dev = Amanda::Device->new($dev_name);
 481     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 482        "$dev_name: create successful")
 483         or diag($dev->error_or_status());
 484
 485     my @s3_props = ( 's3_access_key', 's3_secret_key' );
 486     push @s3_props, 's3_user_token' if ($dev_name =~ /^s3zmanda:/);
 487     properties_include([ $dev->property_list() ], [ @common_properties, @s3_props ],
 488         "necessary properties listed on s3 device");
 489
 490     ok($dev->property_set('BLOCK_SIZE', 32768*2),
 491         "set block size")
 492         or diag($dev->error_or_status());
 493
 494     if ($dev_name =~ /^s3:/) {
 495         # use regular S3 credentials
 496         ok($dev->property_set('S3_ACCESS_KEY', $S3_ACCESS_KEY),
 497            "set S3 access key")
 498         or diag($dev->error_or_status());
 499
 500         ok($dev->property_set('S3_SECRET_KEY', $S3_SECRET_KEY),
 501            "set S3 secret key")
 502             or diag($dev->error_or_status());
 503
 504         pass("(placeholder)");
 505     } elsif ($dev_name =~ /^s3zmanda:/) {
 506         # use s3zmanda credentials
 507         ok($dev->property_set('S3_ACCESS_KEY', $DEVPAY_ACCESS_KEY),
 508            "set s3zmanda access key")
 509         or diag($dev->error_or_status());
 510
 511         ok($dev->property_set('S3_SECRET_KEY', $DEVPAY_SECRET_KEY),
 512            "set s3zmanda secret key")
 513             or diag($dev->error_or_status());
 514
 515         ok($dev->property_set('S3_USER_TOKEN', $DEVPAY_USER_TOKEN),
 516            "set s3zmanda user token")
 517             or diag($dev->error_or_status());
 518     } else {
 519         croak("didn't recognize the device scheme, so no credentials were set");
 520     }
 521     return $dev;
 522 }
 523
 524 my $s3_run_main_tests_count = 12
 525         + 4 * $write_file_count
 526         + 1 * $verify_file_count
 527         + 3 * $s3_make_device_count;
 528 sub s3_run_main_tests($$) {
 529     my ($dev_scheme, $base_name) = @_;
 530     $dev_name = "$dev_scheme:$base_name-$dev_scheme";
 531     $dev = s3_make_device($dev_name);
 532     $dev->read_label();
 533     my $status = $dev->status();
 534     # this test appears very liberal, but catches the case where setup_handle fails without
 535     # giving false positives
 536     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 537        "status is either OK or possibly unlabeled")
 538         or diag($dev->error_or_status());
 539
 540     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 541        "start in write mode")
 542         or diag($dev->error_or_status());
 543
 544     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 545        "it's labeled now")
 546         or diag($dev->error_or_status());
 547
 548     for (my $i = 1; $i <= 3; $i++) {
 549         write_file(0x2FACE, $dev->block_size()*10, $i);
 550     }
 551
 552     ok($dev->finish(),
 553        "finish device after write")
 554         or diag($dev->error_or_status());
 555
 556     $dev->read_label();
 557     ok(!($dev->status()),
 558        "no error, at all, from read_label")
 559         or diag($dev->error_or_status());
 560
 561     # append one more copy, to test ACCESS_APPEND
 562
 563     ok($dev->start($ACCESS_APPEND, undef, undef),
 564        "start in append mode")
 565         or diag($dev->error_or_status());
 566
 567     write_file(0xD0ED0E, $dev->block_size()*10, 4);
 568
 569     ok($dev->finish(),
 570        "finish device after append")
 571         or diag($dev->error_or_status());
 572
 573     # try reading the third file back
 574
 575     ok($dev->start($ACCESS_READ, undef, undef),
 576        "start in read mode")
 577         or diag($dev->error_or_status());
 578
 579     verify_file(0x2FACE, $dev->block_size()*10, 3);
 580
 581     ok($dev->finish(),
 582        "finish device after read")
 583         or diag($dev->error_or_status());    # (note: we don't use write_max_size here, as the maximum for S3 is very large)
 584
 585     # try a constrained bucket
 586     $dev_name = lc("$dev_scheme:$base_name-$dev_scheme-eu");
 587     $dev = s3_make_device($dev_name);
 588     ok($dev->property_set('S3_BUCKET_LOCATION', 'EU'),
 589        "set S3 bucket location")
 590         or diag($dev->error_or_status());
 591
 592     $dev->read_label();
 593     $status = $dev->status();
 594     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 595        "status is either OK or possibly unlabeled")
 596         or diag($dev->error_or_status());
 597
 598     # bucket name incompatible with location constraint
 599     $dev_name = "$dev_scheme:-$base_name-$dev_scheme-eu";
 600     $dev = s3_make_device($dev_name);
 601
 602     ok(!$dev->property_set('S3_BUCKET_LOCATION', 'EU'),
 603        "should not be able to set S3 bucket location with an incompatible name")
 604         or diag($dev->error_or_status());
 605 }
 606
 607 SKIP: {
 608     skip "define \$INSTALLCHECK_S3_{SECRET,ACCESS}_KEY to run S3 tests",
 609                     1 + $s3_run_main_tests_count + $s3_make_device_count
 610         unless $run_s3_tests;
 611
 612     # XXX for best results, the bucket should already exist (Amazon doesn't create
 613     # buckets quickly enough to pass subsequent tests), but should be empty (so that
 614     # the device appears unlabeled)
 615     $dev_base_name = "$S3_ACCESS_KEY-installcheck-$hostname";
 616
 617     s3_run_main_tests('s3', $dev_base_name);
 618
 619     # can't set user token without devpay
 620     $dev_name = "s3:$dev_base_name";
 621     $dev = s3_make_device($dev_name);
 622     ok(!$dev->property_set('S3_USER_TOKEN', '123'),
 623        "set user token, but that shouldn't be possible (not using DevPay)")
 624         or diag($dev->error_or_status());
 625
 626 }
 627
 628 SKIP: {
 629     # in this case, most of our code has already been exercised
 630     # just make sure that authentication works as a basic sanity check
 631     skip "skipping abbreviated s3zmanda tests", $s3_make_device_count + 1
 632         unless ($run_s3_tests and $run_devpay_tests);
 633     $dev_name = "s3zmanda:$dev_base_name";
 634     $dev = s3_make_device($dev_name);
 635     $dev->read_label();
 636     my $status = $dev->status();
 637     # this test appears very liberal, but catches the case where setup_handle fails without
 638     # giving false positives
 639     ok(($status == 0) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 640        "status is either OK or possibly unlabeled")
 641         or diag($dev->error_or_status());
 642 }
 643
 644 SKIP: {
 645     # if we're running devpay tests and not S3 tests, then we do the whole suite with devpay
 646     skip "define \$INSTALLCHECK_DEVPAY_{SECRET_KEY,ACCESS_KEY,USER_TOKEN} to run full s3zmanda tests", $s3_run_main_tests_count
 647         unless (!$run_s3_tests and $run_devpay_tests);
 648     s3_run_main_tests('s3zmanda', $dev_base_name);
 649 }
 650
 651 # Test a tape device if the proper environment variables are set
 652 my $TAPE_DEVICE = $ENV{'INSTALLCHECK_TAPE_DEVICE'};
 653 my $run_tape_tests = defined $TAPE_DEVICE;
 654 SKIP: {
 655     skip "define \$INSTALLCHECK_TAPE_DEVICE to run tape tests", 37
 656         unless $run_tape_tests;
 657
 658     $dev_name = "tape:$TAPE_DEVICE";
 659     $dev = Amanda::Device->new($dev_name);
 660     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 661         "$dev_name: create successful")
 662         or diag($dev->error_or_status());
 663
 664     my $status = $dev->read_label();
 665     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
 666        "status is either OK or possibly unlabeled")
 667         or diag($dev->error_or_status());
 668
 669     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
 670         "start in write mode")
 671         or diag($dev->error_or_status());
 672
 673     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
 674         "not unlabeled anymore")
 675         or diag($dev->error_or_status());
 676
 677     for (my $i = 1; $i <= 3; $i++) {
 678         write_file(0x2FACE, $dev->block_size()*10+17, $i);
 679     }
 680
 681     ok($dev->finish(),
 682         "finish device after write")
 683         or diag($dev->error_or_status());
 684
 685     $dev->read_label();
 686     ok(!($dev->status()),
 687         "no error, at all, from read_label")
 688         or diag($dev->error_or_status());
 689
 690     is($dev->volume_label(), "TESTCONF13",
 691         "read_label reads the correct label")
 692         or diag($dev->error_or_status());
 693
 694     # append one more copy, to test ACCESS_APPEND
 695
 696     SKIP: {
 697         skip "APPEND not supported", $write_file_count + 2
 698             unless $dev->property_get("APPENDABLE");
 699         ok($dev->start($ACCESS_APPEND, undef, undef),
 700             "start in append mode")
 701             or diag($dev->error_or_status());
 702
 703         write_file(0xD0ED0E, $dev->block_size()*4, 4);
 704
 705         ok($dev->finish(),
 706             "finish device after append")
 707             or diag($dev->error_or_status());
 708     }
 709
 710     # try reading the third file back, creating a new device
 711     # object first, and skipping the read-label step.
 712
 713     $dev = undef;
 714     $dev = Amanda::Device->new($dev_name);
 715     is($dev->status(), $DEVICE_STATUS_SUCCESS,
 716         "$dev_name: re-create successful")
 717         or diag($dev->error_or_status());
 718
 719     ok($dev->start($ACCESS_READ, undef, undef),
 720         "start in read mode")
 721         or diag($dev->error_or_status());
 722
 723     verify_file(0x2FACE, $dev->block_size()*10+17, 3);
 724
 725     ok($dev->finish(),
 726         "finish device after read")
 727         or diag($dev->error_or_status());
 728
 729 }
 730
 731 unlink($input_filename);
 732 unlink($output_filename);
 733 rmtree($taperoot);