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

   1 # Copyright (c) 2009-2012 Zmanda Inc.  All Rights Reserved.
   2 #
   3 # This program is free software; you can redistribute it and/or
   4 # modify it under the terms of the GNU General Public License
   5 # as published by the Free Software Foundation; either version 2
   6 # of the License, or (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful, but
   9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  10 # or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  11 # for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License along
  14 # with this program; if not, write to the Free Software Foundation, Inc.,
  15 # 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA
  16 #
  17 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
  18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  19
  20 use Test::More tests => 171;
  21 use File::Path;
  22 use Data::Dumper;
  23 use strict;
  24 use warnings;
  25
  26 use lib "@amperldir@";
  27 use Installcheck;
  28 use Installcheck::Config;
  29 use Installcheck::Changer;
  30 use Installcheck::Mock qw( setup_mock_mtx $mock_mtx_path );
  31 use Amanda::Device qw( :constants );
  32 use Amanda::Debug;
  33 use Amanda::Paths;
  34 use Amanda::MainLoop;
  35 use Amanda::Config qw( :init :getconf config_dir_relative );
  36 use Amanda::Changer;
  37
  38 # set up debugging so debug output doesn't interfere with test results
  39 Amanda::Debug::dbopen("installcheck");
  40
  41 my $ndmp = Installcheck::Mock::NdmpServer->new();
  42
  43 # and disable Debug's die() and warn() overrides
  44 Amanda::Debug::disable_die_override();
  45
  46 my $chg_state_file = "$Installcheck::TMP/chg-ndmp-state";
  47 unlink($chg_state_file) if -f $chg_state_file;
  48
  49 sub check_inventory {
  50     my ($chg, $barcodes, $next_step, $expected, $msg) = @_;
  51
  52     $chg->inventory(inventory_cb => make_cb(sub {
  53         my ($err, $inv) = @_;
  54         die $err if $err;
  55
  56         # strip barcodes from both $expected and $inv
  57         if (!$barcodes) {
  58             for (@$expected, @$inv) {
  59                 delete $_->{'barcode'};
  60             }
  61         }
  62
  63         is_deeply($inv, $expected, $msg)
  64             or diag("Got:\n" . Dumper($inv));
  65
  66         $next_step->();
  67     }));
  68 }
  69
  70 ##
  71 # test the "interface" package
  72
  73 sub test_interface {
  74     my ($finished_cb) = @_;
  75     my ($interface, $chg);
  76
  77     my $steps = define_steps
  78         cb_ref => \$finished_cb,
  79         finalize => sub { $chg->quit() if defined $chg};
  80
  81     step start => sub {
  82         my $testconf = Installcheck::Config->new();
  83         $testconf->add_changer('robo', [
  84             tpchanger => "\"chg-ndmp:127.0.0.1:$ndmp->{port}\@$ndmp->{changer}\"",
  85             changerfile => "\"$chg_state_file\"",
  86
  87             property => "       \"tape-device\" \"0=ndmp:127.0.0.1:$ndmp->{port}\@$ndmp->{drive0}\"",
  88             property => "append \"tape-device\" \"1=ndmp:127.0.0.1:$ndmp->{port}\@$ndmp->{drive1}\"",
  89         ]);
  90         $testconf->write();
  91
  92         my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
  93         if ($cfg_result != $CFGERR_OK) {
  94             my ($level, @errors) = Amanda::Config::config_errors();
  95             die(join "\n", @errors);
  96         }
  97
  98         $chg = Amanda::Changer->new("robo");
  99         die "$chg" if $chg->isa("Amanda::Changer::Error");
 100         is($chg->have_inventory(), '1', "changer have inventory");
 101
 102         $interface = $chg->{'interface'};
 103         $interface->inquiry($steps->{'inquiry_cb'});
 104     };
 105
 106     step inquiry_cb => sub {
 107         my ($error, $info) = @_;
 108
 109         die $error if $error;
 110
 111         is_deeply($info, {
 112             'revision' => '1.0',
 113             'product id' => 'FakeRobot',
 114             'vendor id' => 'NDMJOB',
 115             'product type' => 'Medium Changer'
 116             }, "robot::Interface inquiry() info is correct");
 117
 118         $steps->{'status1'}->();
 119     };
 120
 121     step status1 => sub {
 122         $interface->status(sub {
 123             my ($error, $status) = @_;
 124
 125             die $error if $error;
 126
 127             is_deeply($status, {
 128                 'drives' => {
 129                     '0' => undef,
 130                     '1' => undef,
 131                 },
 132                 'slots' => {
 133                     1 => { ie => 1, empty => 1 },
 134                     2 => { ie => 1, empty => 1 },
 135                     3 => { barcode => 'PTAG00XX', },
 136                     4 => { barcode => 'PTAG01XX', },
 137                     5 => { barcode => 'PTAG02XX', },
 138                     6 => { barcode => 'PTAG03XX', },
 139                     7 => { barcode => 'PTAG04XX', },
 140                     8 => { barcode => 'PTAG05XX', },
 141                     9 => { barcode => 'PTAG06XX', },
 142                     10 => { barcode => 'PTAG07XX', },
 143                     11 => { barcode => 'PTAG08XX', },
 144                     12 => { barcode => 'PTAG09XX', },
 145                 },
 146             }, "robot::Interface status() output is correct (no drives loaded)")
 147                 or die("robot does not look like I expect it to");
 148
 149             $steps->{'load0'}->();
 150         });
 151     };
 152
 153     step load0 => sub {
 154         $interface->load(3, 0, sub {
 155             my ($error) = @_;
 156
 157             die $error if $error;
 158
 159             pass("load");
 160             $steps->{'status2'}->();
 161         });
 162     };
 163
 164     step status2 => sub {
 165         $interface->status(sub {
 166             my ($error, $status) = @_;
 167
 168             die $error if $error;
 169
 170             is_deeply($status, {
 171                 'drives' => {
 172                     '0' => { barcode => 'PTAG00XX', orig_slot => 3 },
 173                     '1' => undef,
 174                 },
 175                 'slots' => {
 176                     1 => { ie => 1, empty => 1 },
 177                     2 => { ie => 1, empty => 1 },
 178                     3 => { empty => 1 },
 179                     4 => { barcode => 'PTAG01XX', },
 180                     5 => { barcode => 'PTAG02XX', },
 181                     6 => { barcode => 'PTAG03XX', },
 182                     7 => { barcode => 'PTAG04XX', },
 183                     8 => { barcode => 'PTAG05XX', },
 184                     9 => { barcode => 'PTAG06XX', },
 185                     10 => { barcode => 'PTAG07XX', },
 186                     11 => { barcode => 'PTAG08XX', },
 187                     12 => { barcode => 'PTAG09XX', },
 188                 },
 189             }, "robot::Interface status() output is correct (one drive loaded)")
 190                 or die("robot does not look like I expect it to");
 191
 192             $steps->{'load1'}->();
 193         });
 194     };
 195
 196     step load1 => sub {
 197         $interface->load(12, 1, sub {
 198             my ($error) = @_;
 199
 200             die $error if $error;
 201
 202             pass("load");
 203             $steps->{'status3'}->();
 204         });
 205     };
 206
 207     step status3 => sub {
 208         $interface->status(sub {
 209             my ($error, $status) = @_;
 210
 211             die $error if $error;
 212
 213             is_deeply($status, {
 214                 'drives' => {
 215                     '0' => { barcode => 'PTAG00XX', orig_slot => 3 },
 216                     '1' => { barcode => 'PTAG09XX', orig_slot => 12 },
 217                 },
 218                 'slots' => {
 219                     1 => { ie => 1, empty => 1 },
 220                     2 => { ie => 1, empty => 1 },
 221                     3 => { empty => 1 },
 222                     4 => { barcode => 'PTAG01XX', },
 223                     5 => { barcode => 'PTAG02XX', },
 224                     6 => { barcode => 'PTAG03XX', },
 225                     7 => { barcode => 'PTAG04XX', },
 226                     8 => { barcode => 'PTAG05XX', },
 227                     9 => { barcode => 'PTAG06XX', },
 228                     10 => { barcode => 'PTAG07XX', },
 229                     11 => { barcode => 'PTAG08XX', },
 230                     12 => { empty => 1 },
 231                 },
 232             }, "robot::Interface status() output is correct (two drives loaded)")
 233                 or die("robot does not look like I expect it to");
 234
 235             $steps->{'transfer'}->();
 236         });
 237     };
 238
 239     step transfer => sub {
 240         $interface->transfer(5, 2, sub {
 241             my ($error) = @_;
 242
 243             die $error if $error;
 244
 245             pass("transfer");
 246             $steps->{'status4'}->();
 247         });
 248     };
 249
 250     step status4 => sub {
 251         $interface->status(sub {
 252             my ($error, $status) = @_;
 253
 254             die $error if $error;
 255
 256             is_deeply($status, {
 257                 'drives' => {
 258                     '0' => { barcode => 'PTAG00XX', orig_slot => 3 },
 259                     '1' => { barcode => 'PTAG09XX', orig_slot => 12 },
 260                 },
 261                 'slots' => {
 262                     1 => { ie => 1, empty => 1 },
 263                     2 => { ie => 1, barcode => 'PTAG02XX', },
 264                     3 => { empty => 1 },
 265                     4 => { barcode => 'PTAG01XX', },
 266                     5 => { empty => 1 },
 267                     6 => { barcode => 'PTAG03XX', },
 268                     7 => { barcode => 'PTAG04XX', },
 269                     8 => { barcode => 'PTAG05XX', },
 270                     9 => { barcode => 'PTAG06XX', },
 271                     10 => { barcode => 'PTAG07XX', },
 272                     11 => { barcode => 'PTAG08XX', },
 273                     12 => { empty => 1 },
 274                 },
 275             }, "robot::Interface status() output is correct after transfer")
 276                 or die("robot does not look like I expect it to");
 277
 278             $finished_cb->();
 279         });
 280     };
 281 }
 282 test_interface(\&Amanda::MainLoop::quit);
 283 Amanda::MainLoop::run();
 284
 285 ##
 286 # Test the real deal
 287
 288 sub test_changer {
 289     my ($mtx_config, $finished_cb) = @_;
 290     my $chg;
 291     my ($res1, $res2);
 292     my ($drive0_name, $drive1_name);
 293     my $pfx = "BC=$mtx_config->{barcodes}; TORIG=$mtx_config->{track_orig}";
 294
 295     my $steps = define_steps
 296         cb_ref => \$finished_cb,
 297         finalize => sub { $chg->quit() if defined $chg};
 298
 299     # clean up
 300     step setup => sub {
 301         unlink($chg_state_file) if -f $chg_state_file;
 302
 303         my @ignore_barcodes = ( property => "\"ignore-barcodes\" \"y\"")
 304             if ($mtx_config->{'barcodes'} == -1);
 305
 306         $drive0_name = "ndmp:127.0.0.1:$ndmp->{port}\@$ndmp->{drive0}";
 307         $drive1_name = "ndmp:127.0.0.1:$ndmp->{port}\@$ndmp->{drive1}";
 308
 309         my $testconf = Installcheck::Config->new();
 310         $testconf->add_changer('robo', [
 311             tpchanger => "\"chg-ndmp:127.0.0.1:$ndmp->{port}\@$ndmp->{changer}\"",
 312             changerfile => "\"$chg_state_file\"",
 313
 314             property => "       \"tape-device\" \"0=$drive0_name\"",
 315             property => "append \"tape-device\" \"1=$drive1_name\"",
 316             property => "\"use-slots\" \"1-5\"",
 317             property => "\"verbose\" \"1\"",
 318             @ignore_barcodes,
 319         ]);
 320         $testconf->write();
 321
 322         config_uninit();
 323         my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
 324         if ($cfg_result != $CFGERR_OK) {
 325             my ($level, @errors) = Amanda::Config::config_errors();
 326             die(join "\n", @errors);
 327         }
 328
 329         # reset the changer to its base state
 330         $ndmp->reset();
 331
 332         $steps->{'start'}->();
 333     };
 334
 335     step start => sub {
 336         $chg = Amanda::Changer->new("robo");
 337         ok(!$chg->isa("Amanda::Changer::Error"),
 338             "$pfx: Create working chg-robot instance: $chg")
 339             or die("no sense going on");
 340
 341         is($chg->have_inventory(), '1', "changer have inventory");
 342         $chg->info(info => [qw(vendor_string num_slots fast_search)],
 343                     info_cb => $steps->{'info_cb'});
 344     };
 345
 346     step info_cb => sub {
 347         my ($err, %info) = @_;
 348         die $err if $err;
 349
 350         is_deeply({ %info }, {
 351             num_slots => 5,
 352             fast_search => 1,
 353             vendor_string => "NDMJOB FakeRobot",
 354         }, "$pfx: info keys num_slots, fast_search, vendor_string are correct");
 355
 356         $steps->{'inventory1'}->();
 357     };
 358
 359     step inventory1 => sub {
 360         check_inventory($chg, $mtx_config->{'barcodes'} > 0, $steps->{'load_slot_1'}, [
 361             { slot => 1, state => Amanda::Changer::SLOT_EMPTY,
 362               import_export => 1,
 363               device_status => undef, device_error => undef,
 364               f_type => undef, label => undef },
 365             { slot => 2, state => Amanda::Changer::SLOT_EMPTY,
 366               import_export => 1,
 367               device_status => undef, device_error => undef,
 368               f_type => undef, label => undef },
 369             { slot => 3, state => Amanda::Changer::SLOT_FULL,
 370               barcode => 'PTAG00XX', current => 1,
 371               device_status => undef, device_error => undef,
 372               f_type => undef, label => undef },
 373             { slot => 4, state => Amanda::Changer::SLOT_FULL,
 374               barcode => 'PTAG01XX',
 375               device_status => undef, device_error => undef,
 376               f_type => undef, label => undef },
 377             { slot => 5, state => Amanda::Changer::SLOT_FULL,
 378               barcode => 'PTAG02XX',
 379               device_status => undef, device_error => undef,
 380               f_type => undef, label => undef },
 381         ], "$pfx: inventory is correct on start-up");
 382     };
 383
 384     step load_slot_1 => sub {
 385         $chg->load(slot => 3, res_cb => $steps->{'loaded_slot_1'});
 386     };
 387
 388     step loaded_slot_1 => sub {
 389         (my $err, $res1) = @_;
 390         die $err if $err;
 391
 392         is($res1->{'device'}->device_name, $drive0_name,
 393             "$pfx: first load returns drive-0 device");
 394
 395         is_deeply({
 396                 loaded_in => $chg->{'__last_state'}->{'slots'}->{3}->{'loaded_in'},
 397                 orig_slot => $chg->{'__last_state'}->{'drives'}->{0}->{'orig_slot'},
 398             }, {
 399                 loaded_in => 0,
 400                 orig_slot => 3,
 401             }, "$pfx: slot 3 'loaded_in' and drive 0 'orig_slot' are correct");
 402
 403         $steps->{'load_slot_2'}->();
 404     };
 405
 406     step load_slot_2 => sub {
 407         $chg->load(slot => 4, res_cb => $steps->{'loaded_slot_2'});
 408     };
 409
 410     step loaded_slot_2 => sub {
 411         (my $err, $res2) = @_;
 412         die $err if $err;
 413
 414         is($res2->{'device'}->device_name, $drive1_name,
 415             "$pfx: second load returns drive-1 device");
 416
 417         is_deeply({
 418                 loaded_in => $chg->{'__last_state'}->{'slots'}->{3}->{'loaded_in'},
 419                 orig_slot => $chg->{'__last_state'}->{'drives'}->{0}->{'orig_slot'},
 420             }, {
 421                 loaded_in => 0,
 422                 orig_slot => 3,
 423             }, "$pfx: slot 3 'loaded_in' and drive 0 'orig_slot' are still correct");
 424
 425         is_deeply({
 426                 loaded_in => $chg->{'__last_state'}->{'slots'}->{4}->{'loaded_in'},
 427                 orig_slot => $chg->{'__last_state'}->{'drives'}->{1}->{'orig_slot'},
 428             }, {
 429                 loaded_in => 1,
 430                 orig_slot => 4,
 431             }, "$pfx: slot 4 'loaded_in' and drive 1 'orig_slot' are correct");
 432
 433         $steps->{'check_loads'}->();
 434     };
 435
 436     step check_loads => sub {
 437         # peek into the interface to check that things are loaded correctly
 438         $chg->{'interface'}->status(sub {
 439             my ($error, $status) = @_;
 440
 441             die $error if $error;
 442
 443             # only perform these checks when barcodes are enabled
 444             if ($mtx_config->{'barcodes'} > 0) {
 445                 is_deeply($status->{'drives'}, {
 446                     0 => { barcode => 'PTAG00XX', 'orig_slot' => 3 },
 447                     1 => { barcode => 'PTAG01XX', 'orig_slot' => 4 },
 448                 }, "$pfx: double-check: loading drives with the changer gets the right drives loaded");
 449             }
 450
 451             $steps->{'inventory2'}->();
 452         });
 453     };
 454
 455     step inventory2 => sub {
 456         check_inventory($chg, $mtx_config->{'barcodes'} > 0, $steps->{'load_slot_3'}, [
 457             { slot => 1, state => Amanda::Changer::SLOT_EMPTY,
 458               import_export => 1,
 459               device_status => undef, device_error => undef,
 460               f_type => undef, label => undef },
 461             { slot => 2, state => Amanda::Changer::SLOT_EMPTY,
 462               import_export => 1,
 463               device_status => undef, device_error => undef,
 464               f_type => undef, label => undef },
 465             { slot => 3, state => Amanda::Changer::SLOT_FULL,
 466               barcode => 'PTAG00XX', reserved => 1, loaded_in => 0,
 467               current => 1,
 468               device_status => $DEVICE_STATUS_VOLUME_UNLABELED,
 469               device_error => 'no tape label found',
 470               f_type => $Amanda::Header::F_EMPTY, label => undef },
 471             { slot => 4, state => Amanda::Changer::SLOT_FULL,
 472               barcode => 'PTAG01XX', reserved => 1, loaded_in => 1,
 473               device_status => $DEVICE_STATUS_VOLUME_UNLABELED,
 474               device_error => 'no tape label found',
 475               f_type => $Amanda::Header::F_EMPTY, label => undef },
 476             { slot => 5, state => Amanda::Changer::SLOT_FULL,
 477               barcode => 'PTAG02XX',
 478               device_status => undef, device_error => undef,
 479               f_type => undef, label => undef },
 480         ], "$pfx: inventory is updated when slots are loaded");
 481     };
 482
 483     step load_slot_3 => sub {
 484         $chg->load(slot => 5, res_cb => $steps->{'loaded_slot_3'});
 485     };
 486
 487     step loaded_slot_3 => sub {
 488         my ($err, $no_res) = @_;
 489
 490         chg_err_like($err,
 491             { message => "no drives available",
 492               reason => 'driveinuse',
 493               type => 'failed' },
 494             "$pfx: trying to load a third slot fails with 'no drives available'");
 495
 496         $steps->{'label_tape_1'}->();
 497     };
 498
 499     step label_tape_1 => sub {
 500         $res1->{'device'}->start($Amanda::Device::ACCESS_WRITE, "TAPE-1", undef);
 501         $res1->{'device'}->finish();
 502
 503         $res1->set_label(label => "TAPE-1", finished_cb => $steps->{'label_tape_2'});
 504     };
 505
 506     step label_tape_2 => sub {
 507         my ($err) = @_;
 508         die $err if $err;
 509
 510         pass("$pfx: labeled TAPE-1 in drive 0");
 511
 512         is_deeply({
 513                 loaded_in => $chg->{'__last_state'}->{'slots'}->{3}->{'loaded_in'},
 514                 orig_slot => $chg->{'__last_state'}->{'drives'}->{0}->{'orig_slot'},
 515                 slot_label => $chg->{'__last_state'}->{'slots'}->{3}->{'label'},
 516                 drive_label => $chg->{'__last_state'}->{'drives'}->{0}->{'label'},
 517             }, {
 518                 loaded_in => 0,
 519                 orig_slot => 3,
 520                 slot_label => 'TAPE-1',
 521                 drive_label => 'TAPE-1',
 522             }, "$pfx: label is correctly reflected in changer state");
 523
 524         is_deeply({
 525                 slot_2_loaded_in => $chg->{'__last_state'}->{'slots'}->{4}->{'loaded_in'},
 526                 slot_1_loaded_in => $chg->{'__last_state'}->{'drives'}->{1}->{'orig_slot'},
 527             }, {
 528                 slot_2_loaded_in => 1,
 529                 slot_1_loaded_in => 4,
 530             },
 531             "$pfx: slot 2 'loaded_in' and drive 1 'orig_slot' are correct");
 532
 533         $res2->{'device'}->start($Amanda::Device::ACCESS_WRITE, "TAPE-2", undef);
 534         $res2->{'device'}->finish();
 535
 536         $res2->set_label(label => "TAPE-2", finished_cb => $steps->{'release1'});
 537     };
 538
 539     step release1 => sub {
 540         my ($err) = @_;
 541         die $err if $err;
 542
 543         pass("$pfx: labeled TAPE-2 in drive 1");
 544
 545         is_deeply({
 546                 loaded_in => $chg->{'__last_state'}->{'slots'}->{4}->{'loaded_in'},
 547                 orig_slot => $chg->{'__last_state'}->{'drives'}->{1}->{'orig_slot'},
 548                 slot_label => $chg->{'__last_state'}->{'slots'}->{4}->{'label'},
 549                 drive_label => $chg->{'__last_state'}->{'drives'}->{1}->{'label'},
 550             }, {
 551                 loaded_in => 1,
 552                 orig_slot => 4,
 553                 slot_label => 'TAPE-2',
 554                 drive_label => 'TAPE-2',
 555             }, "$pfx: label is correctly reflected in changer state");
 556
 557         $res2->release(finished_cb => $steps->{'inventory3'});
 558     };
 559
 560     step inventory3 => sub {
 561         my ($err) = @_;
 562         die "$err" if $err;
 563         pass("$pfx: slot 4/drive 1 released");
 564
 565         check_inventory($chg, $mtx_config->{'barcodes'} > 0, $steps->{'check_state_after_release1'}, [
 566             { slot => 1, state => Amanda::Changer::SLOT_EMPTY,
 567               import_export => 1,
 568               device_status => undef, device_error => undef,
 569               f_type => undef, label => undef },
 570             { slot => 2, state => Amanda::Changer::SLOT_EMPTY,
 571               import_export => 1,
 572               device_status => undef, device_error => undef,
 573               f_type => undef, label => undef },
 574             { slot => 3, state => Amanda::Changer::SLOT_FULL,
 575               barcode => 'PTAG00XX', reserved => 1, loaded_in => 0,
 576               current => 1,
 577               device_status => $DEVICE_STATUS_SUCCESS, device_error => undef,
 578               f_type => $Amanda::Header::F_TAPESTART, label => 'TAPE-1' },
 579             { slot => 4, state => Amanda::Changer::SLOT_FULL,
 580               barcode => 'PTAG01XX', loaded_in => 1,
 581               device_status => $DEVICE_STATUS_SUCCESS, device_error => undef,
 582               f_type => $Amanda::Header::F_TAPESTART, label => 'TAPE-2' },
 583             { slot => 5, state => Amanda::Changer::SLOT_FULL,
 584               barcode => 'PTAG02XX',
 585               device_status => undef, device_error => undef,
 586               f_type => undef, label => undef },
 587         ], "$pfx: inventory is still up to date");
 588     };
 589
 590     step check_state_after_release1 => sub {
 591         is($chg->{'__last_state'}->{'drives'}->{1}->{'res_info'}, undef,
 592                 "$pfx: drive is not reserved");
 593         is($chg->{'__last_state'}->{'drives'}->{1}->{'label'}, 'TAPE-2',
 594                 "$pfx: tape is still in drive");
 595
 596         $steps->{'load_current_1'}->();
 597     };
 598
 599     step load_current_1 => sub {
 600         $chg->load(relative_slot => "current", res_cb => $steps->{'loaded_current_1'});
 601     };
 602
 603     step loaded_current_1 => sub {
 604         my ($err, $res) = @_;
 605
 606         chg_err_like($err,
 607             { message => "the requested volume is in use (drive 0)",
 608               reason => 'volinuse',
 609               type => 'failed' },
 610             "$pfx: loading 'current' when set_current hasn't been used yet gets slot 1 (which is in use)");
 611
 612         $steps->{'load_slot_4'}->();
 613     };
 614
 615     # this should unload what's in drive 1 and load the empty volume in slot 4
 616     step load_slot_4 => sub {
 617         $chg->load(slot => 5, set_current => 1, res_cb => $steps->{'loaded_slot_4'});
 618     };
 619
 620     step loaded_slot_4 => sub {
 621         (my $err, $res2) = @_;
 622         die "$err" if $err;
 623
 624         is($res2->{'device'}->device_name, $drive1_name,
 625             "$pfx: loaded slot 5 into drive 1 (and set current to slot 5)");
 626
 627         is_deeply({
 628                 loaded_in => $chg->{'__last_state'}->{'slots'}->{4}->{'loaded_in'},
 629                 slot_label => $chg->{'__last_state'}->{'slots'}->{4}->{'label'},
 630             }, {
 631                 loaded_in => undef,
 632                 slot_label => 'TAPE-2',
 633             }, "$pfx: slot 4 (which was just unloaded) still tracked correctly");
 634
 635         is_deeply({
 636                 loaded_in => $chg->{'__last_state'}->{'slots'}->{3}->{'loaded_in'},
 637                 orig_slot => $chg->{'__last_state'}->{'drives'}->{0}->{'orig_slot'},
 638             }, {
 639                 loaded_in => 0,
 640                 orig_slot => 3,
 641             }, "$pfx: slot 1 'loaded_in' and drive 0 'orig_slot' are *still* correct");
 642
 643         is_deeply({
 644                 loaded_in => $chg->{'__last_state'}->{'slots'}->{5}->{'loaded_in'},
 645                 orig_slot => $chg->{'__last_state'}->{'drives'}->{1}->{'orig_slot'},
 646             }, {
 647                 loaded_in => 1,
 648                 orig_slot => 5,
 649             }, "$pfx: slot 5 'loaded_in' and drive 1 'orig_slot' are correct");
 650
 651         $steps->{'label_tape_4'}->();
 652     };
 653
 654     step label_tape_4 => sub {
 655         $res2->{'device'}->start($Amanda::Device::ACCESS_WRITE, "TAPE-4", undef);
 656         $res2->{'device'}->finish();
 657
 658         $res2->set_label(label => "TAPE-4", finished_cb => $steps->{'inventory4'});
 659     };
 660
 661     step inventory4 => sub {
 662         my ($err) = @_;
 663         die "$err" if $err;
 664         pass("$pfx: labeled TAPE-4 in drive 1");
 665
 666         check_inventory($chg, $mtx_config->{'barcodes'} > 0, $steps->{'release2'}, [
 667             { slot => 1, state => Amanda::Changer::SLOT_EMPTY,
 668               import_export => 1,
 669               device_status => undef, device_error => undef,
 670               f_type => undef, label => undef },
 671             { slot => 2, state => Amanda::Changer::SLOT_EMPTY,
 672               import_export => 1,
 673               device_status => undef, device_error => undef,
 674               f_type => undef, label => undef },
 675             { slot => 3, state => Amanda::Changer::SLOT_FULL,
 676               barcode => 'PTAG00XX', reserved => 1, loaded_in => 0,
 677               device_status => $DEVICE_STATUS_SUCCESS, device_error => undef,
 678               f_type => $Amanda::Header::F_TAPESTART, label => 'TAPE-1' },
 679             { slot => 4, state => Amanda::Changer::SLOT_FULL,
 680               barcode => 'PTAG01XX',
 681               device_status => $DEVICE_STATUS_SUCCESS, device_error => undef,
 682               f_type => $Amanda::Header::F_TAPESTART, label => 'TAPE-2' },
 683             { slot => 5, state => Amanda::Changer::SLOT_FULL,
 684               barcode => 'PTAG02XX', reserved => 1, loaded_in => 1,
 685               current => 1,
 686               device_status => $DEVICE_STATUS_SUCCESS, device_error => undef,
 687               f_type => $Amanda::Header::F_TAPESTART, label => 'TAPE-4' },
 688         ], "$pfx: inventory is up to date after more labelings");
 689     };
 690
 691     step release2 => sub {
 692         is_deeply({
 693                 loaded_in => $chg->{'__last_state'}->{'slots'}->{5}->{'loaded_in'},
 694                 orig_slot => $chg->{'__last_state'}->{'drives'}->{1}->{'orig_slot'},
 695                 slot_label => $chg->{'__last_state'}->{'slots'}->{5}->{'label'},
 696                 drive_label => $chg->{'__last_state'}->{'drives'}->{1}->{'label'},
 697             }, {
 698                 loaded_in => 1,
 699                 orig_slot => 5,
 700                 slot_label => 'TAPE-4',
 701                 drive_label => 'TAPE-4',
 702             }, "$pfx: label is correctly reflected in changer state");
 703
 704         $res1->release(finished_cb => $steps->{'release2_done'});
 705     };
 706
 707     step release2_done => sub {
 708         my ($err) = @_;
 709         die $err if $err;
 710
 711         pass("$pfx: slot 1/drive 0 released");
 712
 713         is($chg->{'__last_state'}->{'drives'}->{0}->{'label'}, 'TAPE-1',
 714                 "$pfx: tape is still in drive");
 715
 716         $steps->{'release3'}->();
 717     };
 718
 719     step release3 => sub {
 720         my ($err) = @_;
 721         die $err if $err;
 722
 723         $res2->release(finished_cb => $steps->{'release3_done'});
 724     };
 725
 726     step release3_done => sub {
 727         my ($err) = @_;
 728         die $err if $err;
 729
 730         pass("$pfx: slot 4/drive 0 released");
 731
 732         is($chg->{'__last_state'}->{'drives'}->{1}->{'label'},
 733                 'TAPE-4', "$pfx: tape is still in drive");
 734
 735         $steps->{'quit'}->();
 736     };
 737
 738     # note that Amanda_Changer_robot performs a *lot* more tests; they're
 739     # duplicative for this changer, so they are omitted
 740
 741     step quit => sub {
 742         unlink($chg_state_file) if -f $chg_state_file;
 743         $finished_cb->();
 744     };
 745     # ^^ remove final call to first sub XXX
 746 }
 747
 748 # These tests are run over a number of different mtx configurations, to ensure
 749 # that the behavior is identical regardless of the changer/mtx characteristics
 750 for my $mtx_config (
 751     { barcodes => 1, track_orig => 1, },
 752     { barcodes => 0, track_orig => 1, },
 753     { barcodes => 1, track_orig => -1, },
 754     { barcodes => 0, track_orig => 0, },
 755     { barcodes => -1, track_orig => 0, },
 756     ) {
 757     test_changer($mtx_config, \&Amanda::MainLoop::quit);
 758     Amanda::MainLoop::run();
 759 }
 760
 761 $ndmp->cleanup();