1 # Copyright (c) 2007-2012 Zmanda, Inc. All Rights Reserved.
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.
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
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
17 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
20 use Test::More tests => 54;
26 use lib "@amperldir@";
27 use Installcheck::Config;
29 use Amanda::Device qw( :constants );;
32 use Amanda::Config qw( :init :getconf config_dir_relative );
36 # set up debugging so debug output doesn't interfere with test results
37 Amanda::Debug::dbopen("installcheck");
38 Installcheck::log_test_output();
40 # and disable Debug's die() and warn() overrides
41 Amanda::Debug::disable_die_override();
44 # define a "test" changer for purposes of this installcheck
46 package Amanda::Changer::test;
48 @ISA = qw( Amanda::Changer );
50 # monkey-patch our test changer into Amanda::Changer, and indicate that
51 # the module has already been required by adding a key to %INC
52 $INC{'Amanda/Changer/test.pm'} = "Amanda_Changer";
56 my ($config, $tpchanger) = @_;
61 slots => [ 'TAPE-00', 'TAPE-01', 'TAPE-02', 'TAPE-03' ],
65 bless ($self, $class);
73 my $cb = $params{'res_cb'};
75 if (exists $params{'label'}) {
78 my $label = $params{'label'};
80 for my $i (0 .. $#{$self->{'slots'}}) {
81 if ($self->{'slots'}->[$i] eq $label) {
87 $cb->("No such label '$label'", undef);
91 # check that it's not in use
92 for my $used_slot (@{$self->{'reserved_slots'}}) {
93 if ($used_slot == $slot) {
94 $cb->("Volume with label '$label' is already in use", undef);
100 push @{$self->{'reserved_slots'}}, $slot;
102 if (exists $params{'set_current'} && $params{'set_current'}) {
103 $self->{'curslot'} = $slot;
106 $cb->(undef, Amanda::Changer::test::Reservation->new($self, $slot, $label));
107 } elsif (exists $params{'slot'} or exists $params{'relative_slot'}) {
108 my $slot = $params{'slot'};
109 if (exists $params{'relative_slot'}) {
110 if ($params{'relative_slot'} eq "current") {
111 $slot = $self->{'curslot'};
112 } elsif ($params{'relative_slot'} eq "next") {
113 $slot = ($self->{'curslot'} + 1) % (scalar @{$self->{'slots'}});
115 die "invalid relative_slot";
119 if (grep { $_ == $slot } @{$self->{'reserved_slots'}}) {
120 $cb->("Slot $slot is already in use", undef);
123 my $label = $self->{'slots'}->[$slot];
124 push @{$self->{'reserved_slots'}}, $slot;
126 if (exists $params{'set_current'} && $params{'set_current'}) {
127 $self->{'curslot'} = $slot;
130 $cb->(undef, Amanda::Changer::test::Reservation->new($self, $slot, $label));
132 die "No label or slot parameter given";
138 my ($key, %params) = @_;
141 if ($key eq 'num_slots') {
143 } elsif ($key eq 'mkerror1') {
144 return $self->make_error("failed", $params{'info_cb'},
147 } elsif ($key eq 'mkerror2') {
148 return $self->make_error("failed", $params{'info_cb'},
153 $params{'info_cb'}->(undef, %results) if $params{'info_cb'};
160 $self->{'curslot'} = 0;
162 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
169 $self->{'clean'} = 1;
171 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
178 Amanda::MainLoop::call_later($params{'inventory_cb'},
190 package Amanda::Changer::test::Reservation;
192 @ISA = qw( Amanda::Changer::Reservation );
196 my ($chg, $slot, $label) = @_;
197 my $self = Amanda::Changer::Reservation::new($class);
199 $self->{'chg'} = $chg;
200 $self->{'slot'} = $slot;
201 $self->{'label'} = $label;
203 $self->{'device'} = Amanda::Device->new("null:slot-$slot");
204 $self->{'this_slot'} = $slot;
212 my $slot = $self->{'slot'};
213 my $chg = $self->{'chg'};
215 $chg->{'reserved_slots'} = [ grep { $_ != $slot } @{$chg->{'reserved_slots'}} ];
217 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
223 my $slot = $self->{'slot'};
224 my $chg = $self->{'chg'};
226 $self->{'chg'}->{'slots'}->[$self->{'slot'}] = $params{'label'};
227 $self->{'label'} = $params{'label'};
229 $params{'finished_cb'}->(undef) if $params{'finished_cb'};
233 # back to the perl tests..
237 # work against a config specifying our test changer, to work out the kinks
238 # when it opens devices to check their labels
240 $testconf = Installcheck::Config->new();
241 $testconf->add_changer("mychanger", [
242 'tpchanger' => '"chg-test:/foo"',
243 'property' => '"testprop" "testval"',
247 my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
248 if ($cfg_result != $CFGERR_OK) {
249 my ($level, @errors) = Amanda::Config::config_errors();
250 die(join "\n", @errors);
253 # check out the relevant changer properties
254 my $tlf = Amanda::Config::config_dir_relative(getconf($CNF_TAPELIST));
255 my $tl = Amanda::Tapelist->new($tlf);
256 my $chg = Amanda::Changer->new("mychanger", tapelist => $tl);
257 is($chg->{'config'}->get_property("testprop"), "testval",
258 "changer properties are correctly represented");
259 is($chg->have_inventory(), 1, "changer have inventory");
260 my @new_tape_label = $chg->make_new_tape_label();
261 is_deeply(\@new_tape_label, [undef, "template is not set, you must set autolabel"], "no make_new_tape_label");
262 is($chg->make_new_meta_label(), undef, "no make_new_meta_label");
264 $chg = Amanda::Changer->new("mychanger", tapelist => $tl,
265 labelstr => "TESTCONF-[0-9][0-9][0-9]-[a-z][a-z][a-z]-[0-9][0-9][0-9]",
266 autolabel => { template => '$c-$m-$b-%%%',
271 meta_autolabel => "%%%");
272 my $meta = $chg->make_new_meta_label();
273 is($meta, "001", "meta 001");
274 my $label = $chg->make_new_tape_label(meta => $meta, barcode => 'aaa');
275 is($label, 'TESTCONF-001-aaa-001', "label TESTCONF-001-aaa-001");
277 is($chg->volume_is_labelable($DEVICE_STATUS_VOLUME_UNLABELED, $Amanda::Header::F_EMPTY),
278 1, "empty volume is labelable");
279 is($chg->volume_is_labelable($DEVICE_STATUS_VOLUME_ERROR, undef),
280 0, "empty volume is labelable");
282 # test loading by label
286 my ($getres, $rq_reserved, $relres);
288 $getres = make_cb('getres' => sub {
290 return $rq_reserved->();
293 my $label = pop @labels;
295 $chg->load(label => $label,
296 set_current => ($label eq "TAPE-02"),
298 my ($err, $res) = @_;
299 ok(!$err, "no error loading $label")
302 # keep this reservation
303 push @reservations, $res if $res;
305 # and start on the next
310 $rq_reserved = make_cb(rq_reserved => sub {
311 # try to load an already-reserved volume
312 $chg->load(label => 'TAPE-00',
314 my ($err, $res) = @_;
315 ok($err, "error when requesting already-reserved volume");
316 push @reservations, $res if $res;
322 $relres = make_cb('relres' => sub {
323 if (!@reservations) {
324 return Amanda::MainLoop::quit();
327 my $res = pop @reservations;
328 $res->release(finished_cb => sub {
337 @labels = ( 'TAPE-02', 'TAPE-00', 'TAPE-03' );
339 Amanda::MainLoop::run();
342 Amanda::MainLoop::run();
344 @labels = ( 'TAPE-00', 'TAPE-01' );
346 Amanda::MainLoop::run();
348 # explicitly release the reservations (without using the callback)
349 for my $res (@reservations) {
354 # test loading by slot
356 my ($start, $first_cb, $released, $second_cb, $quit);
359 # reserves the current slot
360 $start = make_cb('start' => sub {
361 $chg->load(res_cb => $first_cb, relative_slot => "current");
364 # gets a reservation for the "current" slot
365 $first_cb = make_cb('first_cb' => sub {
366 my ($err, $res) = @_;
369 is($res->{'this_slot'}, 2,
370 "'current' slot loads slot 2");
371 is($res->{'device'}->device_name, "null:slot-2",
372 "..device is correct");
374 $slot = $res->{'this_slot'};
375 $res->release(finished_cb => $released);
378 $released = make_cb(released => sub {
381 $chg->load(res_cb => $second_cb, relative_slot => 'next',
382 slot => $slot, set_current => 1);
385 # gets a reservation for the "next" slot
386 $second_cb = make_cb('second_cb' => sub {
387 my ($err, $res) = @_;
390 is($res->{'this_slot'}, 3,
391 "next slot loads slot 3");
392 is($chg->{'curslot'}, 3,
393 "..which is also now the current slot");
395 $res->release(finished_cb => $quit);
398 $quit = make_cb(quit => sub {
402 Amanda::MainLoop::quit();
406 Amanda::MainLoop::run();
411 my ($start, $load1_cb, $set_cb, $released, $load2_cb, $released2, $load3_cb);
415 $start = make_cb('start' => sub {
416 $chg->load(res_cb => $load1_cb, label => "TAPE-00");
419 # rename it to TAPE-99
420 $load1_cb = make_cb('load1_cb' => sub {
421 (my $err, $res) = @_;
424 pass("loaded TAPE-00");
425 $res->set_label(label => "TAPE-99", finished_cb => $set_cb);
428 $set_cb = make_cb('set_cb' => sub {
431 $res->release(finished_cb => $released);
434 # try to load TAPE-00
435 $released = make_cb('released' => sub {
439 pass("relabeled TAPE-00 to TAPE-99");
440 $chg->load(res_cb => $load2_cb, label => "TAPE-00");
443 # try to load TAPE-99
444 $load2_cb = make_cb('load2_cb' => sub {
445 (my $err, $res) = @_;
446 ok($err, "loading TAPE-00 is now an error");
448 $chg->load(res_cb => $load3_cb, label => "TAPE-99");
452 $load3_cb = make_cb('load3_cb' => sub {
453 (my $err, $res) = @_;
456 pass("but loading TAPE-99 is ok");
458 $res->release(finished_cb => $released2);
461 $released2 = make_cb(released2 => sub {
465 Amanda::MainLoop::quit();
469 Amanda::MainLoop::run();
472 # test reset and clean and inventory
474 my ($finished_cb) = @_;
476 my $steps = define_steps
477 cb_ref => \$finished_cb;
479 step do_reset => sub {
480 $chg->reset(finished_cb => sub {
481 is($chg->{'curslot'}, 0,
482 "reset() resets to slot 0");
483 $steps->{'do_clean'}->();
487 step do_clean => sub {
488 $chg->clean(finished_cb => sub {
489 ok($chg->{'clean'}, "clean 'cleaned' the changer");
490 $steps->{'do_inventory'}->();
494 step do_inventory => sub {
495 $chg->inventory(inventory_cb => sub {
504 }], "inventory returns an inventory");
509 test_simple(\&Amanda::MainLoop::quit);
510 Amanda::MainLoop::run();
514 my ($do_info, $check_info, $do_info_err, $check_info_err);
516 $do_info = make_cb('do_info' => sub {
517 $chg->info(info_cb => $check_info,
518 info => [ 'num_slots' ]);
521 $check_info = make_cb('check_info' => sub {
522 my ($err, %results) = @_;
524 is_deeply(\%results, { 'num_slots' => 13 },
529 $do_info_err = make_cb('do_info_err' => sub {
530 $chg->info(info_cb => $check_info_err,
531 info => [ 'mkerror1', 'mkerror2' ]);
534 $check_info_err = make_cb('check_info_err' => sub {
535 my ($err, %results) = @_;
537 "While getting info key 'mkerror1': err1; While getting info key 'mkerror2': err2",
538 "info errors are handled correctly");
539 is($err->{'type'}, 'failed', "error has type 'failed'");
540 ok($err->failed, "\$err->failed is true");
541 ok(!$err->fatal, "\$err->fatal is false");
542 is($err->{'reason'}, 'unknown', "\$err->{'reason'} is 'unknown'");
543 ok($err->unknown, "\$err->unknown is true");
544 ok(!$err->notimpl, "\$err->notimpl is false");
545 Amanda::MainLoop::quit();
549 Amanda::MainLoop::run();
553 # Test the various permutations of configuration setup, with a patched
554 # _new_from_uri so we can monitor the result
555 sub my_new_from_uri {
556 my ($uri, $cc, $name) = @_;
557 return $uri if (ref $uri and $uri->isa("Amanda::Changer::Error"));
558 return [ $uri, $cc? "cc" : undef ];
560 *saved_new_from_uri = *Amanda::Changer::_new_from_uri;
561 *Amanda::Changer::_new_from_uri = *my_new_from_uri;
564 my ($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn) = @_;
566 $testconf = Installcheck::Config->new();
568 if (defined($global_tapedev)) {
569 $testconf->add_param('tapedev', "\"$global_tapedev\"")
572 if (defined($global_tpchanger)) {
573 $testconf->add_param('tpchanger', "\"$global_tpchanger\"")
576 if (defined($defn_tpchanger)) {
577 $testconf->add_changer("mychanger", [
578 'tpchanger' => "\"$defn_tpchanger\"",
582 if (defined($custom_defn)) {
583 $testconf->add_changer("customchanger", $custom_defn);
584 $testconf->add_param('tpchanger', '"customchanger"');
589 my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
590 if ($cfg_result != $CFGERR_OK) {
591 my ($level, @errors) = Amanda::Config::config_errors();
592 die(join "\n", @errors);
597 my ($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn,
598 $name, $regexp, $msg) = @_;
599 loadconfig($global_tapedev, $global_tpchanger, $defn_tpchanger, $custom_defn);
600 my $err = Amanda::Changer->new($name);
601 if ($err->isa("Amanda::Changer::Error")) {
602 like($err->{'message'}, $regexp, $msg);
604 diag("Amanda::Changer->new did not return an Error object:");
605 diag("".Dumper($err));
610 assert_invalid(undef, undef, undef, undef, undef,
611 qr/You must specify one of 'tapedev' or 'tpchanger'/,
612 "supplying a nothing is invalid");
614 loadconfig(undef, "file:/foo", undef, undef);
615 is_deeply( Amanda::Changer->new(), [ "chg-single:file:/foo", undef ],
616 "default changer with global tpchanger naming a device");
618 loadconfig(undef, "chg-disk:/foo", undef, undef);
619 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", undef ],
620 "default changer with global tpchanger naming a changer");
622 loadconfig(undef, "mychanger", "chg-disk:/bar", undef);
623 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
624 "default changer with global tpchanger naming a defined changer with a uri");
626 loadconfig(undef, "mychanger", "chg-zd-mtx", undef);
627 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", "cc" ],
628 "default changer with global tpchanger naming a defined changer with a compat script");
630 loadconfig(undef, "chg-zd-mtx", undef, undef);
631 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", undef ],
632 "default changer with global tpchanger naming a compat script");
634 loadconfig("tape:/dev/foo", undef, undef, undef);
635 is_deeply( Amanda::Changer->new(), [ "chg-single:tape:/dev/foo", undef ],
636 "default changer with global tapedev naming a device and no tpchanger");
638 assert_invalid("tape:/dev/foo", "tape:/dev/foo", undef, undef, undef,
639 qr/Cannot specify both 'tapedev' and 'tpchanger'/,
640 "supplying a device for both tpchanger and tapedev is invalid");
642 assert_invalid("tape:/dev/foo", "chg-disk:/foo", undef, undef, undef,
643 qr/Cannot specify both 'tapedev' and 'tpchanger'/,
644 "supplying a device for tapedev and a changer for tpchanger is invalid");
646 loadconfig("tape:/dev/foo", 'chg-zd-mtx', undef, undef);
647 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", undef ],
648 "default changer with global tapedev naming a device and a global tpchanger naming a compat script");
650 assert_invalid("chg-disk:/foo", "tape:/dev/foo", undef, undef, undef,
651 qr/Cannot specify both 'tapedev' and 'tpchanger'/,
652 "supplying a changer for tapedev and a device for tpchanger is invalid");
654 loadconfig("chg-disk:/foo", undef, undef, undef);
655 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", undef ],
656 "default changer with global tapedev naming a device");
658 loadconfig("mychanger", undef, "chg-disk:/bar", undef);
659 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
660 "default changer with global tapedev naming a defined changer with a uri");
662 loadconfig("mychanger", undef, "chg-zd-mtx", undef);
663 is_deeply( Amanda::Changer->new(), [ "chg-compat:chg-zd-mtx", "cc" ],
664 "default changer with global tapedev naming a defined changer with a compat script");
666 loadconfig(undef, undef, "chg-disk:/foo", undef);
667 is_deeply( Amanda::Changer->new("mychanger"), [ "chg-disk:/foo", "cc" ],
668 "named changer loads the proper definition");
670 loadconfig(undef, undef, undef, [
671 tapedev => '"chg-disk:/foo"',
673 is_deeply( Amanda::Changer->new(), [ "chg-disk:/foo", "cc" ],
674 "defined changer with tapedev loads the proper definition");
676 loadconfig(undef, undef, undef, [
677 tpchanger => '"chg-disk:/bar"',
679 is_deeply( Amanda::Changer->new(), [ "chg-disk:/bar", "cc" ],
680 "defined changer with tpchanger loads the proper definition");
682 assert_invalid(undef, undef, undef, [
683 tpchanger => '"chg-disk:/bar"',
684 tapedev => '"file:/bar"',
686 qr/Cannot specify both 'tapedev' and 'tpchanger'/,
687 "supplying both a new tpchanger and tapedev in a definition is invalid");
689 assert_invalid(undef, undef, undef, [
690 property => '"this" "will not work"',
692 qr/You must specify one of 'tapedev' or 'tpchanger'/,
693 "supplying neither a tpchanger nor tapedev in a definition is invalid");
695 *Amanda::Changer::_new_from_uri = *saved_new_from_uri;
697 # test with_locked_state *within* a process
699 sub test_locked_state {
700 my ($finished_cb) = @_;
702 my $stfile = "$Installcheck::TMP/test-statefile";
703 my $num_outstanding = 0;
705 my $steps = define_steps
706 cb_ref => \$finished_cb,
707 finalize => sub { $chg->quit() if defined $chg };
710 $chg = Amanda::Changer->new("chg-null:");
712 for my $num (qw( one two three )) {
714 $chg->with_locked_state($stfile, $steps->{'maybe_done'}, sub {
715 my ($state, $maybe_done) = @_;
717 $state->{$num} = $num;
720 Amanda::MainLoop::call_after(50, $maybe_done, undef, $state);
725 step maybe_done => sub {
726 my ($err, $state) = @_;
729 return if (--$num_outstanding);
736 }, "state is maintained correctly (within a process)");
738 unlink($stfile) if -f $stfile;
743 test_locked_state(\&Amanda::MainLoop::quit);
744 Amanda::MainLoop::run();