1 # Copyright (c) 2008, 2009, 2010 Zmanda, Inc. All Rights Reserved.
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.
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
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
16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 use Test::More tests => 482;
20 use File::Path qw( mkpath rmtree );
25 use lib "@amperldir@";
27 use Installcheck::Mock;
28 use Installcheck::Config;
30 use Amanda::Device qw( :constants );
31 use Amanda::Config qw( :getconf :init );
32 use Amanda::Xfer qw( :constants );
33 use Amanda::Header qw( :constants );
42 my ($vtape1, $vtape2);
43 my ($input_filename, $output_filename) =
44 ( "$Installcheck::TMP/input.tmp", "$Installcheck::TMP/output.tmp" );
45 my $taperoot = "$Installcheck::TMP/Amanda_Device_test_tapes";
49 # we'll need some vtapes..
53 my $mytape = "$taperoot/$num";
54 if (-d $mytape) { rmtree($mytape); }
55 mkpath("$mytape/data");
60 # make up a fake dumpfile_t to write with
61 my $dumpfile = Amanda::Header->new();
62 $dumpfile->{type} = $Amanda::Header::F_DUMPFILE;
63 $dumpfile->{datestamp} = "20070102030405";
64 $dumpfile->{dumplevel} = 0;
65 $dumpfile->{compressed} = 1;
66 $dumpfile->{name} = "localhost";
67 $dumpfile->{disk} = "/home";
68 $dumpfile->{program} = "INSTALLCHECK";
70 # function to set up a queue_fd for a filename
72 my ($filename, $mode) = @_;
74 open(my $fd, $mode, $filename) or die("Could not open $filename: $!");
75 return $fd, Amanda::Device::queue_fd_t->new($fd);
78 my $write_file_count = 5;
80 my ($seed, $length, $filenum) = @_;
82 croak ("selected file size $length is *way* too big")
83 unless ($length < 1024*1024*10);
84 Amanda::Tests::write_random_file($seed, $length, $input_filename);
86 $dumpfile->{'datestamp'} = "2000010101010$filenum";
88 ok($dev->start_file($dumpfile),
89 "start file $filenum")
90 or diag($dev->error_or_status());
92 is($dev->file(), $filenum,
93 "Device has correct filenum");
95 my ($input, $queue_fd) = make_queue_fd($input_filename, "<");
96 ok($dev->write_from_fd($queue_fd),
98 or diag($dev->error_or_status());
99 close($input) or die("Error closing $input_filename");
101 if(ok($dev->in_file(),
103 ok($dev->finish_file(),
105 or diag($dev->error_or_status());
107 pass("not in file, so not calling finish_file");
111 my $verify_file_count = 5;
113 my ($seed, $length, $filenum) = @_;
115 ok(my $read_dumpfile = $dev->seek_file($filenum),
116 "seek to file $filenum")
117 or diag($dev->error_or_status());
118 is($dev->file(), $filenum,
119 "device is really at file $filenum");
120 ok(header_for($read_dumpfile, $filenum),
122 or diag($dev->error_or_status());
124 my ($output, $queue_fd) = make_queue_fd($output_filename, ">");
125 ok($dev->read_to_fd($queue_fd),
126 "read data from file $filenum")
127 or diag($dev->error_or_status());
128 close($output) or die("Error closing $output_filename");
130 ok(Amanda::Tests::verify_random_file($seed, $length, $output_filename, 0),
131 "verified file contents");
135 my ($hdr, $filenum) = @_;
136 return ($hdr and $hdr->{'datestamp'} eq "2000010101010$filenum");
141 my @common_properties = (
147 'medium_access_type',
154 sub properties_include {
155 my ($got, $should_include, $msg) = @_;
156 my %got = map { $_->{'name'}, 1 } @$got;
157 my @missing = grep { !defined($got{$_}) } @$should_include;
160 diag(" Expected properties: " . join(", ", @$should_include));
161 diag(" Got properties: " . join(", ", @$got));
162 diag(" Missing properties: " . join(", ", @missing));
171 $testconf = Installcheck::Config->new();
173 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
174 or die("Could not load configuration");
176 # put the debug messages somewhere
177 Amanda::Debug::dbopen("installcheck");
178 Installcheck::log_test_output();
181 ## Test errors a little bit
183 $dev = Amanda::Device->new("foobar:");
184 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
185 "creation of a bogus 'foobar:' device fails");
187 $dev = Amanda::Device->new("rait:{{");
188 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
189 "creation of a bogus 'rait:{{' device fails");
191 $dev = Amanda::Device->new("rait:{a,b");
192 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
193 "creation of a bogus 'rait:{a,b' device fails");
196 ## first, test out the 'null' device.
200 $dev = Amanda::Device->new($dev_name);
201 is($dev->status(), $DEVICE_STATUS_SUCCESS,
202 "create null device")
203 or diag $dev->error_or_status();
204 ok($dev->start($ACCESS_WRITE, "NULL1", "19780615010203"),
205 "start null device in write mode")
206 or diag $dev->error_or_status();
209 properties_include([ $dev->property_list() ], [ @common_properties ],
210 "necessary properties listed on null device");
211 is($dev->property_get("canonical_name"), "null:",
212 "property_get(canonical_name) on null device");
213 is($dev->property_get("caNONical-name"), "null:",
214 "property_get(caNONical-name) on null device (case, dash-insensitivity)");
215 is_deeply([ $dev->property_get("canonical_name") ],
216 [ "null:", $PROPERTY_SURETY_GOOD, $PROPERTY_SOURCE_DEFAULT ],
217 "extended property_get returns correct surety/source");
218 for my $prop ($dev->property_list()) {
219 next unless $prop->{'name'} eq 'canonical_name';
220 is($prop->{'description'},
221 "The most reliable device name to use to refer to this device.",
222 "property info for canonical name is correct");
224 ok(!$dev->property_get("full_deletion"),
225 "property_get(full_deletion) on null device");
226 is($dev->property_get("comment"), undef,
227 "no comment by default");
228 ok($dev->property_set("comment", "well, that was silly"),
229 "set comment property");
230 is($dev->property_get("comment"), "well, that was silly",
231 "comment correctly stored");
233 # and write a file to it
234 write_file(0xabcde, 1024*256, 1);
236 # (don't finish the device, testing the finalize method's cleanup)
239 ## Now some full device tests
243 $vtape1 = mkvtape(1);
244 $dev_name = "file:$vtape1";
246 $dev = Amanda::Device->new($dev_name);
247 is($dev->status(), $DEVICE_STATUS_SUCCESS,
248 "$dev_name: create successful")
249 or diag($dev->error_or_status());
251 properties_include([ $dev->property_list() ],
252 [ @common_properties, 'max_volume_usage' ],
253 "necessary properties listed on vfs device");
255 # play with properties a little bit
256 ok($dev->property_set("comment", 16),
257 "set an string property to an integer");
259 ok($dev->property_set("comment", 16.0),
260 "set an string property to a float");
262 ok($dev->property_set("comment", "hi mom"),
263 "set an string property to a string");
265 ok($dev->property_set("comment", "32768"),
266 "set an integer property to a simple string");
268 ok($dev->property_set("comment", "32k"),
269 "set an integer property to a string with a unit");
271 ok($dev->property_set("block_size", 32768),
272 "set an integer property to an integer");
275 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
276 "initially unlabeled")
277 or diag($dev->error_or_status());
279 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
280 "start in write mode")
281 or diag($dev->error_or_status());
283 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
284 "not unlabeled anymore")
285 or diag($dev->error_or_status());
287 for (my $i = 1; $i <= 3; $i++) {
288 write_file(0x2FACE, $dev->block_size()*10+17, $i);
292 "finish device after write")
293 or diag($dev->error_or_status());
296 ok(!($dev->status()),
297 "no error, at all, from read_label")
298 or diag($dev->error_or_status());
300 # append one more copy, to test ACCESS_APPEND
302 ok($dev->start($ACCESS_APPEND, undef, undef),
303 "start in append mode")
304 or diag($dev->error_or_status());
306 write_file(0xD0ED0E, $dev->block_size()*4, 4);
309 "finish device after append")
310 or diag($dev->error_or_status());
312 # try reading the third file back, creating a new device
313 # object first, and skipping the read-label step.
316 $dev = Amanda::Device->new($dev_name);
317 is($dev->status(), $DEVICE_STATUS_SUCCESS,
318 "$dev_name: re-create successful")
319 or diag($dev->error_or_status());
321 ok($dev->start($ACCESS_READ, undef, undef),
322 "start in read mode")
323 or diag($dev->error_or_status());
325 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
328 # try two seek_file's in a row
329 my $hdr = $dev->seek_file(3);
330 is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
331 $hdr = $dev->seek_file(3);
332 is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
336 "finish device after read")
337 or diag($dev->error_or_status());
342 or diag($dev->error_or_status());
345 "erase device (again)")
346 or diag($dev->error_or_status());
349 "finish device after erase")
350 or diag($dev->error_or_status());
353 ## Test a RAIT device of two vfs devices.
355 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
356 $dev_name = "rait:file:{$vtape1,$vtape2}";
358 $dev = Amanda::Device->new($dev_name);
359 is($dev->status(), $DEVICE_STATUS_SUCCESS,
360 "$dev_name: create successful")
361 or diag($dev->error_or_status());
363 ok($dev->configure(1), "configure device");
365 properties_include([ $dev->property_list() ], [ @common_properties ],
366 "necessary properties listed on rait device");
368 is($dev->property_get("block_size"), 32768, # (RAIT default)
369 "rait device calculates a default block size correctly");
371 ok($dev->property_set("block_size", 32768*16),
372 "rait device accepts an explicit block size");
374 is($dev->property_get("block_size"), 32768*16,
375 "..and remembers it");
378 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
379 "initially unlabeled")
380 or diag($dev->error_or_status());
382 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
383 "start in write mode")
384 or diag($dev->error_or_status());
386 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
387 "not unlabeled anymore")
388 or diag($dev->error_or_status());
390 for (my $i = 1; $i <= 3; $i++) {
391 write_file(0x2FACE, $dev->block_size()*10+17, $i);
395 "finish device after write")
396 or diag($dev->error_or_status());
399 ok(!($dev->status()),
400 "no error, at all, from read_label")
401 or diag($dev->error_or_status());
403 # append one more copy, to test ACCESS_APPEND
405 ok($dev->start($ACCESS_APPEND, undef, undef),
406 "start in append mode")
407 or diag($dev->error_or_status());
409 write_file(0xD0ED0E, $dev->block_size()*4, 4);
412 "finish device after append")
413 or diag($dev->error_or_status());
415 # try reading the third file back, creating a new device
416 # object first, and skipping the read-label step.
419 $dev = Amanda::Device->new($dev_name);
420 is($dev->status(), $DEVICE_STATUS_SUCCESS,
421 "$dev_name: re-create successful")
422 or diag($dev->error_or_status());
424 ok($dev->start($ACCESS_READ, undef, undef),
425 "start in read mode")
426 or diag($dev->error_or_status());
428 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
431 "finish device after read")
432 or diag($dev->error_or_status());
434 ok($dev->start($ACCESS_READ, undef, undef),
435 "start in read mode after missing volume")
436 or diag($dev->error_or_status());
438 # corrupt the device somehow and hope it keeps working
439 rmtree("$taperoot/1");
441 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
442 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
443 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
446 "finish device read after missing volume")
447 or diag($dev->error_or_status());
449 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
450 "start in write mode fails with missing volume")
451 or diag($dev->error_or_status());
455 $dev_name = "rait:{file:$vtape2,MISSING}";
456 $dev = Amanda::Device->new($dev_name);
458 ok($dev->start($ACCESS_READ, undef, undef),
459 "start in read mode with MISSING")
460 or diag($dev->error_or_status());
462 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
463 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
464 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
467 "finish device read with MISSING")
468 or diag($dev->error_or_status());
470 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
471 "start in write mode fails with MISSING")
472 or diag($dev->error_or_status());
476 $dev = Amanda::Device->new_rait_from_children(
477 Amanda::Device->new("file:$vtape2"), undef);
479 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
480 "start a RAIT device in write mode fails, when created with 'undef'")
481 or diag($dev->error_or_status());
483 # Make two devices with different labels, should get a
484 # message accordingly.
485 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
488 for $dev_name ("file:$vtape1", "file:$vtape2") {
489 my $dev = Amanda::Device->new($dev_name);
490 is($dev->status(), $DEVICE_STATUS_SUCCESS,
491 "$dev_name: Open successful")
492 or diag($dev->error_or_status());
493 ok($dev->start($ACCESS_WRITE, "TESTCONF$n", undef),
494 "wrote label 'TESTCONF$n'");
495 ok($dev->finish(), "finished device");
499 $dev = Amanda::Device->new_rait_from_children(
500 Amanda::Device->new("file:$vtape1"),
501 Amanda::Device->new("file:$vtape2"));
502 is($dev->status(), $DEVICE_STATUS_SUCCESS,
503 "new_rait_from_children: Open successful")
504 or diag($dev->error_or_status());
507 ok($dev->status() & $DEVICE_STATUS_VOLUME_ERROR,
508 "Label mismatch error handled correctly")
509 or diag($dev->error_or_status());
511 # Use some config to set a block size on a child device
512 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
513 $dev_name = "rait:{file:$vtape1,mytape2}";
515 $testconf = Installcheck::Config->new();
516 $testconf->add_device("mytape2", [
517 "tapedev" => "\"file:$vtape2\"",
518 "device_property" => "\"BLOCK_SIZE\" \"64k\""
521 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
522 or die("Could not load configuration");
524 $dev = Amanda::Device->new($dev_name);
525 is($dev->status(), $DEVICE_STATUS_SUCCESS,
526 "$dev_name: create successful")
527 or diag($dev->error_or_status());
529 ok($dev->configure(1), "configure device");
531 is($dev->property_get("block_size"), 65536,
532 "rait device calculates a block size from its children correctly");
534 # Test an S3 device if the proper environment variables are set
535 my $S3_SECRET_KEY = $ENV{'INSTALLCHECK_S3_SECRET_KEY'};
536 my $S3_ACCESS_KEY = $ENV{'INSTALLCHECK_S3_ACCESS_KEY'};
537 my $DEVPAY_SECRET_KEY = $ENV{'INSTALLCHECK_DEVPAY_SECRET_KEY'};
538 my $DEVPAY_ACCESS_KEY = $ENV{'INSTALLCHECK_DEVPAY_ACCESS_KEY'};
539 my $DEVPAY_USER_TOKEN = $ENV{'INSTALLCHECK_DEVPAY_USER_TOKEN'};
541 my $run_s3_tests = defined $S3_SECRET_KEY && defined $S3_ACCESS_KEY;
542 my $run_devpay_tests = defined $DEVPAY_SECRET_KEY &&
543 defined $DEVPAY_ACCESS_KEY && $DEVPAY_USER_TOKEN;
545 my $s3_make_device_count = 6;
546 sub s3_make_device($$) {
547 my ($dev_name, $kind) = @_;
548 $dev = Amanda::Device->new($dev_name);
549 is($dev->status(), $DEVICE_STATUS_SUCCESS,
550 "$dev_name: create successful")
551 or diag($dev->error_or_status());
553 my @s3_props = ( 's3_access_key', 's3_secret_key' );
554 push @s3_props, 's3_user_token' if ($kind eq "devpay");
555 properties_include([ $dev->property_list() ], [ @common_properties, @s3_props ],
556 "necessary properties listed on s3 device");
558 ok($dev->property_set('BLOCK_SIZE', 32768*2),
560 or diag($dev->error_or_status());
563 # use regular S3 credentials
564 ok($dev->property_set('S3_ACCESS_KEY', $S3_ACCESS_KEY),
566 or diag($dev->error_or_status());
568 ok($dev->property_set('S3_SECRET_KEY', $S3_SECRET_KEY),
570 or diag($dev->error_or_status());
572 pass("(placeholder)");
573 } elsif ($kind eq "devpay") {
574 # use devpay credentials
575 ok($dev->property_set('S3_ACCESS_KEY', $DEVPAY_ACCESS_KEY),
576 "set devpay access key")
577 or diag($dev->error_or_status());
579 ok($dev->property_set('S3_SECRET_KEY', $DEVPAY_SECRET_KEY),
580 "set devpay secret key")
581 or diag($dev->error_or_status());
583 ok($dev->property_set('S3_USER_TOKEN', $DEVPAY_USER_TOKEN),
584 "set devpay user token")
585 or diag($dev->error_or_status());
587 croak("didn't recognize the device kind, so no credentials were set");
595 skip "define \$INSTALLCHECK_S3_{SECRET,ACCESS}_KEY to run S3 tests",
597 1 * $verify_file_count +
598 4 * $write_file_count +
599 10 * $s3_make_device_count
600 unless $run_s3_tests;
603 $dev = Amanda::Device->new($dev_name);
604 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
605 "creating $dev_name fails miserably");
607 $dev_name = "s3:foo";
608 $dev = Amanda::Device->new($dev_name);
610 ok($dev->property_get("full_deletion"),
611 "property_get(full_deletion) on s3 device");
613 # test parsing of boolean values
614 # (s3 is the only device driver that has a writable boolean property at the
618 {'val' => '1', 'true' => 1},
619 {'val' => '0', 'true' => 0},
620 {'val' => 't', 'true' => 1},
621 {'val' => 'true', 'true' => 1},
622 {'val' => 'f', 'true' => 0},
623 {'val' => 'false', 'true' => 0},
624 {'val' => 'y', 'true' => 1},
625 {'val' => 'yes', 'true' => 1},
626 {'val' => 'n', 'true' => 0},
627 {'val' => 'no', 'true' => 0},
628 {'val' => 'on', 'true' => 1},
629 {'val' => 'off', 'true' => 0},
630 {'val' => 'oFf', 'true' => 0},
633 foreach my $v (@verbose_vals) {
634 $dev_name = "s3:foo";
635 $dev = Amanda::Device->new($dev_name);
637 $testconf = Installcheck::Config->new();
638 $testconf->add_param("device_property", "\"verbose\" \"$v->{'val'}\"");
640 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
641 or die("Could not load configuration");
643 ok($dev->configure(1),
644 "configured device with verbose set to $v->{'val'}")
645 or diag($dev->error_or_status());
647 my $get_val = $dev->property_get('verbose');
648 # see if truth-iness matches
649 my $expec = $v->{'true'}? "true" : "false";
650 is(!!$dev->property_get('verbose'), !!$v->{'true'},
651 "device_property 'VERBOSE' '$v->{'val'}' => property_get(verbose) returning $expec");
654 # test unparsable property
655 $dev_name = "s3:foo";
656 $dev = Amanda::Device->new($dev_name);
658 $testconf = Installcheck::Config->new();
659 $testconf->add_param("device_property", "\"verbose\" \"foo\"");
661 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
662 or die("Could not load configuration");
664 ok(!$dev->configure(1),
665 "failed to configure device with verbose set to foo");
667 like($dev->error_or_status(), qr/'verbose'/,
668 "error message mentions property name");
670 like($dev->error_or_status(), qr/'foo'/,
671 "error message mentions property value");
673 like($dev->error_or_status(), qr/gboolean/,
674 "error message mentions property type");
676 my $hostname = hostname();
677 $hostname =~ s/\./-/g;
678 $base_name = "$S3_ACCESS_KEY-installcheck-$hostname";
679 $dev_name = "s3:$base_name-s3";
680 $dev = s3_make_device($dev_name, "s3");
682 my $status = $dev->status();
683 # this test appears very liberal, but catches the case where setup_handle fails without
684 # giving false positives
685 ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
686 "status is either OK or possibly unlabeled")
687 or diag($dev->error_or_status());
689 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
690 "start in write mode")
691 or diag($dev->error_or_status());
693 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
695 or diag($dev->error_or_status());
697 for (my $i = 1; $i <= 3; $i++) {
698 write_file(0x2FACE, $dev->block_size()*10, $i);
702 "finish device after write")
703 or diag($dev->error_or_status());
706 ok(!($dev->status()),
707 "no error, at all, from read_label")
708 or diag($dev->error_or_status());
710 # append one more copy, to test ACCESS_APPEND
712 ok($dev->start($ACCESS_APPEND, undef, undef),
713 "start in append mode")
714 or diag($dev->error_or_status());
716 write_file(0xD0ED0E, $dev->block_size()*10, 4);
719 "finish device after append")
720 or diag($dev->error_or_status());
722 # try reading the third file back
724 ok($dev->start($ACCESS_READ, undef, undef),
725 "start in read mode")
726 or diag($dev->error_or_status());
728 verify_file(0x2FACE, $dev->block_size()*10, 3);
730 # test EOT indications on reading
731 my $hdr = $dev->seek_file(4);
732 is($hdr->{'type'}, $Amanda::Header::F_DUMPFILE,
733 "file 4 has correct type F_DUMPFILE");
735 $hdr = $dev->seek_file(5);
736 is($hdr->{'type'}, $Amanda::Header::F_TAPEEND,
737 "file 5 has correct type F_TAPEEND");
739 $hdr = $dev->seek_file(6);
740 is($hdr, undef, "seek_file returns undef for file 6");
743 "finish device after read")
744 or diag($dev->error_or_status()); # (note: we don't use write_max_size here, as the maximum for S3 is very large)
748 or diag($dev->error_or_status());
751 "erase device (again)")
752 or diag($dev->error_or_status());
755 "finish device after erase")
756 or diag($dev->error_or_status());
759 $status = $dev->status();
760 ok($status & $DEVICE_STATUS_VOLUME_UNLABELED,
761 "status is unlabeled after an erase")
762 or diag($dev->error_or_status());
764 $dev = s3_make_device($dev_name, "s3");
767 "erase device right after creation")
768 or diag($dev->error_or_status());
770 # try with empty user token
771 $dev_name = lc("s3:$base_name-s3");
772 $dev = s3_make_device($dev_name, "s3");
773 ok($dev->property_set('S3_USER_TOKEN', ''),
774 "set devpay user token")
775 or diag($dev->error_or_status());
778 $status = $dev->status();
779 ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
780 "status is either OK or possibly unlabeled")
781 or diag($dev->error_or_status());
783 # try a eu-constrained bucket
784 $dev_name = lc("s3:$base_name-s3-eu");
785 $dev = s3_make_device($dev_name, "s3");
786 ok($dev->property_set('S3_BUCKET_LOCATION', 'EU'),
787 "set S3 bucket location to 'EU'")
788 or diag($dev->error_or_status());
790 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
791 "start in write mode")
792 or diag($dev->error_or_status());
794 is($dev->status(), $DEVICE_STATUS_SUCCESS,
796 or diag($dev->error_or_status());
800 # try a wildcard-constrained bucket
801 $dev_name = lc("s3:$base_name-s3-wild");
802 $dev = s3_make_device($dev_name, "s3");
803 ok($dev->property_set('S3_BUCKET_LOCATION', '*'),
804 "set S3 bucket location to ''")
805 or diag($dev->error_or_status());
807 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
808 "start in write mode")
809 or diag($dev->error_or_status());
811 is($dev->status(), $DEVICE_STATUS_SUCCESS,
813 or diag($dev->error_or_status());
817 # test again with invalid ca_info
818 $dev = s3_make_device($dev_name, "s3");
820 skip "SSL not supported; can't check SSL_CA_INFO", 2
821 unless $dev->property_get('S3_SSL');
823 ok($dev->property_set('SSL_CA_INFO', '/dev/null'),
824 "set invalid SSL/TLS CA certificate")
825 or diag($dev->error_or_status());
827 ok(!$dev->start($ACCESS_WRITE, "TESTCONF13", undef),
828 "start in write mode")
829 or diag($dev->error_or_status());
831 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
833 or diag($dev->error_or_status());
838 # test again with our own CA bundle
839 $dev = s3_make_device($dev_name, "s3");
841 skip "SSL not supported; can't check SSL_CA_INFO", 4
842 unless $dev->property_get('S3_SSL');
843 ok($dev->property_set('SSL_CA_INFO', 'data/aws-bundle.crt'),
844 "set our own SSL/TLS CA certificate bundle")
845 or diag($dev->error_or_status());
849 or diag($dev->error_or_status());
851 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
852 "start in write mode")
853 or diag($dev->error_or_status());
855 is($dev->status(), $DEVICE_STATUS_SUCCESS,
857 or diag($dev->error_or_status());
860 # bucket names incompatible with location constraint
861 $dev_name = "s3:-$base_name-s3-eu";
862 $dev = s3_make_device($dev_name, "s3");
864 ok($dev->property_set('S3_BUCKET_LOCATION', ''),
865 "should be able to set an empty S3 bucket location with an incompatible name")
866 or diag($dev->error_or_status());
868 $dev_name = "s3:$base_name-s3.eu";
869 $dev = s3_make_device($dev_name, "s3");
871 ok($dev->property_set('S3_BUCKET_LOCATION', ''),
872 "should be able to set an empty S3 bucket location with an incompatible name")
873 or diag($dev->error_or_status());
875 $dev_name = "s3:-$base_name-s3-eu";
876 $dev = s3_make_device($dev_name, "s3");
878 ok(!$dev->property_set('S3_BUCKET_LOCATION', 'EU'),
879 "should not be able to set S3 bucket location with an incompatible name")
880 or diag($dev->error_or_status());
884 # in this case, most of our code has already been exercised
885 # just make sure that authentication works as a basic sanity check
886 skip "skipping abbreviated devpay tests", $s3_make_device_count + 1
887 unless $run_devpay_tests;
888 $dev_name = "s3:$base_name-devpay";
889 $dev = s3_make_device($dev_name, "devpay");
891 my $status = $dev->status();
892 # this test appears very liberal, but catches the case where setup_handle fails without
893 # giving false positives
894 ok(($status == 0) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
895 "status is either OK or possibly unlabeled")
896 or diag($dev->error_or_status());
899 # Test a tape device if the proper environment variables are set
900 my $TAPE_DEVICE = $ENV{'INSTALLCHECK_TAPE_DEVICE'};
901 my $run_tape_tests = defined $TAPE_DEVICE;
903 skip "define \$INSTALLCHECK_TAPE_DEVICE to run tape tests",
905 7 * $verify_file_count +
906 5 * $write_file_count
907 unless $run_tape_tests;
909 $dev_name = "tape:$TAPE_DEVICE";
910 $dev = Amanda::Device->new($dev_name);
911 is($dev->status(), $DEVICE_STATUS_SUCCESS,
912 "$dev_name: create successful")
913 or diag($dev->error_or_status());
915 my $status = $dev->read_label();
916 ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
917 "status is either OK or possibly unlabeled")
918 or diag($dev->error_or_status());
920 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
921 "start in write mode")
922 or diag($dev->error_or_status());
924 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
925 "not unlabeled anymore")
926 or diag($dev->error_or_status());
928 for (my $i = 1; $i <= 4; $i++) {
929 write_file(0x2FACE+$i, $dev->block_size()*10+17, $i);
933 "finish device after write")
934 or diag($dev->error_or_status());
937 ok(!($dev->status()),
938 "no error, at all, from read_label")
939 or diag($dev->error_or_status());
941 is($dev->volume_label(), "TESTCONF13",
942 "read_label reads the correct label")
943 or diag($dev->error_or_status());
945 # append one more copy, to test ACCESS_APPEND
947 # if final_filemarks is 1, then the tape device will use F_NOOP,
948 # inserting an extra file, and we'll be appending at file number 6.
949 my $append_fileno = ($dev->property_get("FINAL_FILEMARKS") == 2)? 5:6;
952 skip "APPEND not supported", $write_file_count + 2
953 unless $dev->property_get("APPENDABLE");
955 ok($dev->start($ACCESS_APPEND, undef, undef),
956 "start in append mode")
957 or diag($dev->error_or_status());
959 write_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
962 "finish device after append")
963 or diag($dev->error_or_status());
966 # try reading the second and third files back, creating a new
967 # device object first, and skipping the read-label step.
970 $dev = Amanda::Device->new($dev_name);
971 is($dev->status(), $DEVICE_STATUS_SUCCESS,
972 "$dev_name: re-create successful")
973 or diag($dev->error_or_status());
975 # use a big read_block_size, checking that it's also settable
976 # via read_buffer_size
977 ok($dev->property_set("read_buffer_size", 256*1024),
978 "can set read_buffer_size");
979 is($dev->property_get("read_block_size"), 256*1024,
980 "and its value is reflected in read_block_size");
981 ok($dev->property_set("read_block_size", 32*1024),
982 "can set read_block_size");
984 ok($dev->start($ACCESS_READ, undef, undef),
985 "start in read mode")
986 or diag($dev->error_or_status());
988 # now verify those files in a particular order to trigger all of the
991 verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
992 verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
993 verify_file(0x2FACE+4, $dev->block_size()*10+17, 4);
994 verify_file(0x2FACE+3, $dev->block_size()*10+17, 3);
995 verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
997 # try re-seeking to the same file
998 ok(header_for($dev->seek_file(2), 2), "seek to file 2 the first time");
999 verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1000 ok(header_for($dev->seek_file(2), 2), "seek to file 2 the third time");
1002 # and seek through the same pattern *without* reading to EOF
1003 ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1004 ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1005 ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1006 ok(header_for($dev->seek_file(3), 3), "seek to file 3");
1007 ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1010 skip "APPEND not supported", $verify_file_count
1011 unless $dev->property_get("APPENDABLE");
1012 verify_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1016 "finish device after read")
1017 or diag($dev->error_or_status());
1019 # tickle a regression in improperly closing fd's
1021 "finish device again after read")
1022 or diag($dev->error_or_status());
1024 ok($dev->read_label() == $DEVICE_STATUS_SUCCESS,
1025 "read_label after second finish (used to fail)")
1026 or diag($dev->error_or_status());
1028 # finally, run the device with FSF and BSF set to "no", to test the
1029 # fallback schemes for this condition
1032 $dev = Amanda::Device->new($dev_name);
1033 is($dev->status(), $DEVICE_STATUS_SUCCESS,
1034 "$dev_name: re-create successful")
1035 or diag($dev->error_or_status());
1036 $dev->property_set("fsf", "no");
1037 $dev->property_set("bsf", "no");
1039 ok($dev->start($ACCESS_READ, undef, undef),
1040 "start in read mode")
1041 or diag($dev->error_or_status());
1043 ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1044 ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1045 ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1048 "finish device after read")
1049 or diag($dev->error_or_status());
1053 skip "not built with ndmp and server", 77 unless
1054 Amanda::Util::built_with_component("ndmp") and
1055 Amanda::Util::built_with_component("server");
1058 my $testconf = Installcheck::Config->new();
1061 my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
1062 if ($cfg_result != $CFGERR_OK) {
1063 my ($level, @errors) = Amanda::Config::config_errors();
1064 die(join "\n", @errors);
1067 my $ndmp = Installcheck::Mock::NdmpServer->new();
1068 my $ndmp_port = $ndmp->{'port'};
1069 my $drive = $ndmp->{'drive'};
1070 pass("started ndmjob in daemon mode");
1072 # set up a header for use below
1073 my $hdr = Amanda::Header->new();
1074 $hdr->{type} = $Amanda::Header::F_DUMPFILE;
1075 $hdr->{datestamp} = "20070102030405";
1076 $hdr->{dumplevel} = 0;
1077 $hdr->{compressed} = 1;
1078 $hdr->{name} = "localhost";
1079 $hdr->{disk} = "/home";
1080 $hdr->{program} = "INSTALLCHECK";
1082 $dev = Amanda::Device->new("ndmp:127.0.0.1:9i1\@foo");
1083 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1084 "creation of an ndmp device fails with invalid port");
1086 $dev = Amanda::Device->new("ndmp:127.0.0.1:90000\@foo");
1087 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1088 "creation of an ndmp device fails with too-large port");
1090 $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port");
1091 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1092 "creation of an ndmp device fails without ..\@device_name");
1094 $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1095 is($dev->status(), $DEVICE_STATUS_SUCCESS,
1096 "creation of an ndmp device succeeds with correct syntax");
1098 ok($dev->property_set("ndmp_username", "foo"),
1099 "set ndmp_username property");
1100 is($dev->property_get("ndmp_username"), "foo",
1101 "..and get the value back");
1102 ok($dev->property_set("ndmp_password", "bar"),
1103 "set ndmp_password property");
1104 is($dev->property_get("ndmp_password"), "bar",
1105 "..and get the value back");
1107 ok($dev->property_set("verbose", 1),
1110 # set 'em back to the defaults
1111 $dev->property_set("ndmp_username", "ndmp");
1112 $dev->property_set("ndmp_password", "ndmp");
1114 # ok, let's fire the thing up
1115 ok($dev->start($ACCESS_WRITE, "TEST1", "20090915000000"),
1116 "start device in write mode")
1117 or diag $dev->error_or_status();
1119 ok($dev->start_file($hdr),
1122 { # write to the file
1123 my $xfer = Amanda::Xfer->new([
1124 Amanda::Xfer::Source::Random->new(32768*21, 0xBEEFEE00),
1125 Amanda::Xfer::Dest::Device->new($dev, 32768*5) ]);
1126 $xfer->start(make_cb(xmsg_cb => sub {
1127 my ($src, $msg, $xfer) = @_;
1128 if ($msg->{'type'} == $XMSG_ERROR) {
1129 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1130 } elsif ($msg->{'type'} == $XMSG_DONE) {
1131 Amanda::MainLoop::quit();
1135 Amanda::MainLoop::run();
1136 pass("wrote 21 blocks");
1141 or diag $dev->error_or_status();
1143 is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1144 "read label from (same) device")
1145 or diag $dev->error_or_status();
1147 is($dev->volume_label, "TEST1",
1148 "volume label read back correctly");
1150 ## label a device and check the label, but open a new device in between
1153 $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1154 is($dev->status(), $DEVICE_STATUS_SUCCESS,
1155 "creation of an ndmp device succeeds with correct syntax");
1156 $dev->property_set("ndmp_username", "ndmp");
1157 $dev->property_set("ndmp_password", "ndmp");
1158 $dev->property_set("verbose", 1);
1161 ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1162 "start device in write mode")
1163 or diag $dev->error_or_status();
1166 or diag $dev->error_or_status();
1168 # Read the label with a new device.
1169 $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1170 is($dev->status(), $DEVICE_STATUS_SUCCESS,
1171 "creation of an ndmp device succeeds with correct syntax");
1172 $dev->property_set("ndmp_username", "ndmp");
1173 $dev->property_set("ndmp_password", "ndmp");
1174 $dev->property_set("verbose", 1);
1177 is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1178 "read label from device")
1179 or diag $dev->error_or_status();
1180 is($dev->volume_label, "TEST2",
1181 "volume label read back correctly");
1184 or diag $dev->error_or_status();
1187 # test the directtcp-target implementation
1191 ok($dev->directtcp_supported(), "is a directtcp target");
1193 my $addrs = $dev->listen(1);
1194 ok($addrs, "listen returns successfully") or die($dev->error_or_status());
1196 # set up an xfer to write to the device
1197 my $xfer = Amanda::Xfer->new([
1198 Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
1199 Amanda::Xfer::Dest::DirectTCPConnect->new($addrs) ]);
1202 $xfer->start(make_cb(xmsg_cb => sub {
1203 my ($src, $msg, $xfer) = @_;
1204 if ($msg->{'type'} == $XMSG_ERROR) {
1205 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1206 } elsif ($msg->{'type'} == $XMSG_DONE) {
1207 Amanda::MainLoop::quit();
1211 # write files from the connection until EOF
1214 my ($call_accept, $start_device, $write_file_cb);
1216 $call_accept = make_cb(call_accept => sub {
1217 $conn = $dev->accept();
1218 Amanda::MainLoop::call_later($start_device);
1221 $start_device = make_cb(start_device => sub {
1222 ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1223 "start device in write mode")
1224 or diag $dev->error_or_status();
1226 Amanda::MainLoop::call_later($write_file_cb);
1229 $write_file_cb = make_cb(write_file_cb => sub {
1230 ++$num_files < 20 or die "I seem to be in a loop!";
1232 ok($dev->start_file($hdr), "start file $num_files for writing");
1233 is($dev->file, $num_files, "..file number is correct");
1235 my ($ok, $size) = $dev->write_from_connection(32768*15);
1236 push @messages, sprintf("WRITE-%s-%d-%s-%s",
1237 $ok?"OK":"ERR", $size,
1238 $dev->is_eof()? "EOF":"!eof",
1239 $dev->is_eom()? "EOM":"!eom");
1240 ok($ok, "..write from connection succeeds");
1241 my $eof = $dev->is_eof();
1243 ok($dev->finish_file(), "..finish file after writing");
1246 Amanda::MainLoop::call_later($write_file_cb);
1250 Amanda::MainLoop::call_later($call_accept);
1251 Amanda::MainLoop::run();
1252 is_deeply([@messages], [
1253 'WRITE-OK-491520-!eof-!eom',
1254 'WRITE-OK-491520-!eof-!eom',
1255 'WRITE-OK-131072-EOF-!eom',
1257 "a sequence of write_from_connection calls works correctly");
1261 if (my $err = $conn->close()) {
1271 ok($dev->directtcp_supported(), "is a directtcp target");
1273 $dev->property_set("_force_indirecttcp", 1);
1275 my $addrs = $dev->listen(1);
1276 is_deeply([ scalar @$addrs, $addrs->[0][0] ],
1277 [ 1, '255.255.255.255' ],
1278 "listen returns successfully with indirecttcp sentinel")
1279 or die($dev->error_or_status());
1281 # fork off to evaluate the indirecttcp addresses and then set up an
1282 # xfer to write to the device
1283 if (POSIX::fork() == 0) {
1284 # NOTE: do not use IO::Socket in normal Amanda code - it is diabolically
1285 # not threadsafe! It's OK here since this is just a test script and
1286 # since we're in a subprocess
1288 my $sock = new IO::Socket::INET(
1289 PeerAddr => '127.0.0.1',
1290 PeerPort => $addrs->[0][1],
1292 or die("Could not create connecting socket");
1293 $sock->shutdown(1); # send EOF
1294 my $sockresult = <$sock>;
1297 my @sockresult = map { [ split(/:/, $_) ] } split(/ /, $sockresult);
1298 $addrs = [ map { $_->[1] = int($_->[1]); $_ } @sockresult ];
1300 my $xfer = Amanda::Xfer->new([
1301 Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
1302 Amanda::Xfer::Dest::DirectTCPConnect->new($addrs) ]);
1304 $xfer->start(make_cb(xmsg_cb => sub {
1305 my ($src, $msg, $xfer) = @_;
1306 if ($msg->{'type'} == $XMSG_ERROR) {
1307 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1308 } elsif ($msg->{'type'} == $XMSG_DONE) {
1309 Amanda::MainLoop::quit();
1313 Amanda::MainLoop::run();
1315 # exit without doing any of perl's cleanup
1319 # write files from the connection until EOF
1323 my ($call_accept, $start_device, $write_file_cb);
1325 $call_accept = make_cb(call_accept => sub {
1326 $conn = $dev->accept();
1327 Amanda::MainLoop::call_later($start_device);
1330 $start_device = make_cb(start_device => sub {
1331 ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1332 "start device in write mode")
1333 or diag $dev->error_or_status();
1335 Amanda::MainLoop::call_later($write_file_cb);
1338 $write_file_cb = make_cb(write_file_cb => sub {
1339 ++$num_files < 20 or die "I seem to be in a loop!";
1341 ok($dev->start_file($hdr), "start file $num_files for writing");
1342 is($dev->file, $num_files, "..file number is correct");
1344 my ($ok, $size) = $dev->write_from_connection(32768*15);
1345 push @messages, sprintf("WRITE-%s-%d-%s-%s",
1346 $ok?"OK":"ERR", $size,
1347 $dev->is_eof()? "EOF":"!eof",
1348 $dev->is_eom()? "EOM":"!eom");
1349 ok($ok, "..write from connection succeeds");
1350 my $eof = $dev->is_eof();
1352 ok($dev->finish_file(), "..finish file after writing");
1355 Amanda::MainLoop::call_later($write_file_cb);
1357 Amanda::MainLoop::quit();
1361 Amanda::MainLoop::call_later($call_accept);
1362 Amanda::MainLoop::run();
1363 is_deeply([@messages], [
1364 'WRITE-OK-491520-!eof-!eom',
1365 'WRITE-OK-491520-!eof-!eom',
1366 'WRITE-OK-131072-EOF-!eom',
1368 "a sequence of write_from_connection calls works correctly");
1372 if (my $err = $conn->close()) {
1377 # now try reading that back piece by piece
1380 my $filename = "$Installcheck::TMP/Amanda_Device_ndmp.tmp";
1381 open(my $dest_fh, ">", $filename);
1383 ok($dev->start($ACCESS_READ, undef, undef),
1384 "start device in read mode")
1385 or diag $dev->error_or_status();
1388 for ($file = 1; $file <= 3; $file++) {
1389 ok($dev->seek_file($file),
1391 is($dev->file, $file, "..file num is correct");
1392 is($dev->block, 0, "..block num is correct");
1394 # read the file, writing to our temp file. We'll check that the byte
1395 # sequence is correct later
1396 my $xfer = Amanda::Xfer->new([
1397 Amanda::Xfer::Source::Device->new($dev),
1398 Amanda::Xfer::Dest::Fd->new($dest_fh) ]);
1400 $xfer->start(make_cb(xmsg_cb => sub {
1401 my ($src, $msg, $xfer) = @_;
1402 if ($msg->{'type'} == $XMSG_ERROR) {
1403 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1404 } elsif ($msg->{'type'} == $XMSG_DONE) {
1405 Amanda::MainLoop::quit();
1408 Amanda::MainLoop::run();
1410 pass("read back file " . $file);
1416 # now read back and verify that file
1417 open(my $src_fh, "<", $filename);
1418 my $xfer = Amanda::Xfer->new([
1419 Amanda::Xfer::Source::Fd->new($src_fh),
1420 Amanda::Xfer::Dest::Null->new(0xB00) ]);
1422 $xfer->start(make_cb(xmsg_cb => sub {
1423 my ($src, $msg, $xfer) = @_;
1424 if ($msg->{'type'} == $XMSG_ERROR) {
1425 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1426 } elsif ($msg->{'type'} == $XMSG_DONE) {
1427 Amanda::MainLoop::quit();
1430 Amanda::MainLoop::run();
1432 pass("data in the three parts is correct");
1437 # Test read_to_connection
1439 # This requires something that can connect to a device and read from
1440 # it; the XFA does not have an XFER_MECH_DIRECTTCP_CONNECT, so we fake
1441 # it by manually connecting and then setting up an xfer with a regular
1442 # XferSourceFd. This works because the NDMP server will accept an
1443 # incoming connection before the Device API accept() method is called;
1444 # this trick may not work with other DirectTCP-capable devices. Also,
1445 # this doesn't work so well if there's an error in the xfer (e.g., a
1446 # random value mismatch). But tests are supposed to succeed!
1448 sub test_read2conn {
1449 my ($finished_cb) = @_;
1454 my $steps = define_steps
1455 cb_ref => \$finished_cb;
1458 my $addrs = $dev->listen(0);
1460 # now connect to that
1461 $sock = IO::Socket::INET->new(
1463 PeerHost => $addrs->[0][0],
1464 PeerPort => $addrs->[0][1],
1468 # and set up a transfer to read from that socket
1469 my $xfer = Amanda::Xfer->new([
1470 Amanda::Xfer::Source::Fd->new($sock),
1471 Amanda::Xfer::Dest::Null->new(0xB00) ]);
1473 $xfer->start(make_cb(xmsg_cb => sub {
1474 my ($src, $msg, $xfer) = @_;
1475 if ($msg->{'type'} == $XMSG_ERROR) {
1476 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1478 if ($msg->{'type'} == $XMSG_DONE) {
1479 push @events, "DONE";
1480 $steps->{'quit'}->();
1484 $steps->{'accept'}->();
1487 step accept => sub {
1488 $conn = $dev->accept();
1489 die $dev->error_or_status() unless ($conn);
1491 Amanda::MainLoop::call_later($steps->{'start_dev'});
1494 step start_dev => sub {
1495 ok($dev->start($ACCESS_READ, undef, undef),
1496 "start device in read mode")
1497 or diag $dev->error_or_status();
1499 Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1502 step read_part_cb => sub {
1503 my $hdr = $dev->seek_file($file);
1504 die $dev->error_or_status() unless ($hdr);
1505 my $size = $dev->read_to_connection(0);
1506 push @events, "READ-$size";
1509 Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1511 # close the connection, which will end the xfer, which will
1512 # result in a call to finished_cb. So there.
1513 push @events, "CLOSE";
1519 close $sock or die "close: $!";
1521 is_deeply([@events],
1522 [ "READ-491520", "READ-491520", "READ-131072", "CLOSE", "DONE" ],
1523 "sequential read_to_connection operations read the right amounts " .
1524 "and bytestream matches");
1529 test_read2conn(\&Amanda::MainLoop::quit);
1530 Amanda::MainLoop::run();
1532 # try two seek_file's in a row
1533 $hdr = $dev->seek_file(2);
1534 is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
1535 $hdr = $dev->seek_file(2);
1536 is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
1538 ## test seek_file's handling of EOM
1540 $hdr = $dev->seek_file(3);
1541 is($hdr->{type}, $Amanda::Header::F_DUMPFILE, "file 3 is a dumpfile");
1542 $hdr = $dev->seek_file(4);
1543 is($hdr->{type}, $Amanda::Header::F_TAPEEND, "file 4 is tapeend");
1544 $hdr = $dev->seek_file(5);
1545 is($hdr, undef, "file 5 is an error");
1546 $hdr = $dev->seek_file(6);
1547 is($hdr, undef, "file 6 is an error");
1551 unlink($input_filename);
1552 unlink($output_filename);