1 # Copyright (c) 2008-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 => 31;
25 use lib "@amperldir@";
27 use Installcheck::Config;
28 use Installcheck::Run;
29 use Installcheck::Changer;
32 use Amanda::Debug qw( :logging );
34 use Amanda::Config qw( :init :getconf config_dir_relative );
37 # set up debugging so debug output doesn't interfere with test results
38 Amanda::Debug::dbopen("installcheck");
39 Installcheck::log_test_output();
41 # and disable Debug's die() and warn() overrides
42 Amanda::Debug::disable_die_override();
44 my $changer_filename = "$Installcheck::TMP/chg-test";
45 my $result_file = "$Installcheck::TMP/chg-test.result";
47 # Set up a 'test' changer; several of these are defined below.
49 my ($changer_script) = @_;
51 open my $chg_test, ">", $changer_filename or die("Could not create test changer");
53 $changer_script =~ s/\$Installcheck::TMP/$Installcheck::TMP/g;
55 print $chg_test "#! /bin/sh\n";
56 print $chg_test $changer_script;
59 chmod 0755, $changer_filename;
62 # slurp the $result_file
64 return '' unless (-r $result_file);
66 open(my $fh, "<", $result_file) or die("open $result_file: $!");
67 my $result = do { local $/; <$fh> };
73 # Functions to invoke the changer and later verify the result
74 my ($check_res_cb, $check_finished_cb);
76 my $expected_err_info;
81 $check_res_cb = make_cb('check_res_cb' => sub {
85 if (defined($expected_err_info)) {
86 chg_err_like($err, $expected_err_info, $msg);
89 diag("Unexpected error: $err");
92 if (defined($expected_dev)) {
93 is($res->{'device'}->device_name, $expected_dev, $msg);
96 diag("Unexpected reservation");
101 $res->release(finished_cb => $quit);
107 $check_finished_cb = make_cb('check_finished_cb' => sub {
108 my ($err, $res) = @_;
111 if (defined($expected_err_info)) {
112 chg_err_like($err, $expected_err_info, $msg);
115 diag("Unexpected error: $err");
118 if (!defined($expected_err_info)) {
122 diag("Unexpected success");
127 $res->release(finished_cb => $quit);
133 $quit = make_cb(quit => sub {
137 Amanda::MainLoop::quit();
140 sub try_run_changer {
142 ($sub, $expected_err_info, $expected_dev, $msg) = @_;
144 Amanda::MainLoop::call_later($sub);
145 Amanda::MainLoop::run();
149 # OK, let's get started with some simple stuff
150 setup_changer <<'EOC';
154 1) echo "1 null:fake1"; exit 0;;
155 2) echo "<ignored> slot 2 is empty"; exit 1;;
156 3) echo "1"; exit 0;; # test missing 'device' portion
157 4) echo "1 bogus:dev"; exit 0;;
158 5) echo "<error> multiline error"; echo "line 2"; exit 1;;
159 current) echo "1 null:current"; exit 0;;
160 next) echo "1 null:next"; exit 0;;
163 echo "reset" > $Installcheck::TMP/chg-test.result
164 echo "reset ignored";;
166 echo "eject" > $Installcheck::TMP/chg-test.result
167 echo "eject ignored";;
169 echo "clean" > $Installcheck::TMP/chg-test.result
170 echo "clean ignored";;
173 foo?bar) echo "1 ok"; exit 0;;
174 *) echo "<error> bad label"; exit 1;;
176 -info) echo "7 10 1 1"; exit 0;;
179 TAPE?01) echo "5 null:fakedev"; exit 0;;
180 fatal) echo "<error> game over"; exit 2;;
181 *) echo "<error> not found"; exit 1;;
186 # set up a config for this changer, implicitly using Amanda::Changer::Compat
188 $testconf = Installcheck::Config->new();
189 $testconf->add_param("tpchanger", "\"$changer_filename\"");
192 my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
193 if ($cfg_result != $CFGERR_OK) {
194 my ($level, @errors) = Amanda::Config::config_errors();
195 die(join "\n", @errors);
198 my $chg = Amanda::Changer->new();
199 die($chg) if $chg->isa("Amanda::Changer::Error");
201 is($chg->have_inventory(), '', "changer have inventory");
204 sub { $chg->load(label => 'TAPE-01', res_cb => $check_res_cb); },
207 "search by label succeeds");
210 sub { $chg->load(label => 'TAPE-99', res_cb => $check_res_cb); },
211 { message => "not found", type => 'failed', reason => 'notfound' },
213 "search by label; nonexistent tape");
216 sub { $chg->load(slot => '1', res_cb => $check_res_cb); },
222 sub { $chg->load(slot => '2', res_cb => $check_res_cb); },
223 { message => "slot 2 is empty", type => 'failed', reason => 'notfound' },
225 "search by slot; empty slot");
228 sub { $chg->load(slot => '3', res_cb => $check_res_cb); },
229 { message => "changer script did not provide a device name", type => 'fatal' },
231 "search by slot; no device in response");
234 sub { $chg->load(slot => '1', res_cb => $check_res_cb); },
235 { message => "changer script did not provide a device name", type => 'fatal' },
237 "fatal error is sticky");
239 $chg->{'fatal_error'} = undef; # reset the fatal error
242 sub { $chg->load(slot => '4', res_cb => $check_res_cb); },
243 { message => "opening 'bogus:dev': Device type bogus is not known.",
245 reason => 'device' },
247 "search by slot; bogus device leads to 'failed' error");
249 $chg->{'fatal_error'} = undef; # reset the fatal error
252 sub { $chg->load(slot => '5', res_cb => $check_res_cb); },
253 { message => "multiline error\nline 2",
255 reason => 'notfound' },
257 "multiline error response captured in its entirety");
259 $chg->{'fatal_error'} = undef; # reset the fatal error
262 sub { $chg->load(label => 'fatal', res_cb => $check_res_cb); },
263 { message => "game over", type => 'fatal' },
265 "search by label with fatal error");
267 # reset the fatal error
268 $chg->{'fatal_error'} = undef;
271 sub { $chg->eject(finished_cb => $check_finished_cb); },
272 undef, undef, "chg->eject doesn't fail");
273 like(slurp_result(), qr/eject/, ".. and calls chg-test -eject");
276 sub { $chg->reset(finished_cb => $check_finished_cb); },
277 undef, undef, "chg->reset doesn't fail");
278 like(slurp_result(), qr/reset/, ".. and calls chg-test -reset");
281 sub { $chg->clean(finished_cb => $check_finished_cb); },
282 undef, undef, "chg->clean doesn't fail");
283 like(slurp_result(), qr/clean/, ".. and calls chg-test -clean");
286 sub { $chg->update(finished_cb => $check_finished_cb); },
287 undef, undef, "chg->update doesn't fail");
290 sub { $chg->inventory(inventory_cb => $check_finished_cb); },
291 { message => "'chg-compat:' does not support inventory",
292 type => 'failed', reason => 'notimpl' },
294 "inventory not implemented");
297 # make sure only one reservation can be held at once
301 my ($load_1, $load_2, $check_load_2, $check_eject);
303 $load_1 = make_cb('load_1' => sub {
304 $chg->load(slot => 1, res_cb => $load_2);
307 $load_2 = make_cb('load_2' => sub {
308 my ($err, $res) = @_;
311 # keep this in scope through the next load
314 $chg->load(slot => 2, res_cb => $check_load_2);
317 $check_load_2 = make_cb('check_load_2' => sub {
318 my ($err, $res) = @_;
320 like($err, qr/Changer is already reserved/,
321 "mulitple simultaneous reservations not alowed");
323 $first_res->release(eject => 1, finished_cb => $check_eject);
326 $check_eject = make_cb('check_eject' => sub {
329 ok(!defined $err, "release with eject succeeds");
331 like(slurp_result(), qr/eject/, "..and calls chg-test -eject");
333 Amanda::MainLoop::quit();
337 Amanda::MainLoop::run();
342 # Installcheck::Run sets up the whole chg-disk thing for us
343 $testconf = Installcheck::Run::setup();
346 $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
347 if ($cfg_result != $CFGERR_OK) {
348 my ($level, @errors) = Amanda::Config::config_errors();
349 die(join "\n", @errors);
353 $chg = Amanda::Changer->new();
354 die($chg) if $chg->isa("Amanda::Changer::Error");
358 my ($get_info, $load_current, $label_current, $load_next,
359 $released1, $release_next, $load_by_label, $check_by_label);
361 $get_info = make_cb('get_info' => sub {
362 $chg->info(info_cb => $load_current, info => [ 'num_slots', 'fast_search' ]);
365 $load_current = make_cb('load_current' => sub {
368 die($err) if defined($err);
370 is_deeply({ %results },
371 { num_slots => 3, fast_search => 0 }, # old chg-disk is not searchable
372 "info() returns the correct num_slots and fast_search");
374 $chg->load(slot => "1", res_cb => $label_current);
377 $label_current = make_cb('label_current' => sub {
378 (my $err, $res) = @_;
381 pass("seek to current slot succeeded");
383 my $dev = $res->{'device'};
384 $dev->start($Amanda::Device::ACCESS_WRITE, "TESTCONF18", undef)
385 or die $dev->error_or_status();
387 or die $dev->error_or_status();
389 is($res->{'this_slot'}, "1", "this slot is '1'");
390 $res->set_label(label => "TESTCONF18", finished_cb => $load_next);
393 $load_next = make_cb('load_next' => sub {
397 pass("set_label succeeded");
399 $res->release(finished_cb => $released1);
402 $released1 = make_cb(released1 => sub {
406 $chg->load(relative_slot => "next", res_cb => $release_next);
409 $release_next = make_cb('release_next' => sub {
410 (my $err, $res) = @_;
413 pass("load relative slot 'next' succeeded");
415 $res->release(finished_cb => $load_by_label);
418 $load_by_label = make_cb('load_by_label' => sub {
422 pass("release loaded");
424 $chg->load(label => "TESTCONF18", res_cb => $check_by_label);
427 $check_by_label = make_cb('check_by_label' => sub {
428 (my $err, $res) = @_;
431 pass("load by label succeeded");
433 my $dev = $res->{'device'};
434 $dev->read_label() == 0
435 or die $dev->error_or_status();
437 is($dev->volume_label(), "TESTCONF18",
438 "..and finds the right volume");
440 $res->release(finished_cb => sub {
444 Amanda::MainLoop::quit();
449 Amanda::MainLoop::run();
453 # test two simultaneous invocations of info()
455 $chg = Amanda::Changer->new();
456 die($chg) if $chg->isa("Amanda::Changer::Error");
459 my ($finished_cb) = @_;
460 my $n_info_results = 0;
462 my $steps = define_steps
463 cb_ref => \$finished_cb;
465 step get_infos => sub {
466 # convince the changer that it has not gotten any info yet
467 $chg->{'got_info'} = 0;
469 $chg->info(info_cb => $steps->{'got_info_result'}, info => [ 'num_slots' ]);
470 $chg->info(info_cb => $steps->{'got_info_result'}, info => [ 'fast_search' ]);
473 step got_info_result => sub {
474 my ($err, %info) = @_;
477 if ($n_info_results >= 2) {
478 pass("two simultaneous info() invocations are successful");
483 test_get_infos(\&Amanda::MainLoop::quit);
484 Amanda::MainLoop::run();
486 # scan the changer using except_slots
487 sub test_except_slots {
488 my ($finished_cb) = @_;
492 my $steps = define_steps
493 cb_ref => \$finished_cb;
496 $chg->load(relative_slot => "current",
497 except_slots => { %except_slots },
498 res_cb => $steps->{'loaded'});
502 my ($err, $res) = @_;
504 if ($err->notfound) {
505 # this means the scan is done
506 return $steps->{'quit'}->();
507 } elsif ($err->volinuse and defined $err->{'slot'}) {
508 $slot = $err->{'slot'};
513 $slot = $res->{'this_slot'};
516 $except_slots{$slot} = 1;
519 $res->release(finished_cb => $steps->{'released'});
521 $steps->{'released'}->();
525 step released => sub {
529 $chg->load(relative_slot => 'next', slot => $slot,
530 except_slots => { %except_slots },
531 res_cb => $steps->{'loaded'});
535 is_deeply({ %except_slots }, { 1=>1, 2=>1, 3=>1 },
536 "scanning with except_slots works");
540 test_except_slots(\&Amanda::MainLoop::quit);
541 Amanda::MainLoop::run();
544 unlink($changer_filename);
545 unlink($result_file);