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

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