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