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