]> git.gag.com Git - debian/amanda/blob - installcheck/Amanda_Device.pl
7fdccef1ca015821e0556d5f40347418f62cc285
[debian/amanda] / installcheck / Amanda_Device.pl
1 # Copyright (c) 2008, 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 => 593;
20 use File::Path qw( mkpath rmtree );
21 use Sys::Hostname;
22 use Carp;
23 use strict;
24 use warnings;
25
26 use lib "@amperldir@";
27 use Installcheck;
28 use Installcheck::Mock;
29 use Installcheck::Config;
30 use Amanda::Debug;
31 use Amanda::Device qw( :constants );
32 use Amanda::Config qw( :getconf :init );
33 use Amanda::Xfer qw( :constants );
34 use Amanda::Header qw( :constants );
35 use Amanda::Paths;
36 use Amanda::Util;
37 use Amanda::MainLoop;
38 use IO::Socket;
39
40 my $dev;
41 my $dev_name;
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";
46 my $testconf;
47
48 # we'll need some vtapes..
49 sub mkvtape {
50     my ($num) = @_;
51
52     my $mytape = "$taperoot/$num";
53     if (-d $mytape) { rmtree($mytape); }
54     mkpath("$mytape/data");
55     return $mytape;
56 }
57
58
59 # make up a fake dumpfile_t to write with
60 my $dumpfile = Amanda::Header->new();
61 $dumpfile->{type} = $Amanda::Header::F_DUMPFILE;
62 $dumpfile->{datestamp} = "20070102030405";
63 $dumpfile->{dumplevel} = 0;
64 $dumpfile->{compressed} = 1;
65 $dumpfile->{name} = "localhost";
66 $dumpfile->{disk} = "/home";
67 $dumpfile->{program} = "INSTALLCHECK";
68
69 my $write_file_count = 5;
70 sub write_file {
71     my ($seed, $length, $filenum) = @_;
72
73     $dumpfile->{'datestamp'} = "2000010101010$filenum";
74
75     ok($dev->start_file($dumpfile),
76         "start file $filenum")
77         or diag($dev->error_or_status());
78
79     is($dev->file(), $filenum,
80         "Device has correct filenum");
81
82     croak ("selected file size $length is *way* too big")
83         unless ($length < 1024*1024*10);
84     ok(Amanda::Device::write_random_to_device($seed, $length, $dev),
85         "write random data");
86
87     if(ok($dev->in_file(),
88         "still in_file")) {
89         ok($dev->finish_file(),
90             "finish_file")
91             or diag($dev->error_or_status());
92     } else {
93         pass("not in file, so not calling finish_file");
94     }
95 }
96
97 my $verify_file_count = 4;
98 sub verify_file {
99     my ($seed, $length, $filenum) = @_;
100
101     ok(my $read_dumpfile = $dev->seek_file($filenum),
102         "seek to file $filenum")
103         or diag($dev->error_or_status());
104     is($dev->file(), $filenum,
105         "device is really at file $filenum");
106     ok(header_for($read_dumpfile, $filenum),
107         "header is correct")
108         or diag($dev->error_or_status());
109     ok(Amanda::Device::verify_random_from_device($seed, $length, $dev),
110         "verified file contents");
111 }
112
113 sub header_for {
114     my ($hdr, $filenum) = @_;
115     return ($hdr and $hdr->{'datestamp'} eq "2000010101010$filenum");
116 }
117
118 # properties test
119
120 my @common_properties = (
121     'appendable',
122     'block_size',
123     'canonical_name',
124     'concurrency',
125     'max_block_size',
126     'medium_access_type',
127     'min_block_size',
128     'partial_deletion',
129     'full_deletion',
130     'streaming',
131 );
132
133 sub properties_include {
134     my ($got, $should_include, $msg) = @_;
135     my %got = map { $_->{'name'}, 1 } @$got;
136     my @missing = grep { !defined($got{$_}) } @$should_include;
137     if (@missing) {
138         fail($msg);
139         diag(" Expected properties: " . join(", ", @$should_include));
140         diag("      Got properties: " . join(", ", @$got));
141         diag("  Missing properties: " . join(", ", @missing));
142     } else {
143         pass($msg);
144     }
145 }
146
147 ####
148 ## get stuff set up
149
150 $testconf = Installcheck::Config->new();
151 $testconf->write();
152 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
153     or die("Could not load configuration");
154
155 # put the debug messages somewhere
156 Amanda::Debug::dbopen("installcheck");
157 Installcheck::log_test_output();
158
159 ####
160 ## Test errors a little bit
161
162 $dev = Amanda::Device->new("foobar:");
163 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
164     "creation of a bogus 'foobar:' device fails");
165
166 $dev = Amanda::Device->new("rait:{{");
167 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
168     "creation of a bogus 'rait:{{' device fails");
169
170 $dev = Amanda::Device->new("rait:{a,b");
171 isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
172     "creation of a bogus 'rait:{a,b' device fails");
173
174 ####
175 ## first, test out the 'null' device.
176
177 $dev_name = "null:";
178
179 $dev = Amanda::Device->new($dev_name);
180 is($dev->status(), $DEVICE_STATUS_SUCCESS,
181     "create null device")
182     or diag $dev->error_or_status();
183 ok($dev->start($ACCESS_WRITE, "NULL1", "19780615010203"),
184     "start null device in write mode")
185     or diag $dev->error_or_status();
186
187 # try properties
188 properties_include([ $dev->property_list() ], [ @common_properties ],
189     "necessary properties listed on null device");
190 is($dev->property_get("canonical_name"), "null:",
191     "property_get(canonical_name) on null device");
192 is($dev->property_get("caNONical-name"), "null:",
193     "property_get(caNONical-name) on null device (case, dash-insensitivity)");
194 is_deeply([ $dev->property_get("canonical_name") ],
195     [ "null:", $PROPERTY_SURETY_GOOD, $PROPERTY_SOURCE_DEFAULT ],
196     "extended property_get returns correct surety/source");
197 for my $prop ($dev->property_list()) {
198     next unless $prop->{'name'} eq 'canonical_name';
199     is($prop->{'description'},
200         "The most reliable device name to use to refer to this device.",
201         "property info for canonical name is correct");
202 }
203 ok(!$dev->property_get("full_deletion"),
204     "property_get(full_deletion) on null device");
205 is($dev->property_get("comment"), undef,
206     "no comment by default");
207 ok($dev->property_set("comment", "well, that was silly"),
208     "set comment property");
209 is($dev->property_get("comment"), "well, that was silly",
210     "comment correctly stored");
211
212 # and write a file to it
213 write_file(0xabcde, 1024*256, 1);
214
215 # (don't finish the device, testing the finalize method's cleanup)
216
217 ####
218 ## Now some full device tests
219
220 ## VFS device
221
222 $vtape1 = mkvtape(1);
223 $dev_name = "file:$vtape1";
224
225 $dev = Amanda::Device->new($dev_name);
226 is($dev->status(), $DEVICE_STATUS_SUCCESS,
227     "$dev_name: create successful")
228     or diag($dev->error_or_status());
229
230 properties_include([ $dev->property_list() ],
231     [ @common_properties, 'max_volume_usage' ],
232     "necessary properties listed on vfs device");
233
234 # play with properties a little bit
235 ok($dev->property_set("comment", 16),
236     "set an string property to an integer");
237
238 ok($dev->property_set("comment", 16.0),
239     "set an string property to a float");
240
241 ok($dev->property_set("comment", "hi mom"),
242     "set an string property to a string");
243
244 ok($dev->property_set("comment", "32768"),
245     "set an integer property to a simple string");
246
247 ok($dev->property_set("comment", "32k"),
248     "set an integer property to a string with a unit");
249
250 ok($dev->property_set("block_size", 32768),
251     "set an integer property to an integer");
252
253 ok(!($dev->property_set("invalid-property-name", 32768)),
254     "set an invalid-property-name");
255
256 $dev->read_label();
257 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
258     "initially unlabeled")
259     or diag($dev->error_or_status());
260
261 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
262     "start in write mode")
263     or diag($dev->error_or_status());
264
265 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
266     "not unlabeled anymore")
267     or diag($dev->error_or_status());
268
269 for (my $i = 1; $i <= 3; $i++) {
270     write_file(0x2FACE, $dev->block_size()*10+17, $i);
271 }
272
273 ok($dev->finish(),
274     "finish device after write")
275     or diag($dev->error_or_status());
276
277 $dev->read_label();
278 ok(!($dev->status()),
279     "no error, at all, from read_label")
280     or diag($dev->error_or_status());
281
282 # append one more copy, to test ACCESS_APPEND
283
284 ok($dev->start($ACCESS_APPEND, undef, undef),
285     "start in append mode")
286     or diag($dev->error_or_status());
287
288 write_file(0xD0ED0E, $dev->block_size()*4, 4);
289
290 ok($dev->finish(),
291     "finish device after append")
292     or diag($dev->error_or_status());
293
294 # try reading the third file back, creating a new device
295 # object first, and skipping the read-label step.
296
297 $dev = undef;
298 $dev = Amanda::Device->new($dev_name);
299 is($dev->status(), $DEVICE_STATUS_SUCCESS,
300     "$dev_name: re-create successful")
301     or diag($dev->error_or_status());
302
303 ok($dev->start($ACCESS_READ, undef, undef),
304     "start in read mode")
305     or diag($dev->error_or_status());
306
307 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
308
309 {
310     # try two seek_file's in a row
311     my $hdr = $dev->seek_file(3);
312     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
313     $hdr = $dev->seek_file(3);
314     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
315 }
316
317 ok($dev->finish(),
318     "finish device after read")
319     or diag($dev->error_or_status());
320
321 # test erase
322 ok($dev->erase(),
323    "erase device")
324     or diag($dev->error_or_status());
325
326 ok($dev->erase(),
327    "erase device (again)")
328     or diag($dev->error_or_status());
329
330 ok($dev->finish(),
331    "finish device after erase")
332     or diag($dev->error_or_status());
333
334 # test monitor_free_space property (testing the monitoring would require a
335 # dedicated partition for the tests - it's not worth it)
336
337 ok($dev->property_get("monitor_free_space"),
338     "monitor_free_space property is set by default");
339
340 ok($dev->property_set("monitor_free_space", 0),
341     "monitor_free_space property can be set to false");
342
343 ok(!$dev->property_get("monitor_free_space"),
344     "monitor_free_space property value 'sticks'");
345
346 # test the LEOM functionality
347
348 $dev = undef;
349 $dev = Amanda::Device->new($dev_name);
350 is($dev->status(), $DEVICE_STATUS_SUCCESS,
351     "$dev_name: re-create successful")
352     or diag($dev->error_or_status());
353 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
354     "set MAX_VOLUME_USAGE to test LEOM");
355 ok($dev->property_set("LEOM", 1),
356     "set LEOM");
357 ok($dev->property_set("ENFORCE_MAX_VOLUME_USAGE", 0),
358     "set ENFORCE_MAX_VOLUME_USAGE");
359
360 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
361     "start in write mode")
362     or diag($dev->error_or_status());
363
364 ok($dev->start_file($dumpfile),
365     "start file 1")
366     or diag($dev->error_or_status());
367
368 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
369     "write random data into the early-warning zone");
370
371 ok(!$dev->is_eom,
372     "device does not indicates LEOM after writing when ENFORCE_MAX_VOLUME_USAGE is FALSE");
373
374 ok($dev->finish_file(),
375     "..but a finish_file is allowed to complete")
376     or diag($dev->error_or_status());
377
378 ok($dev->finish(),
379    "finish device after LEOM test")
380     or diag($dev->error_or_status());
381
382 $dev = undef;
383 $dev = Amanda::Device->new($dev_name);
384 is($dev->status(), $DEVICE_STATUS_SUCCESS,
385     "$dev_name: re-create successful")
386     or diag($dev->error_or_status());
387 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
388     "set MAX_VOLUME_USAGE to test LEOM");
389 ok($dev->property_set("LEOM", 1),
390     "set LEOM");
391 ok($dev->property_set("ENFORCE_MAX_VOLUME_USAGE", 1),
392     "set ENFORCE_MAX_VOLUME_USAGE");
393
394 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
395     "start in write mode")
396     or diag($dev->error_or_status());
397
398 ok($dev->start_file($dumpfile),
399     "start file 1")
400     or diag($dev->error_or_status());
401
402 ok(!$dev->is_eom,
403     "device does not indicate LEOM before writing");
404
405 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
406     "write random data into the early-warning zone");
407
408 ok($dev->is_eom,
409     "device indicates LEOM after writing");
410
411 ok($dev->finish_file(),
412     "..but a finish_file is allowed to complete")
413     or diag($dev->error_or_status());
414
415 ok($dev->finish(),
416    "finish device after LEOM test")
417     or diag($dev->error_or_status());
418
419 $dev = undef;
420 $dev = Amanda::Device->new($dev_name);
421 is($dev->status(), $DEVICE_STATUS_SUCCESS,
422     "$dev_name: re-create successful")
423     or diag($dev->error_or_status());
424 ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
425     "set MAX_VOLUME_USAGE to test LEOM");
426 ok($dev->property_set("LEOM", 1),
427     "set LEOM");
428
429 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
430     "start in write mode")
431     or diag($dev->error_or_status());
432
433 ok($dev->start_file($dumpfile),
434     "start file 1")
435     or diag($dev->error_or_status());
436
437 ok(!$dev->is_eom,
438     "device does not indicate LEOM before writing");
439
440 ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
441     "write random data into the early-warning zone");
442
443 ok($dev->is_eom,
444     "device indicates LEOM after writing as default value of ENFORCE_MAX_VOLUME_USAGE is true for vfs device");
445
446 ok($dev->finish_file(),
447     "..but a finish_file is allowed to complete")
448     or diag($dev->error_or_status());
449
450 ok($dev->finish(),
451    "finish device after LEOM test")
452     or diag($dev->error_or_status());
453
454 $dev = undef;
455 $dev = Amanda::Device->new($dev_name);
456 is($dev->status(), $DEVICE_STATUS_SUCCESS,
457     "$dev_name: re-create successful")
458     or diag($dev->error_or_status());
459 ok($dev->property_set("MAX_VOLUME_USAGE", "160k"),
460     "set MAX_VOLUME_USAGE to test LEOM while writing the first header");
461 ok($dev->property_set("LEOM", 1),
462     "set LEOM");
463
464 ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
465     "start in write mode")
466     or diag($dev->error_or_status());
467
468 ok($dev->start_file($dumpfile),
469     "start file 1")
470     or diag($dev->error_or_status());
471
472 ok($dev->is_eom,
473     "device indicates LEOM after writing first header");
474
475 ok($dev->finish_file(),
476     "..but a finish_file is allowed to complete")
477     or diag($dev->error_or_status());
478
479 ok($dev->finish(),
480    "finish device after LEOM test")
481     or diag($dev->error_or_status());
482
483 ####
484 ## Test a RAIT device of two vfs devices.
485
486 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
487 $dev_name = "rait:file:{$vtape1,$vtape2}";
488
489 $dev = Amanda::Device->new($dev_name);
490 is($dev->status(), $DEVICE_STATUS_SUCCESS,
491    "$dev_name: create successful")
492     or diag($dev->error_or_status());
493
494 ok($dev->configure(1), "configure device");
495
496 properties_include([ $dev->property_list() ], [ @common_properties ],
497     "necessary properties listed on rait device");
498
499 is($dev->property_get("block_size"), 32768, # (RAIT default)
500     "rait device calculates a default block size correctly");
501
502 ok($dev->property_set("block_size", 32768*16),
503     "rait device accepts an explicit block size");
504
505 is($dev->property_get("block_size"), 32768*16,
506     "..and remembers it");
507
508 ok($dev->property_set("max_volume_usage", 32768*1000),
509     "rait device accepts property MAX_VOLUME_USAGE");
510
511 is($dev->property_get("max_volume_usage"), 32768*1000,
512     "..and remembers it");
513
514 $dev->read_label();
515 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
516    "initially unlabeled")
517     or diag($dev->error_or_status());
518
519 ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
520    "start in write mode")
521     or diag($dev->error_or_status());
522
523 ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
524    "not unlabeled anymore")
525     or diag($dev->error_or_status());
526
527 for (my $i = 1; $i <= 3; $i++) {
528     write_file(0x2FACE, $dev->block_size()*10+17, $i);
529 }
530
531 ok($dev->finish(),
532    "finish device after write")
533     or diag($dev->error_or_status());
534
535 $dev->read_label();
536 ok(!($dev->status()),
537    "no error, at all, from read_label")
538     or diag($dev->error_or_status());
539
540 # append one more copy, to test ACCESS_APPEND
541
542 ok($dev->start($ACCESS_APPEND, undef, undef),
543    "start in append mode")
544     or diag($dev->error_or_status());
545
546 write_file(0xD0ED0E, $dev->block_size()*4, 4);
547
548 ok($dev->finish(),
549    "finish device after append")
550     or diag($dev->error_or_status());
551
552 # try reading the third file back, creating a new device
553 # object first, and skipping the read-label step.
554
555 $dev = undef;
556 $dev = Amanda::Device->new($dev_name);
557 is($dev->status(), $DEVICE_STATUS_SUCCESS,
558     "$dev_name: re-create successful")
559     or diag($dev->error_or_status());
560
561 ok($dev->start($ACCESS_READ, undef, undef),
562    "start in read mode")
563     or diag($dev->error_or_status());
564
565 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
566
567 ok($dev->finish(),
568    "finish device after read")
569     or diag($dev->error_or_status());
570
571 ok($dev->start($ACCESS_READ, undef, undef),
572    "start in read mode after missing volume")
573     or diag($dev->error_or_status());
574
575 # corrupt the device somehow and hope it keeps working
576 rmtree("$taperoot/1");
577
578 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
579 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
580 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
581
582 ok($dev->finish(),
583    "finish device read after missing volume")
584     or diag($dev->error_or_status());
585
586 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
587    "start in write mode fails with missing volume")
588     or diag($dev->error_or_status());
589
590 undef $dev;
591
592 $dev_name = "rait:{file:$vtape2,MISSING}";
593 $dev = Amanda::Device->new($dev_name);
594
595 ok($dev->start($ACCESS_READ, undef, undef),
596    "start in read mode with MISSING")
597     or diag($dev->error_or_status());
598
599 verify_file(0x2FACE, $dev->block_size()*10+17, 3);
600 verify_file(0xD0ED0E, $dev->block_size()*4, 4);
601 verify_file(0x2FACE, $dev->block_size()*10+17, 2);
602
603 ok($dev->finish(),
604    "finish device read with MISSING")
605     or diag($dev->error_or_status());
606
607 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
608    "start in write mode fails with MISSING")
609     or diag($dev->error_or_status());
610
611 undef $dev;
612
613 $dev = Amanda::Device->new_rait_from_children(
614     Amanda::Device->new("file:$vtape2"), undef);
615
616 ok(!($dev->start($ACCESS_WRITE, "TESTCONF29", undef)),
617    "start a RAIT device in write mode fails, when created with 'undef'")
618     or diag($dev->error_or_status());
619
620 # Make two devices with different labels, should get a
621 # message accordingly.
622 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
623
624 my $n = 13;
625 for $dev_name ("file:$vtape1", "file:$vtape2") {
626     my $dev = Amanda::Device->new($dev_name);
627     is($dev->status(), $DEVICE_STATUS_SUCCESS,
628        "$dev_name: Open successful")
629         or diag($dev->error_or_status());
630     ok($dev->start($ACCESS_WRITE, "TESTCONF$n", undef),
631         "wrote label 'TESTCONF$n'");
632     ok($dev->finish(), "finished device");
633     $n++;
634 }
635
636 $dev = Amanda::Device->new_rait_from_children(
637     Amanda::Device->new("file:$vtape1"),
638     Amanda::Device->new("file:$vtape2"));
639 is($dev->status(), $DEVICE_STATUS_SUCCESS,
640    "new_rait_from_children: Open successful")
641     or diag($dev->error_or_status());
642
643 $dev->read_label();
644 ok($dev->status() & $DEVICE_STATUS_VOLUME_ERROR,
645    "Label mismatch error handled correctly")
646     or diag($dev->error_or_status());
647
648 # Use some config to set a block size on a child device
649 ($vtape1, $vtape2) = (mkvtape(1), mkvtape(2));
650 $dev_name = "rait:{file:$vtape1,mytape2}";
651
652 $testconf = Installcheck::Config->new();
653 $testconf->add_device("mytape2", [
654     "tapedev" => "\"file:$vtape2\"",
655     "device_property" => "\"BLOCK_SIZE\" \"64k\""
656 ]);
657 $testconf->write();
658 config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
659     or die("Could not load configuration");
660
661 $dev = Amanda::Device->new($dev_name);
662 is($dev->status(), $DEVICE_STATUS_SUCCESS,
663    "$dev_name: create successful")
664     or diag($dev->error_or_status());
665
666 ok($dev->configure(1), "configure device");
667
668 is($dev->property_get("block_size"), 65536,
669     "rait device calculates a block size from its children correctly");
670
671 # Test an S3 device if the proper environment variables are set
672 my $S3_SECRET_KEY = $ENV{'INSTALLCHECK_S3_SECRET_KEY'};
673 my $S3_ACCESS_KEY = $ENV{'INSTALLCHECK_S3_ACCESS_KEY'};
674 my $DEVPAY_SECRET_KEY = $ENV{'INSTALLCHECK_DEVPAY_SECRET_KEY'};
675 my $DEVPAY_ACCESS_KEY = $ENV{'INSTALLCHECK_DEVPAY_ACCESS_KEY'};
676 my $DEVPAY_USER_TOKEN = $ENV{'INSTALLCHECK_DEVPAY_USER_TOKEN'};
677
678 my $run_s3_tests = defined $S3_SECRET_KEY && defined $S3_ACCESS_KEY;
679 my $run_devpay_tests = defined $DEVPAY_SECRET_KEY &&
680     defined $DEVPAY_ACCESS_KEY && $DEVPAY_USER_TOKEN;
681
682 my $s3_make_device_count = 7;
683 sub s3_make_device($$) {
684     my ($dev_name, $kind) = @_;
685     $dev = Amanda::Device->new($dev_name);
686     is($dev->status(), $DEVICE_STATUS_SUCCESS,
687        "$dev_name: create successful")
688         or diag($dev->error_or_status());
689
690     my @s3_props = ( 's3_access_key', 's3_secret_key' );
691     push @s3_props, 's3_user_token' if ($kind eq "devpay");
692     properties_include([ $dev->property_list() ], [ @common_properties, @s3_props ],
693         "necessary properties listed on s3 device");
694
695     ok($dev->property_set('BLOCK_SIZE', 32768*2),
696         "set block size")
697         or diag($dev->error_or_status());
698
699     # might as well save a few cents while testing this property..
700     ok($dev->property_set('S3_STORAGE_CLASS', 'REDUCED_REDUNDANCY'),
701         "set storage class")
702         or diag($dev->error_or_status());
703
704     if ($kind eq "s3") {
705         # use regular S3 credentials
706         ok($dev->property_set('S3_ACCESS_KEY', $S3_ACCESS_KEY),
707            "set S3 access key")
708         or diag($dev->error_or_status());
709
710         ok($dev->property_set('S3_SECRET_KEY', $S3_SECRET_KEY),
711            "set S3 secret key")
712             or diag($dev->error_or_status());
713
714         pass("(placeholder)");
715     } elsif ($kind eq "devpay") {
716         # use devpay credentials
717         ok($dev->property_set('S3_ACCESS_KEY', $DEVPAY_ACCESS_KEY),
718            "set devpay access key")
719         or diag($dev->error_or_status());
720
721         ok($dev->property_set('S3_SECRET_KEY', $DEVPAY_SECRET_KEY),
722            "set devpay secret key")
723             or diag($dev->error_or_status());
724
725         ok($dev->property_set('S3_USER_TOKEN', $DEVPAY_USER_TOKEN),
726            "set devpay user token")
727             or diag($dev->error_or_status());
728     } else {
729         croak("didn't recognize the device kind, so no credentials were set");
730     }
731     return $dev;
732 }
733
734 my $base_name;
735
736 SKIP: {
737     skip "define \$INSTALLCHECK_S3_{SECRET,ACCESS}_KEY to run S3 tests",
738             101 +
739             1 * $verify_file_count +
740             7 * $write_file_count +
741             13 * $s3_make_device_count
742         unless $run_s3_tests;
743
744     $dev_name = "s3:";
745     $dev = Amanda::Device->new($dev_name);
746     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
747          "creating $dev_name fails miserably");
748
749     $dev_name = "s3:foo";
750     $dev = Amanda::Device->new($dev_name);
751
752     ok($dev->property_get("full_deletion"),
753        "property_get(full_deletion) on s3 device");
754
755     ok($dev->property_get("leom"),
756        "property_get(leom) on s3 device");
757
758     # test parsing of boolean values
759     # (s3 is the only device driver that has a writable boolean property at the
760     # moment)
761
762     my @verbose_vals = (
763         {'val' => '1', 'true' => 1},
764         {'val' => '0', 'true' => 0},
765         {'val' => 't', 'true' => 1},
766         {'val' => 'true', 'true' => 1},
767         {'val' => 'f', 'true' => 0},
768         {'val' => 'false', 'true' => 0},
769         {'val' => 'y', 'true' => 1},
770         {'val' => 'yes', 'true' => 1},
771         {'val' => 'n', 'true' => 0},
772         {'val' => 'no', 'true' => 0},
773         {'val' => 'on', 'true' => 1},
774         {'val' => 'off', 'true' => 0},
775         {'val' => 'oFf', 'true' => 0},
776         );
777
778     foreach my $v (@verbose_vals) {
779         $dev_name = "s3:foo";
780         $dev = Amanda::Device->new($dev_name);
781
782         $testconf = Installcheck::Config->new();
783         $testconf->add_param("device_property", "\"verbose\" \"$v->{'val'}\"");
784         $testconf->write();
785         config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
786             or die("Could not load configuration");
787
788         ok($dev->configure(1),
789            "configured device with verbose set to $v->{'val'}")
790             or diag($dev->error_or_status());
791
792         my $get_val = $dev->property_get('verbose');
793         # see if truth-iness matches
794         my $expec = $v->{'true'}? "true" : "false";
795         is(!!$dev->property_get('verbose'), !!$v->{'true'},
796            "device_property 'VERBOSE' '$v->{'val'}' => property_get(verbose) returning $expec");
797     }
798
799     # test unparsable property
800     $dev_name = "s3:foo";
801     $dev = Amanda::Device->new($dev_name);
802
803     $testconf = Installcheck::Config->new();
804     $testconf->add_param("device_property", "\"verbose\" \"foo\"");
805     $testconf->write();
806     config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF') == $CFGERR_OK
807         or die("Could not load configuration");
808
809     ok(!$dev->configure(1),
810        "failed to configure device with verbose set to foo");
811
812     like($dev->error_or_status(), qr/'verbose'/,
813          "error message mentions property name");
814
815     like($dev->error_or_status(), qr/'foo'/,
816          "error message mentions property value");
817
818     like($dev->error_or_status(), qr/gboolean/,
819          "error message mentions property type");
820
821     my $hostname  = hostname();
822     $hostname =~ s/\./-/g;
823     $base_name = "$S3_ACCESS_KEY-installcheck-$hostname";
824     $dev_name = "s3:$base_name-s3";
825     $dev = s3_make_device($dev_name, "s3");
826     $dev->read_label();
827     my $status = $dev->status();
828     # this test appears very liberal, but catches the case where setup_handle fails without
829     # giving false positives
830     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
831        "status is either OK or possibly unlabeled")
832         or diag($dev->error_or_status());
833
834     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
835        "start in write mode")
836         or diag($dev->error_or_status());
837
838     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
839        "it's labeled now")
840         or diag($dev->error_or_status());
841
842     for (my $i = 1; $i <= 3; $i++) {
843         write_file(0x2FACE, $dev->block_size()*10, $i);
844     }
845
846     ok($dev->finish(),
847        "finish device after write")
848         or diag($dev->error_or_status());
849
850     $dev->read_label();
851     ok(!($dev->status()),
852        "no error, at all, from read_label")
853         or diag($dev->error_or_status());
854
855     # append one more copy, to test ACCESS_APPEND
856
857     ok($dev->start($ACCESS_APPEND, undef, undef),
858        "start in append mode")
859         or diag($dev->error_or_status());
860
861     write_file(0xD0ED0E, $dev->block_size()*10, 4);
862
863     ok($dev->finish(),
864        "finish device after append")
865         or diag($dev->error_or_status());
866
867     # try reading the third file back
868
869     ok($dev->start($ACCESS_READ, undef, undef),
870        "start in read mode")
871         or diag($dev->error_or_status());
872
873     verify_file(0x2FACE, $dev->block_size()*10, 3);
874
875     # test EOT indications on reading
876     my $hdr = $dev->seek_file(4);
877     is($hdr->{'type'}, $Amanda::Header::F_DUMPFILE,
878         "file 4 has correct type F_DUMPFILE");
879
880     $hdr = $dev->seek_file(5);
881     is($hdr->{'type'}, $Amanda::Header::F_TAPEEND,
882         "file 5 has correct type F_TAPEEND");
883
884     $hdr = $dev->seek_file(6);
885     is($hdr, undef, "seek_file returns undef for file 6");
886
887     ok($dev->finish(),
888        "finish device after read")
889         or diag($dev->error_or_status());    # (note: we don't use write_max_size here,
890                                              # as the maximum for S3 is very large)
891
892     ok($dev->erase(),
893        "erase device")
894        or diag($dev->error_or_status());
895
896     ok($dev->erase(),
897        "erase device (again)")
898        or diag($dev->error_or_status());
899
900     ok($dev->finish(),
901        "finish device after erase")
902         or diag($dev->error_or_status());
903
904     $dev->read_label();
905     $status = $dev->status();
906     ok($status & $DEVICE_STATUS_VOLUME_UNLABELED,
907        "status is unlabeled after an erase")
908         or diag($dev->error_or_status());
909
910     $dev = s3_make_device($dev_name, "s3");
911
912     ok($dev->erase(),
913        "erase device right after creation")
914        or diag($dev->error_or_status());
915
916     $dev = s3_make_device($dev_name, "s3");
917
918     # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=false
919     ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
920        "set MAX_VOLUME_USAGE to test LEOM");
921
922     ok($dev->property_set("LEOM", 1),
923         "set LEOM");
924
925     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef), 
926        "start in write mode")
927         or diag($dev->error_or_status());
928
929     write_file(0x2FACE, 440*1024, 1);
930
931     ok(!$dev->is_eom,
932         "device does not indicate LEOM after writing as property ENFORCE_MAX_VOLUME_USAGE not set and its default value is false");
933
934     ok($dev->finish(),
935        "finish device after LEOM test")
936        or diag($dev->error_or_status());
937     
938     ok($dev->erase(),
939        "erase device")
940        or diag($dev->error_or_status());
941     
942     $dev = s3_make_device($dev_name, "s3");
943
944     # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=true
945     ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
946        "set MAX_VOLUME_USAGE to test LEOM");
947
948     ok($dev->property_set('ENFORCE_MAX_VOLUME_USAGE', 1 ),
949        "set ENFORCE_MAX_VOLUME_USAGE");
950
951     ok($dev->property_set("LEOM", 1),
952         "set LEOM");
953
954     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef), 
955        "start in write mode")
956         or diag($dev->error_or_status());
957
958     write_file(0x2FACE, 440*1024, 1);
959
960     ok($dev->is_eom,
961         "device indicates LEOM after writing, when property ENFORCE_MAX_VOLUME_USAGE set to true");
962
963     ok($dev->finish(),
964        "finish device after LEOM test")
965        or diag($dev->error_or_status());
966
967     ok($dev->erase(),
968        "erase device")
969        or diag($dev->error_or_status());
970     
971     $dev = s3_make_device($dev_name, "s3");
972
973     # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=false
974     ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
975        "set MAX_VOLUME_USAGE to test LEOM");
976
977     ok($dev->property_set('ENFORCE_MAX_VOLUME_USAGE', 0 ),
978        "set ENFORCE_MAX_VOLUME_USAGE");
979
980     ok($dev->property_set("LEOM", 1),
981         "set LEOM");
982
983     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef), 
984        "start in write mode")
985         or diag($dev->error_or_status());
986
987     write_file(0x2FACE, 440*1024, 1);
988
989     ok(!$dev->is_eom,
990         "device does not indicate LEOM after writing, when property ENFORCE_MAX_VOLUME_USAGE set to false");
991
992     ok($dev->finish(),
993        "finish device after LEOM test")
994        or diag($dev->error_or_status());
995     
996     ok($dev->erase(),
997        "erase device")
998        or diag($dev->error_or_status());
999     
1000     # try with empty user token
1001     $dev_name = lc("s3:$base_name-s3");
1002     $dev = s3_make_device($dev_name, "s3");
1003     ok($dev->property_set('S3_USER_TOKEN', ''),
1004        "set devpay user token")
1005         or diag($dev->error_or_status());
1006
1007     $dev->read_label();
1008     $status = $dev->status();
1009     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1010        "status is either OK or possibly unlabeled")
1011         or diag($dev->error_or_status());
1012
1013     $dev->finish();
1014
1015     ok($dev->erase(),
1016        "erase device")
1017        or diag($dev->error_or_status());
1018
1019     # try a eu-constrained bucket
1020     $dev_name = lc("s3:$base_name-s3-eu");
1021     $dev = s3_make_device($dev_name, "s3");
1022     ok($dev->property_set('S3_BUCKET_LOCATION', 'EU'),
1023        "set S3 bucket location to 'EU'")
1024         or diag($dev->error_or_status());
1025
1026     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1027        "start in write mode")
1028         or diag($dev->error_or_status());
1029
1030     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1031        "status is OK")
1032         or diag($dev->error_or_status());
1033
1034     $dev->finish();
1035
1036     ok($dev->erase(),
1037        "erase device")
1038        or diag($dev->error_or_status());
1039
1040     # try a wildcard-constrained bucket
1041     $dev_name = lc("s3:$base_name-s3-wild");
1042     $dev = s3_make_device($dev_name, "s3");
1043     ok($dev->property_set('S3_BUCKET_LOCATION', '*'),
1044        "set S3 bucket location to ''")
1045         or diag($dev->error_or_status());
1046
1047     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1048        "start in write mode")
1049         or diag($dev->error_or_status());
1050
1051     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1052        "status is OK")
1053         or diag($dev->error_or_status());
1054
1055     $dev->finish();
1056
1057     # test again with invalid ca_info
1058     $dev = s3_make_device($dev_name, "s3");
1059     SKIP: {
1060         skip "SSL not supported; can't check SSL_CA_INFO", 2
1061             unless $dev->property_get('S3_SSL');
1062
1063         ok($dev->property_set('SSL_CA_INFO', '/dev/null'),
1064            "set invalid SSL/TLS CA certificate")
1065             or diag($dev->error_or_status());
1066
1067         ok(!$dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1068            "start in write mode")
1069             or diag($dev->error_or_status());
1070
1071         isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1072            "status is OK")
1073             or diag($dev->error_or_status());
1074
1075         $dev->finish();
1076     }
1077
1078     # test again with our own CA bundle
1079     $dev = s3_make_device($dev_name, "s3");
1080     SKIP: {
1081         skip "SSL not supported; can't check SSL_CA_INFO", 4
1082             unless $dev->property_get('S3_SSL');
1083         ok($dev->property_set('SSL_CA_INFO', "$srcdir/data/aws-bundle.crt"),
1084            "set our own SSL/TLS CA certificate bundle")
1085             or diag($dev->error_or_status());
1086
1087         ok($dev->erase(),
1088            "erase device")
1089             or diag($dev->error_or_status());
1090
1091         ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1092            "start in write mode")
1093             or diag($dev->error_or_status());
1094
1095         is($dev->status(), $DEVICE_STATUS_SUCCESS,
1096            "status is OK")
1097             or diag($dev->error_or_status());
1098
1099         $dev->finish();
1100     }
1101
1102     ok($dev->erase(),
1103        "erase device")
1104        or diag($dev->error_or_status());
1105
1106     # bucket names incompatible with location constraint
1107     $dev_name = "s3:-$base_name-s3-eu";
1108     $dev = s3_make_device($dev_name, "s3");
1109
1110     ok($dev->property_set('S3_BUCKET_LOCATION', ''),
1111        "should be able to set an empty S3 bucket location with an incompatible name")
1112         or diag($dev->error_or_status());
1113
1114     $dev_name = "s3:$base_name-s3.eu";
1115     $dev = s3_make_device($dev_name, "s3");
1116
1117     ok($dev->property_set('S3_BUCKET_LOCATION', ''),
1118        "should be able to set an empty S3 bucket location with an incompatible name")
1119         or diag($dev->error_or_status());
1120
1121     $dev_name = "s3:-$base_name-s3-eu";
1122     $dev = s3_make_device($dev_name, "s3");
1123
1124     ok(!$dev->property_set('S3_BUCKET_LOCATION', 'EU'),
1125        "should not be able to set S3 bucket location with an incompatible name")
1126         or diag($dev->error_or_status());
1127
1128     $dev_name = lc("s3:$base_name-s3-eu");
1129     $dev = s3_make_device($dev_name, "s3");
1130     ok($dev->property_set('S3_BUCKET_LOCATION', 'XYZ'),
1131        "should be able to set S3 bucket location with a compatible name")
1132         or diag($dev->error_or_status());
1133     $dev->read_label();
1134     $status = $dev->status();
1135     ok(($status == $DEVICE_STATUS_DEVICE_ERROR),
1136        "status is DEVICE_STATUS_DEVICE_ERROR")
1137         or diag($dev->error_or_status());
1138     my $error_msg = $dev->error_or_status();
1139     ok(($dev->error_or_status() == "While creating new S3 bucket: The specified location-constraint is not valid (Unknown) (HTTP 400)"),
1140        "invalid location-constraint")
1141        or diag("bad error: " . $dev->error_or_status());
1142
1143 }
1144
1145 SKIP: {
1146     # in this case, most of our code has already been exercised
1147     # just make sure that authentication works as a basic sanity check
1148     skip "skipping abbreviated devpay tests", $s3_make_device_count + 1
1149         unless $run_devpay_tests;
1150     $dev_name = "s3:$base_name-devpay";
1151     $dev = s3_make_device($dev_name, "devpay");
1152     $dev->read_label();
1153     my $status = $dev->status();
1154     # this test appears very liberal, but catches the case where setup_handle fails without
1155     # giving false positives
1156     ok(($status == 0) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1157        "status is either OK or possibly unlabeled")
1158         or diag($dev->error_or_status());
1159 }
1160
1161 # Test a tape device if the proper environment variables are set
1162 my $TAPE_DEVICE = $ENV{'INSTALLCHECK_TAPE_DEVICE'};
1163 my $run_tape_tests = defined $TAPE_DEVICE;
1164 SKIP: {
1165     skip "define \$INSTALLCHECK_TAPE_DEVICE to run tape tests",
1166             30 +
1167             7 * $verify_file_count +
1168             5 * $write_file_count
1169         unless $run_tape_tests;
1170
1171     $dev_name = "tape:$TAPE_DEVICE";
1172     $dev = Amanda::Device->new($dev_name);
1173     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1174         "$dev_name: create successful")
1175         or diag($dev->error_or_status());
1176
1177     my $status = $dev->read_label();
1178     ok(($status == $DEVICE_STATUS_SUCCESS) || (($status & $DEVICE_STATUS_VOLUME_UNLABELED) != 0),
1179        "status is either OK or possibly unlabeled")
1180         or diag($dev->error_or_status());
1181
1182     ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef),
1183         "start in write mode")
1184         or diag($dev->error_or_status());
1185
1186     ok(!($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED),
1187         "not unlabeled anymore")
1188         or diag($dev->error_or_status());
1189
1190     for (my $i = 1; $i <= 4; $i++) {
1191         write_file(0x2FACE+$i, $dev->block_size()*10+17, $i);
1192     }
1193
1194     ok($dev->finish(),
1195         "finish device after write")
1196         or diag($dev->error_or_status());
1197
1198     $dev->read_label();
1199     ok(!($dev->status()),
1200         "no error, at all, from read_label")
1201         or diag($dev->error_or_status());
1202
1203     is($dev->volume_label(), "TESTCONF13",
1204         "read_label reads the correct label")
1205         or diag($dev->error_or_status());
1206
1207     # append one more copy, to test ACCESS_APPEND
1208
1209     # if final_filemarks is 1, then the tape device will use F_NOOP,
1210     # inserting an extra file, and we'll be appending at file number 6.
1211     my $append_fileno = ($dev->property_get("FINAL_FILEMARKS") == 2)? 5:6;
1212
1213     SKIP: {
1214         skip "APPEND not supported", $write_file_count + 2
1215             unless $dev->property_get("APPENDABLE");
1216
1217         ok($dev->start($ACCESS_APPEND, undef, undef),
1218             "start in append mode")
1219             or diag($dev->error_or_status());
1220
1221         write_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1222
1223         ok($dev->finish(),
1224             "finish device after append")
1225             or diag($dev->error_or_status());
1226     }
1227
1228     # try reading the second and third files back, creating a new
1229     # device object first, and skipping the read-label step.
1230
1231     $dev = undef;
1232     $dev = Amanda::Device->new($dev_name);
1233     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1234         "$dev_name: re-create successful")
1235         or diag($dev->error_or_status());
1236
1237     # use a big read_block_size, checking that it's also settable
1238     # via read_buffer_size
1239     ok($dev->property_set("read_buffer_size", 256*1024),
1240         "can set read_buffer_size");
1241     is($dev->property_get("read_block_size"), 256*1024,
1242         "and its value is reflected in read_block_size");
1243     ok($dev->property_set("read_block_size", 32*1024),
1244         "can set read_block_size");
1245
1246     ok($dev->start($ACCESS_READ, undef, undef),
1247         "start in read mode")
1248         or diag($dev->error_or_status());
1249
1250     # now verify those files in a particular order to trigger all of the
1251     # seeking edge cases
1252
1253     verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
1254     verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1255     verify_file(0x2FACE+4, $dev->block_size()*10+17, 4);
1256     verify_file(0x2FACE+3, $dev->block_size()*10+17, 3);
1257     verify_file(0x2FACE+1, $dev->block_size()*10+17, 1);
1258
1259     # try re-seeking to the same file
1260     ok(header_for($dev->seek_file(2), 2), "seek to file 2 the first time");
1261     verify_file(0x2FACE+2, $dev->block_size()*10+17, 2);
1262     ok(header_for($dev->seek_file(2), 2), "seek to file 2 the third time");
1263
1264     # and seek through the same pattern *without* reading to EOF
1265     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1266     ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1267     ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1268     ok(header_for($dev->seek_file(3), 3), "seek to file 3");
1269     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1270
1271     SKIP: {
1272         skip "APPEND not supported", $verify_file_count
1273             unless $dev->property_get("APPENDABLE");
1274         verify_file(0xD0ED0E, $dev->block_size()*4, $append_fileno);
1275     }
1276
1277     ok($dev->finish(),
1278         "finish device after read")
1279         or diag($dev->error_or_status());
1280
1281     # tickle a regression in improperly closing fd's
1282     ok($dev->finish(),
1283         "finish device again after read")
1284         or diag($dev->error_or_status());
1285
1286     ok($dev->read_label() == $DEVICE_STATUS_SUCCESS,
1287         "read_label after second finish (used to fail)")
1288         or diag($dev->error_or_status());
1289
1290     # finally, run the device with FSF and BSF set to "no", to test the
1291     # fallback schemes for this condition
1292
1293     $dev = undef;
1294     $dev = Amanda::Device->new($dev_name);
1295     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1296         "$dev_name: re-create successful")
1297         or diag($dev->error_or_status());
1298     $dev->property_set("fsf", "no");
1299     $dev->property_set("bsf", "no");
1300
1301     ok($dev->start($ACCESS_READ, undef, undef),
1302         "start in read mode")
1303         or diag($dev->error_or_status());
1304
1305     ok(header_for($dev->seek_file(1), 1), "seek to file 1");
1306     ok(header_for($dev->seek_file(4), 4), "seek to file 4");
1307     ok(header_for($dev->seek_file(2), 2), "seek to file 2");
1308
1309     ok($dev->finish(),
1310         "finish device after read")
1311         or diag($dev->error_or_status());
1312 }
1313
1314 SKIP: {
1315     skip "not built with ndmp and server", 78 unless
1316         Amanda::Util::built_with_component("ndmp") and
1317         Amanda::Util::built_with_component("server");
1318
1319     my $dev;
1320     my $testconf = Installcheck::Config->new();
1321     $testconf->write();
1322
1323     my $cfg_result = config_init($CONFIG_INIT_EXPLICIT_NAME, 'TESTCONF');
1324     if ($cfg_result != $CFGERR_OK) {
1325         my ($level, @errors) = Amanda::Config::config_errors();
1326         die(join "\n", @errors);
1327     }
1328
1329     my $ndmp = Installcheck::Mock::NdmpServer->new();
1330     my $ndmp_port = $ndmp->{'port'};
1331     my $drive = $ndmp->{'drive'};
1332     pass("started ndmjob in daemon mode");
1333
1334     # set up a header for use below
1335     my $hdr = Amanda::Header->new();
1336     $hdr->{type} = $Amanda::Header::F_DUMPFILE;
1337     $hdr->{datestamp} = "20070102030405";
1338     $hdr->{dumplevel} = 0;
1339     $hdr->{compressed} = 1;
1340     $hdr->{name} = "localhost";
1341     $hdr->{disk} = "/home";
1342     $hdr->{program} = "INSTALLCHECK";
1343
1344     $dev = Amanda::Device->new("ndmp:127.0.0.1:9i1\@foo");
1345     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1346         "creation of an ndmp device fails with invalid port");
1347
1348     $dev = Amanda::Device->new("ndmp:127.0.0.1:90000\@foo");
1349     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1350         "creation of an ndmp device fails with too-large port");
1351
1352     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port");
1353     isnt($dev->status(), $DEVICE_STATUS_SUCCESS,
1354         "creation of an ndmp device fails without ..\@device_name");
1355
1356     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1357     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1358         "creation of an ndmp device succeeds with correct syntax");
1359
1360     ok($dev->property_set("ndmp_username", "foo"),
1361         "set ndmp_username property");
1362     is($dev->property_get("ndmp_username"), "foo",
1363         "..and get the value back");
1364     ok($dev->property_set("ndmp_password", "bar"),
1365         "set ndmp_password property");
1366     is($dev->property_get("ndmp_password"), "bar",
1367         "..and get the value back");
1368
1369     ok($dev->property_set("verbose", 1),
1370         "set VERBOSE");
1371
1372     # set 'em back to the defaults
1373     $dev->property_set("ndmp_username", "ndmp");
1374     $dev->property_set("ndmp_password", "ndmp");
1375
1376     # use a big read_block_size, checking that it's also settable
1377     # via read_buffer_size
1378     ok($dev->property_set("read_block_size", 256*1024),
1379     "can set read_block_size");
1380     is($dev->property_get("read_block_size"), 256*1024,
1381     "and its value is reflected");
1382     ok($dev->property_set("read_block_size", 64*1024),
1383     "set read_block_size back to something smaller");
1384
1385     # ok, let's fire the thing up
1386     ok($dev->start($ACCESS_WRITE, "TEST1", "20090915000000"),
1387         "start device in write mode")
1388         or diag $dev->error_or_status();
1389
1390     ok($dev->start_file($hdr),
1391         "start_file");
1392
1393     {   # write to the file
1394         my $xfer = Amanda::Xfer->new([
1395                 Amanda::Xfer::Source::Random->new(32768*21, 0xBEEFEE00),
1396                 Amanda::Xfer::Dest::Device->new($dev, 0) ]);
1397         $xfer->start(make_cb(xmsg_cb => sub {
1398             my ($src, $msg, $xfer) = @_;
1399             if ($msg->{'type'} == $XMSG_ERROR) {
1400                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1401             } elsif ($msg->{'type'} == $XMSG_DONE) {
1402                 Amanda::MainLoop::quit();
1403             }
1404         }));
1405
1406         Amanda::MainLoop::run();
1407         pass("wrote 21 blocks");
1408     }
1409
1410     ok($dev->finish(),
1411         "finish device")
1412         or diag $dev->error_or_status();
1413
1414     is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1415         "read label from (same) device")
1416         or diag $dev->error_or_status();
1417
1418     is($dev->volume_label, "TEST1",
1419         "volume label read back correctly");
1420
1421     ## label a device and check the label, but open a new device in between
1422
1423     # Write a label
1424     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1425     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1426         "creation of an ndmp device succeeds with correct syntax");
1427     $dev->property_set("ndmp_username", "ndmp");
1428     $dev->property_set("ndmp_password", "ndmp");
1429     $dev->property_set("verbose", 1);
1430
1431     # Write the label
1432     ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1433         "start device in write mode")
1434         or diag $dev->error_or_status();
1435     ok($dev->finish(),
1436         "finish device")
1437         or diag $dev->error_or_status();
1438
1439     # Read the label with a new device.
1440     $dev = Amanda::Device->new("ndmp:127.0.0.1:$ndmp_port\@$drive");
1441     is($dev->status(), $DEVICE_STATUS_SUCCESS,
1442         "creation of an ndmp device succeeds with correct syntax");
1443     $dev->property_set("ndmp_username", "ndmp");
1444     $dev->property_set("ndmp_password", "ndmp");
1445     $dev->property_set("verbose", 1);
1446
1447     # read the label
1448     is($dev->read_label(), $DEVICE_STATUS_SUCCESS,
1449         "read label from device")
1450         or diag $dev->error_or_status();
1451     is($dev->volume_label, "TEST2",
1452         "volume label read back correctly");
1453     ok($dev->finish(),
1454         "finish device")
1455         or diag $dev->error_or_status();
1456
1457     #
1458     # test the directtcp-target implementation
1459     #
1460
1461     ok($dev->directtcp_supported(), "is a directtcp target");
1462     for my $dev_use ('initiator', 'listener') {
1463         my ($xfer, $addrs, $dest_elt);
1464         if ($dev_use eq 'listener') {
1465             $addrs = $dev->listen(1);
1466             ok($addrs, "listen returns successfully") or die($dev->error_or_status());
1467
1468             # set up an xfer to write to the device
1469             $dest_elt = Amanda::Xfer::Dest::DirectTCPConnect->new($addrs);
1470         } else {
1471             # set up an xfer to write to the device
1472             $dest_elt = Amanda::Xfer::Dest::DirectTCPListen->new();
1473         }
1474         $xfer = Amanda::Xfer->new([
1475                 Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
1476                 $dest_elt,
1477             ]);
1478
1479         my @messages;
1480         $xfer->start(make_cb(xmsg_cb => sub {
1481             my ($src, $msg, $xfer) = @_;
1482             if ($msg->{'type'} == $XMSG_ERROR) {
1483                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1484             } elsif ($msg->{'type'} == $XMSG_DONE) {
1485                 Amanda::MainLoop::quit();
1486             }
1487         }));
1488
1489         # write files from the connection until EOF
1490         my $num_files;
1491         my $conn;
1492         my ($finish_connection, $start_device, $write_file_cb);
1493
1494
1495         $finish_connection = make_cb(finish_connection => sub {
1496             if ($dev_use eq 'listener') {
1497                 $conn = $dev->accept();
1498             } else {
1499                 $addrs = $dest_elt->get_addrs();
1500                 $conn = $dev->connect(1, $addrs);
1501             }
1502             Amanda::MainLoop::call_later($start_device);
1503         });
1504
1505
1506         $start_device = make_cb(start_device => sub {
1507             ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
1508                 "start device in write mode")
1509                 or diag $dev->error_or_status();
1510
1511             Amanda::MainLoop::call_later($write_file_cb);
1512         });
1513
1514         $write_file_cb = make_cb(write_file_cb => sub {
1515             ++$num_files < 20 or die "I seem to be in a loop!";
1516
1517             ok($dev->start_file($hdr), "start file $num_files for writing");
1518             is($dev->file, $num_files, "..file number is correct");
1519
1520             my ($ok, $size) = $dev->write_from_connection(32768*15);
1521             push @messages, sprintf("WRITE-%s-%d-%s-%s",
1522                 $ok?"OK":"ERR", $size,
1523                 $dev->is_eof()? "EOF":"!eof",
1524                 $dev->is_eom()? "EOM":"!eom");
1525             ok($ok, "..write from connection succeeds");
1526             my $eof = $dev->is_eof();
1527
1528             ok($dev->finish_file(), "..finish file after writing");
1529
1530             if (!$eof) {
1531                 Amanda::MainLoop::call_later($write_file_cb);
1532             }
1533         });
1534
1535         Amanda::MainLoop::call_later($finish_connection);
1536         Amanda::MainLoop::run();
1537         is_deeply([@messages], [
1538                 'WRITE-OK-491520-!eof-!eom',
1539                 'WRITE-OK-491520-!eof-!eom',
1540                 'WRITE-OK-131072-EOF-!eom',
1541             ],
1542             "a sequence of write_from_connection calls works correctly");
1543
1544         $dev->finish();
1545
1546         if (my $err = $conn->close()) {
1547             die $err;
1548         }
1549     }
1550
1551     # now try reading that back piece by piece
1552
1553     {
1554         my $filename = "$Installcheck::TMP/Amanda_Device_ndmp.tmp";
1555         open(my $dest_fh, ">", $filename);
1556
1557         ok($dev->start($ACCESS_READ, undef, undef),
1558             "start device in read mode")
1559             or diag $dev->error_or_status();
1560
1561         my $file;
1562         for ($file = 1; $file <= 3; $file++) {
1563             ok($dev->seek_file($file),
1564                 "seek_file $file");
1565             is($dev->file, $file, "..file num is correct");
1566             is($dev->block, 0, "..block num is correct");
1567
1568             # read the file, writing to our temp file.  We'll check that the byte
1569             # sequence is correct later
1570             my $xfer = Amanda::Xfer->new([
1571                     Amanda::Xfer::Source::Device->new($dev),
1572                     Amanda::Xfer::Dest::Fd->new($dest_fh) ]);
1573
1574             $xfer->start(make_cb(xmsg_cb => sub {
1575                 my ($src, $msg, $xfer) = @_;
1576                 if ($msg->{'type'} == $XMSG_ERROR) {
1577                     die $msg->{'elt'} . " failed: " . $msg->{'message'};
1578                 } elsif ($msg->{'type'} == $XMSG_DONE) {
1579                     Amanda::MainLoop::quit();
1580                 }
1581             }));
1582             Amanda::MainLoop::run();
1583
1584             pass("read back file " . $file);
1585         }
1586
1587         $dev->finish();
1588         close $dest_fh;
1589
1590         # now read back and verify that file
1591         open(my $src_fh, "<", $filename);
1592         my $xfer = Amanda::Xfer->new([
1593                 Amanda::Xfer::Source::Fd->new($src_fh),
1594                 Amanda::Xfer::Dest::Null->new(0xB00) ]);
1595
1596         $xfer->start(make_cb(xmsg_cb => sub {
1597             my ($src, $msg, $xfer) = @_;
1598             if ($msg->{'type'} == $XMSG_ERROR) {
1599                 die $msg->{'elt'} . " failed: " . $msg->{'message'};
1600             } elsif ($msg->{'type'} == $XMSG_DONE) {
1601                 Amanda::MainLoop::quit();
1602             }
1603         }));
1604         Amanda::MainLoop::run();
1605
1606         pass("data in the three parts is correct");
1607         unlink $filename;
1608     }
1609
1610     ####
1611     # Test read_to_connection
1612     #
1613     # This requires something that can connect to a device and read from
1614     # it; the XFA does not have an XFER_MECH_DIRECTTCP_CONNECT, so we fake
1615     # it by manually connecting and then setting up an xfer with a regular
1616     # XferSourceFd.  This works because the NDMP server will accept an
1617     # incoming connection before the Device API accept() method is called;
1618     # this trick may not work with other DirectTCP-capable devices.  Also,
1619     # this doesn't work so well if there's an error in the xfer (e.g., a
1620     # random value mismatch).  But tests are supposed to succeed!
1621
1622     sub test_read2conn {
1623         my ($finished_cb) = @_;
1624         my @events;
1625         my $file = 1;
1626         my ($conn, $sock);
1627
1628         my $steps = define_steps
1629             cb_ref => \$finished_cb;
1630
1631         step setup => sub {
1632             my $addrs = $dev->listen(0);
1633
1634             # now connect to that
1635             $sock = IO::Socket::INET->new(
1636                 Proto => "tcp",
1637                 PeerHost => $addrs->[0][0],
1638                 PeerPort => $addrs->[0][1],
1639                 Blocking => 1,
1640             );
1641
1642             # and set up a transfer to read from that socket
1643             my $xfer = Amanda::Xfer->new([
1644                     Amanda::Xfer::Source::Fd->new($sock),
1645                     Amanda::Xfer::Dest::Null->new(0xB00) ]);
1646
1647             $xfer->start(make_cb(xmsg_cb => sub {
1648                 my ($src, $msg, $xfer) = @_;
1649                 if ($msg->{'type'} == $XMSG_ERROR) {
1650                     die $msg->{'elt'} . " failed: " . $msg->{'message'};
1651                 }
1652                 if ($msg->{'type'} == $XMSG_DONE) {
1653                     push @events, "DONE";
1654                     $steps->{'quit'}->();
1655                 }
1656             }));
1657
1658             $steps->{'accept'}->();
1659         };
1660
1661         step accept => sub {
1662             $conn = $dev->accept();
1663             die $dev->error_or_status() unless ($conn);
1664
1665             Amanda::MainLoop::call_later($steps->{'start_dev'});
1666         };
1667
1668         step start_dev => sub {
1669             ok($dev->start($ACCESS_READ, undef, undef),
1670                 "start device in read mode")
1671                 or diag $dev->error_or_status();
1672
1673             Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1674         };
1675
1676         step read_part_cb => sub {
1677             my $hdr = $dev->seek_file($file);
1678             die $dev->error_or_status() unless ($hdr);
1679             my $size = $dev->read_to_connection(0);
1680             push @events, "READ-$size";
1681
1682             if (++$file <= 3) {
1683                 Amanda::MainLoop::call_later($steps->{'read_part_cb'});
1684             } else {
1685                 # close the connection, which will end the xfer, which will
1686                 # result in a call to finished_cb.  So there.
1687                 push @events, "CLOSE";
1688                 $conn->close();
1689             }
1690         };
1691
1692         step quit => sub {
1693             close $sock or die "close: $!";
1694
1695             is_deeply([@events],
1696                 [ "READ-491520", "READ-491520", "READ-131072", "CLOSE", "DONE" ],
1697                 "sequential read_to_connection operations read the right amounts " .
1698                 "and bytestream matches");
1699
1700             $finished_cb->();
1701         };
1702     }
1703     test_read2conn(\&Amanda::MainLoop::quit);
1704     Amanda::MainLoop::run();
1705
1706     # try two seek_file's in a row
1707     $hdr = $dev->seek_file(2);
1708     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
1709     $hdr = $dev->seek_file(2);
1710     is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
1711
1712     ## test seek_file's handling of EOM
1713
1714     $hdr = $dev->seek_file(3);
1715     is($hdr->{type}, $Amanda::Header::F_DUMPFILE, "file 3 is a dumpfile");
1716     $hdr = $dev->seek_file(4);
1717     is($hdr->{type}, $Amanda::Header::F_TAPEEND, "file 4 is tapeend");
1718     $hdr = $dev->seek_file(5);
1719     is($hdr, undef, "file 5 is an error");
1720     $hdr = $dev->seek_file(6);
1721     is($hdr, undef, "file 6 is an error");
1722
1723     $ndmp->cleanup();
1724 }
1725 unlink($input_filename);
1726 unlink($output_filename);
1727 rmtree($taperoot);