lintian doesn't like orphan packages with uploaders...
[debian/amanda] / installcheck / Amanda_Device.pl
index b01879a055e42b7b486aa7d711e741e90ce50f51..2b5fcb65966d7e3db988e02debc7a44f8735138b 100644 (file)
@@ -1,8 +1,9 @@
-# Copyright (c) 2008, 2009, 2010 Zmanda, Inc.  All Rights Reserved.
+# Copyright (c) 2008-2012 Zmanda, Inc.  All Rights Reserved.
 #
-# This program is free software; you can redistribute it and/or modify it
-# under the terms of the GNU General Public License version 2 as published
-# by the Free Software Foundation.
+# This program is free software; you can redistribute it and/or
+# modify it under the terms of the GNU General Public License
+# as published by the Free Software Foundation; either version 2
+# of the License, or (at your option) any later version.
 #
 # This program is distributed in the hope that it will be useful, but
 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
 
-use Test::More tests => 482;
+use Test::More tests => 541;
 use File::Path qw( mkpath rmtree );
 use Sys::Hostname;
 use Carp;
 use strict;
+use warnings;
 
 use lib "@amperldir@";
 use Installcheck;
@@ -32,7 +34,7 @@ use Amanda::Config qw( :getconf :init );
 use Amanda::Xfer qw( :constants );
 use Amanda::Header qw( :constants );
 use Amanda::Paths;
-use Amanda::Tests;
+use Amanda::Constants;
 use Amanda::Util;
 use Amanda::MainLoop;
 use IO::Socket;
@@ -44,7 +46,6 @@ my ($input_filename, $output_filename) =
     ( "$Installcheck::TMP/input.tmp", "$Installcheck::TMP/output.tmp" );
 my $taperoot = "$Installcheck::TMP/Amanda_Device_test_tapes";
 my $testconf;
-my $queue_fd;
 
 # we'll need some vtapes..
 sub mkvtape {
@@ -67,22 +68,10 @@ $dumpfile->{name} = "localhost";
 $dumpfile->{disk} = "/home";
 $dumpfile->{program} = "INSTALLCHECK";
 
-# function to set up a queue_fd for a filename
-sub make_queue_fd {
-    my ($filename, $mode) = @_;
-
-    open(my $fd, $mode, $filename) or die("Could not open $filename: $!");
-    return $fd, Amanda::Device::queue_fd_t->new($fd);
-}
-
 my $write_file_count = 5;
 sub write_file {
     my ($seed, $length, $filenum) = @_;
 
-    croak ("selected file size $length is *way* too big")
-       unless ($length < 1024*1024*10);
-    Amanda::Tests::write_random_file($seed, $length, $input_filename);
-
     $dumpfile->{'datestamp'} = "2000010101010$filenum";
 
     ok($dev->start_file($dumpfile),
@@ -92,11 +81,10 @@ sub write_file {
     is($dev->file(), $filenum,
        "Device has correct filenum");
 
-    my ($input, $queue_fd) = make_queue_fd($input_filename, "<");
-    ok($dev->write_from_fd($queue_fd),
-       "write some data")
-       or diag($dev->error_or_status());
-    close($input) or die("Error closing $input_filename");
+    croak ("selected file size $length is *way* too big")
+       unless ($length < 1024*1024*10);
+    ok(Amanda::Device::write_random_to_device($seed, $length, $dev),
+       "write random data");
 
     if(ok($dev->in_file(),
        "still in_file")) {
@@ -108,7 +96,7 @@ sub write_file {
     }
 }
 
-my $verify_file_count = 5;
+my $verify_file_count = 4;
 sub verify_file {
     my ($seed, $length, $filenum) = @_;
 
@@ -120,14 +108,7 @@ sub verify_file {
     ok(header_for($read_dumpfile, $filenum),
        "header is correct")
        or diag($dev->error_or_status());
-
-    my ($output, $queue_fd) = make_queue_fd($output_filename, ">");
-    ok($dev->read_to_fd($queue_fd),
-       "read data from file $filenum")
-       or diag($dev->error_or_status());
-    close($output) or die("Error closing $output_filename");
-
-    ok(Amanda::Tests::verify_random_file($seed, $length, $output_filename, 0),
+    ok(Amanda::Device::verify_random_from_device($seed, $length, $dev),
        "verified file contents");
 }
 
@@ -271,6 +252,9 @@ ok($dev->property_set("comment", "32k"),
 ok($dev->property_set("block_size", 32768),
     "set an integer property to an integer");
 
+ok(!($dev->property_set("invalid-property-name", 32768)),
+    "set an invalid-property-name");
+
 $dev->read_label();
 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
     "initially unlabeled")
@@ -349,6 +333,155 @@ ok($dev->finish(),
    "finish device after erase")
     or diag($dev->error_or_status());
 
+# test monitor_free_space property (testing the monitoring would require a
+# dedicated partition for the tests - it's not worth it)
+
+ok($dev->property_get("monitor_free_space"),
+    "monitor_free_space property is set by default");
+
+ok($dev->property_set("monitor_free_space", 0),
+    "monitor_free_space property can be set to false");
+
+ok(!$dev->property_get("monitor_free_space"),
+    "monitor_free_space property value 'sticks'");
+
+# test the LEOM functionality
+
+$dev = undef;
+$dev = Amanda::Device->new($dev_name);
+is($dev->status(), $DEVICE_STATUS_SUCCESS,
+    "$dev_name: re-create successful")
+    or diag($dev->error_or_status());
+ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
+    "set MAX_VOLUME_USAGE to test LEOM");
+ok($dev->property_set("LEOM", 1),
+    "set LEOM");
+ok($dev->property_set("ENFORCE_MAX_VOLUME_USAGE", 0),
+    "set ENFORCE_MAX_VOLUME_USAGE");
+
+ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
+    "start in write mode")
+    or diag($dev->error_or_status());
+
+ok($dev->start_file($dumpfile),
+    "start file 1")
+    or diag($dev->error_or_status());
+
+ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
+    "write random data into the early-warning zone");
+
+ok(!$dev->is_eom,
+    "device does not indicates LEOM after writing when ENFORCE_MAX_VOLUME_USAGE is FALSE");
+
+ok($dev->finish_file(),
+    "..but a finish_file is allowed to complete")
+    or diag($dev->error_or_status());
+
+ok($dev->finish(),
+   "finish device after LEOM test")
+    or diag($dev->error_or_status());
+
+$dev = undef;
+$dev = Amanda::Device->new($dev_name);
+is($dev->status(), $DEVICE_STATUS_SUCCESS,
+    "$dev_name: re-create successful")
+    or diag($dev->error_or_status());
+ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
+    "set MAX_VOLUME_USAGE to test LEOM");
+ok($dev->property_set("LEOM", 1),
+    "set LEOM");
+ok($dev->property_set("ENFORCE_MAX_VOLUME_USAGE", 1),
+    "set ENFORCE_MAX_VOLUME_USAGE");
+
+ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
+    "start in write mode")
+    or diag($dev->error_or_status());
+
+ok($dev->start_file($dumpfile),
+    "start file 1")
+    or diag($dev->error_or_status());
+
+ok(!$dev->is_eom,
+    "device does not indicate LEOM before writing");
+
+ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
+    "write random data into the early-warning zone");
+
+ok($dev->is_eom,
+    "device indicates LEOM after writing");
+
+ok($dev->finish_file(),
+    "..but a finish_file is allowed to complete")
+    or diag($dev->error_or_status());
+
+ok($dev->finish(),
+   "finish device after LEOM test")
+    or diag($dev->error_or_status());
+
+$dev = undef;
+$dev = Amanda::Device->new($dev_name);
+is($dev->status(), $DEVICE_STATUS_SUCCESS,
+    "$dev_name: re-create successful")
+    or diag($dev->error_or_status());
+ok($dev->property_set("MAX_VOLUME_USAGE", "512k"),
+    "set MAX_VOLUME_USAGE to test LEOM");
+ok($dev->property_set("LEOM", 1),
+    "set LEOM");
+
+ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
+    "start in write mode")
+    or diag($dev->error_or_status());
+
+ok($dev->start_file($dumpfile),
+    "start file 1")
+    or diag($dev->error_or_status());
+
+ok(!$dev->is_eom,
+    "device does not indicate LEOM before writing");
+
+ok(Amanda::Device::write_random_to_device(0xCAFE, 440*1024, $dev),
+    "write random data into the early-warning zone");
+
+ok($dev->is_eom,
+    "device indicates LEOM after writing as default value of ENFORCE_MAX_VOLUME_USAGE is true for vfs device");
+
+ok($dev->finish_file(),
+    "..but a finish_file is allowed to complete")
+    or diag($dev->error_or_status());
+
+ok($dev->finish(),
+   "finish device after LEOM test")
+    or diag($dev->error_or_status());
+
+$dev = undef;
+$dev = Amanda::Device->new($dev_name);
+is($dev->status(), $DEVICE_STATUS_SUCCESS,
+    "$dev_name: re-create successful")
+    or diag($dev->error_or_status());
+ok($dev->property_set("MAX_VOLUME_USAGE", "160k"),
+    "set MAX_VOLUME_USAGE to test LEOM while writing the first header");
+ok($dev->property_set("LEOM", 1),
+    "set LEOM");
+
+ok($dev->start($ACCESS_WRITE, 'TESTCONF23', undef),
+    "start in write mode")
+    or diag($dev->error_or_status());
+
+ok($dev->start_file($dumpfile),
+    "start file 1")
+    or diag($dev->error_or_status());
+
+ok($dev->is_eom,
+    "device indicates LEOM after writing first header");
+
+ok($dev->finish_file(),
+    "..but a finish_file is allowed to complete")
+    or diag($dev->error_or_status());
+
+ok($dev->finish(),
+   "finish device after LEOM test")
+    or diag($dev->error_or_status());
+
 ####
 ## Test a RAIT device of two vfs devices.
 
@@ -374,6 +507,12 @@ ok($dev->property_set("block_size", 32768*16),
 is($dev->property_get("block_size"), 32768*16,
     "..and remembers it");
 
+ok($dev->property_set("max_volume_usage", 32768*1000),
+    "rait device accepts property MAX_VOLUME_USAGE");
+
+is($dev->property_get("max_volume_usage"), 32768*1000,
+    "..and remembers it");
+
 $dev->read_label();
 ok($dev->status() & $DEVICE_STATUS_VOLUME_UNLABELED,
    "initially unlabeled")
@@ -542,7 +681,7 @@ my $run_s3_tests = defined $S3_SECRET_KEY && defined $S3_ACCESS_KEY;
 my $run_devpay_tests = defined $DEVPAY_SECRET_KEY &&
     defined $DEVPAY_ACCESS_KEY && $DEVPAY_USER_TOKEN;
 
-my $s3_make_device_count = 6;
+my $s3_make_device_count = 7;
 sub s3_make_device($$) {
     my ($dev_name, $kind) = @_;
     $dev = Amanda::Device->new($dev_name);
@@ -559,6 +698,11 @@ sub s3_make_device($$) {
        "set block size")
        or diag($dev->error_or_status());
 
+    # might as well save a few cents while testing this property..
+    ok($dev->property_set('S3_STORAGE_CLASS', 'REDUCED_REDUNDANCY'),
+       "set storage class")
+       or diag($dev->error_or_status());
+
     if ($kind eq "s3") {
         # use regular S3 credentials
         ok($dev->property_set('S3_ACCESS_KEY', $S3_ACCESS_KEY),
@@ -593,10 +737,10 @@ my $base_name;
 
 SKIP: {
     skip "define \$INSTALLCHECK_S3_{SECRET,ACCESS}_KEY to run S3 tests",
-            67 +
+            101 +
             1 * $verify_file_count +
-            4 * $write_file_count +
-            10 * $s3_make_device_count
+            7 * $write_file_count +
+            13 * $s3_make_device_count
        unless $run_s3_tests;
 
     $dev_name = "s3:";
@@ -610,6 +754,9 @@ SKIP: {
     ok($dev->property_get("full_deletion"),
        "property_get(full_deletion) on s3 device");
 
+    ok($dev->property_get("leom"),
+       "property_get(leom) on s3 device");
+
     # test parsing of boolean values
     # (s3 is the only device driver that has a writable boolean property at the
     # moment)
@@ -741,7 +888,8 @@ SKIP: {
 
     ok($dev->finish(),
        "finish device after read")
-        or diag($dev->error_or_status());    # (note: we don't use write_max_size here, as the maximum for S3 is very large)
+        or diag($dev->error_or_status());    # (note: we don't use write_max_size here,
+                                            # as the maximum for S3 is very large)
 
     ok($dev->erase(),
        "erase device")
@@ -767,6 +915,90 @@ SKIP: {
        "erase device right after creation")
        or diag($dev->error_or_status());
 
+    $dev = s3_make_device($dev_name, "s3");
+
+    # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=false
+    ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
+       "set MAX_VOLUME_USAGE to test LEOM");
+
+    ok($dev->property_set("LEOM", 1),
+        "set LEOM");
+
+    ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef), 
+       "start in write mode")
+        or diag($dev->error_or_status());
+
+    write_file(0x2FACE, 440*1024, 1);
+
+    ok(!$dev->is_eom,
+        "device does not indicate LEOM after writing as property ENFORCE_MAX_VOLUME_USAGE not set and its default value is false");
+
+    ok($dev->finish(),
+       "finish device after LEOM test")
+       or diag($dev->error_or_status());
+    
+    ok($dev->erase(),
+       "erase device")
+       or diag($dev->error_or_status());
+    
+    $dev = s3_make_device($dev_name, "s3");
+
+    # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=true
+    ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
+       "set MAX_VOLUME_USAGE to test LEOM");
+
+    ok($dev->property_set('ENFORCE_MAX_VOLUME_USAGE', 1 ),
+       "set ENFORCE_MAX_VOLUME_USAGE");
+
+    ok($dev->property_set("LEOM", 1),
+        "set LEOM");
+
+    ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef), 
+       "start in write mode")
+        or diag($dev->error_or_status());
+
+    write_file(0x2FACE, 440*1024, 1);
+
+    ok($dev->is_eom,
+        "device indicates LEOM after writing, when property ENFORCE_MAX_VOLUME_USAGE set to true");
+
+    ok($dev->finish(),
+       "finish device after LEOM test")
+       or diag($dev->error_or_status());
+
+    ok($dev->erase(),
+       "erase device")
+       or diag($dev->error_or_status());
+    
+    $dev = s3_make_device($dev_name, "s3");
+
+    # set MAX_VOLUME_USAGE, LEOM=true, ENFORCE_MAX_VOLUME_USAGE=false
+    ok($dev->property_set('MAX_VOLUME_USAGE', "512k"),
+       "set MAX_VOLUME_USAGE to test LEOM");
+
+    ok($dev->property_set('ENFORCE_MAX_VOLUME_USAGE', 0 ),
+       "set ENFORCE_MAX_VOLUME_USAGE");
+
+    ok($dev->property_set("LEOM", 1),
+        "set LEOM");
+
+    ok($dev->start($ACCESS_WRITE, "TESTCONF13", undef), 
+       "start in write mode")
+        or diag($dev->error_or_status());
+
+    write_file(0x2FACE, 440*1024, 1);
+
+    ok(!$dev->is_eom,
+        "device does not indicate LEOM after writing, when property ENFORCE_MAX_VOLUME_USAGE set to false");
+
+    ok($dev->finish(),
+       "finish device after LEOM test")
+       or diag($dev->error_or_status());
+    
+    ok($dev->erase(),
+       "erase device")
+       or diag($dev->error_or_status());
+    
     # try with empty user token
     $dev_name = lc("s3:$base_name-s3");
     $dev = s3_make_device($dev_name, "s3");
@@ -780,6 +1012,12 @@ SKIP: {
        "status is either OK or possibly unlabeled")
         or diag($dev->error_or_status());
 
+    $dev->finish();
+
+    ok($dev->erase(),
+       "erase device")
+       or diag($dev->error_or_status());
+
     # try a eu-constrained bucket
     $dev_name = lc("s3:$base_name-s3-eu");
     $dev = s3_make_device($dev_name, "s3");
@@ -797,6 +1035,10 @@ SKIP: {
 
     $dev->finish();
 
+    ok($dev->erase(),
+       "erase device")
+       or diag($dev->error_or_status());
+
     # try a wildcard-constrained bucket
     $dev_name = lc("s3:$base_name-s3-wild");
     $dev = s3_make_device($dev_name, "s3");
@@ -840,7 +1082,7 @@ SKIP: {
     SKIP: {
        skip "SSL not supported; can't check SSL_CA_INFO", 4
            unless $dev->property_get('S3_SSL');
-       ok($dev->property_set('SSL_CA_INFO', 'data/aws-bundle.crt'),
+       ok($dev->property_set('SSL_CA_INFO', "$srcdir/data/aws-bundle.crt"),
           "set our own SSL/TLS CA certificate bundle")
            or diag($dev->error_or_status());
 
@@ -855,8 +1097,14 @@ SKIP: {
         is($dev->status(), $DEVICE_STATUS_SUCCESS,
            "status is OK")
             or diag($dev->error_or_status());
+
+       $dev->finish();
     }
 
+    ok($dev->erase(),
+       "erase device")
+       or diag($dev->error_or_status());
+
     # bucket names incompatible with location constraint
     $dev_name = "s3:-$base_name-s3-eu";
     $dev = s3_make_device($dev_name, "s3");
@@ -878,6 +1126,22 @@ SKIP: {
     ok(!$dev->property_set('S3_BUCKET_LOCATION', 'EU'),
        "should not be able to set S3 bucket location with an incompatible name")
         or diag($dev->error_or_status());
+
+    $dev_name = lc("s3:$base_name-s3-eu");
+    $dev = s3_make_device($dev_name, "s3");
+    ok($dev->property_set('S3_BUCKET_LOCATION', 'XYZ'),
+       "should be able to set S3 bucket location with a compatible name")
+        or diag($dev->error_or_status());
+    $dev->read_label();
+    $status = $dev->status();
+    ok(($status == $DEVICE_STATUS_DEVICE_ERROR),
+       "status is DEVICE_STATUS_DEVICE_ERROR")
+        or diag($dev->error_or_status());
+    my $error_msg = $dev->error_or_status();
+    ok(($dev->error_or_status() == "While creating new S3 bucket: The specified location-constraint is not valid (Unknown) (HTTP 400)"),
+       "invalid location-constraint")
+       or diag("bad error: " . $dev->error_or_status());
+
 }
 
 SKIP: {
@@ -1050,7 +1314,7 @@ SKIP: {
 }
 
 SKIP: {
-    skip "not built with ndmp and server", 77 unless
+    skip "not built with ndmp and server", 26 unless
        Amanda::Util::built_with_component("ndmp") and
        Amanda::Util::built_with_component("server");
 
@@ -1111,6 +1375,15 @@ SKIP: {
     $dev->property_set("ndmp_username", "ndmp");
     $dev->property_set("ndmp_password", "ndmp");
 
+    # use a big read_block_size, checking that it's also settable
+    # via read_buffer_size
+    ok($dev->property_set("read_block_size", 256*1024),
+    "can set read_block_size");
+    is($dev->property_get("read_block_size"), 256*1024,
+    "and its value is reflected");
+    ok($dev->property_set("read_block_size", 64*1024),
+    "set read_block_size back to something smaller");
+
     # ok, let's fire the thing up
     ok($dev->start($ACCESS_WRITE, "TEST1", "20090915000000"),
        "start device in write mode")
@@ -1122,7 +1395,7 @@ SKIP: {
     {   # write to the file
        my $xfer = Amanda::Xfer->new([
                Amanda::Xfer::Source::Random->new(32768*21, 0xBEEFEE00),
-               Amanda::Xfer::Dest::Device->new($dev, 32768*5) ]);
+               Amanda::Xfer::Dest::Device->new($dev, 0) ]);
        $xfer->start(make_cb(xmsg_cb => sub {
            my ($src, $msg, $xfer) = @_;
            if ($msg->{'type'} == $XMSG_ERROR) {
@@ -1183,368 +1456,6 @@ SKIP: {
        "finish device")
        or diag $dev->error_or_status();
 
-    #
-    # test the directtcp-target implementation
-    #
-
-    {
-       ok($dev->directtcp_supported(), "is a directtcp target");
-
-       my $addrs = $dev->listen(1);
-       ok($addrs, "listen returns successfully") or die($dev->error_or_status());
-
-       # set up an xfer to write to the device
-       my $xfer = Amanda::Xfer->new([
-               Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
-               Amanda::Xfer::Dest::DirectTCPConnect->new($addrs) ]);
-
-       my @messages;
-       $xfer->start(make_cb(xmsg_cb => sub {
-           my ($src, $msg, $xfer) = @_;
-           if ($msg->{'type'} == $XMSG_ERROR) {
-               die $msg->{'elt'} . " failed: " . $msg->{'message'};
-           } elsif ($msg->{'type'} == $XMSG_DONE) {
-               Amanda::MainLoop::quit();
-           }
-       }));
-
-       # write files from the connection until EOF
-       my $num_files;
-       my $conn;
-       my ($call_accept, $start_device, $write_file_cb);
-
-       $call_accept = make_cb(call_accept => sub {
-           $conn = $dev->accept();
-           Amanda::MainLoop::call_later($start_device);
-       });
-
-       $start_device = make_cb(start_device => sub {
-           ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
-               "start device in write mode")
-               or diag $dev->error_or_status();
-
-           Amanda::MainLoop::call_later($write_file_cb);
-       });
-
-       $write_file_cb = make_cb(write_file_cb => sub {
-           ++$num_files < 20 or die "I seem to be in a loop!";
-
-           ok($dev->start_file($hdr), "start file $num_files for writing");
-           is($dev->file, $num_files, "..file number is correct");
-
-           my ($ok, $size) = $dev->write_from_connection(32768*15);
-           push @messages, sprintf("WRITE-%s-%d-%s-%s",
-               $ok?"OK":"ERR", $size,
-               $dev->is_eof()? "EOF":"!eof",
-               $dev->is_eom()? "EOM":"!eom");
-           ok($ok, "..write from connection succeeds");
-           my $eof = $dev->is_eof();
-
-           ok($dev->finish_file(), "..finish file after writing");
-
-           if (!$eof) {
-               Amanda::MainLoop::call_later($write_file_cb);
-           }
-       });
-
-       Amanda::MainLoop::call_later($call_accept);
-       Amanda::MainLoop::run();
-       is_deeply([@messages], [
-               'WRITE-OK-491520-!eof-!eom',
-               'WRITE-OK-491520-!eof-!eom',
-               'WRITE-OK-131072-EOF-!eom',
-           ],
-           "a sequence of write_from_connection calls works correctly");
-
-       $dev->finish();
-
-       if (my $err = $conn->close()) {
-           die $err;
-       }
-    }
-
-    #
-    # Test indirecttcp
-    #
-
-    {
-       ok($dev->directtcp_supported(), "is a directtcp target");
-
-       $dev->property_set("_force_indirecttcp", 1);
-
-       my $addrs = $dev->listen(1);
-       is_deeply([ scalar @$addrs, $addrs->[0][0] ],
-           [ 1, '255.255.255.255' ],
-           "listen returns successfully with indirecttcp sentinel")
-           or die($dev->error_or_status());
-
-       # fork off to evaluate the indirecttcp addresses and then set up an
-       # xfer to write to the device
-       if (POSIX::fork() == 0) {
-           # NOTE: do not use IO::Socket in normal Amanda code - it is diabolically
-           # not threadsafe!  It's OK here since this is just a test script and
-           # since we're in a subprocess
-           use IO::Socket;
-           my $sock = new IO::Socket::INET(
-                   PeerAddr => '127.0.0.1',
-                   PeerPort => $addrs->[0][1],
-                   Proto => 'tcp')
-               or die("Could not create connecting socket");
-           $sock->shutdown(1); # send EOF
-           my $sockresult = <$sock>;
-           $sock->close();
-
-           my @sockresult = map { [ split(/:/, $_) ] } split(/ /, $sockresult);
-           $addrs = [ map { $_->[1] = int($_->[1]); $_ } @sockresult ];
-
-           my $xfer = Amanda::Xfer->new([
-                   Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
-                   Amanda::Xfer::Dest::DirectTCPConnect->new($addrs) ]);
-
-           $xfer->start(make_cb(xmsg_cb => sub {
-               my ($src, $msg, $xfer) = @_;
-               if ($msg->{'type'} == $XMSG_ERROR) {
-                   die $msg->{'elt'} . " failed: " . $msg->{'message'};
-               } elsif ($msg->{'type'} == $XMSG_DONE) {
-                   Amanda::MainLoop::quit();
-               }
-           }));
-
-           Amanda::MainLoop::run();
-
-           # exit without doing any of perl's cleanup
-           POSIX::_exit(0);
-       }
-
-       # write files from the connection until EOF
-       my @messages;
-       my $num_files;
-       my $conn;
-       my ($call_accept, $start_device, $write_file_cb);
-
-       $call_accept = make_cb(call_accept => sub {
-           $conn = $dev->accept();
-           Amanda::MainLoop::call_later($start_device);
-       });
-
-       $start_device = make_cb(start_device => sub {
-           ok($dev->start($ACCESS_WRITE, "TEST2", "20090915000000"),
-               "start device in write mode")
-               or diag $dev->error_or_status();
-
-           Amanda::MainLoop::call_later($write_file_cb);
-       });
-
-       $write_file_cb = make_cb(write_file_cb => sub {
-           ++$num_files < 20 or die "I seem to be in a loop!";
-
-           ok($dev->start_file($hdr), "start file $num_files for writing");
-           is($dev->file, $num_files, "..file number is correct");
-
-           my ($ok, $size) = $dev->write_from_connection(32768*15);
-           push @messages, sprintf("WRITE-%s-%d-%s-%s",
-               $ok?"OK":"ERR", $size,
-               $dev->is_eof()? "EOF":"!eof",
-               $dev->is_eom()? "EOM":"!eom");
-           ok($ok, "..write from connection succeeds");
-           my $eof = $dev->is_eof();
-
-           ok($dev->finish_file(), "..finish file after writing");
-
-           if (!$eof) {
-               Amanda::MainLoop::call_later($write_file_cb);
-           } else {
-               Amanda::MainLoop::quit();
-           }
-       });
-
-       Amanda::MainLoop::call_later($call_accept);
-       Amanda::MainLoop::run();
-       is_deeply([@messages], [
-               'WRITE-OK-491520-!eof-!eom',
-               'WRITE-OK-491520-!eof-!eom',
-               'WRITE-OK-131072-EOF-!eom',
-           ],
-           "a sequence of write_from_connection calls works correctly");
-
-       $dev->finish();
-
-       if (my $err = $conn->close()) {
-           die $err;
-       }
-    }
-
-    # now try reading that back piece by piece
-
-    {
-       my $filename = "$Installcheck::TMP/Amanda_Device_ndmp.tmp";
-       open(my $dest_fh, ">", $filename);
-
-       ok($dev->start($ACCESS_READ, undef, undef),
-           "start device in read mode")
-           or diag $dev->error_or_status();
-
-       my $file;
-       for ($file = 1; $file <= 3; $file++) {
-           ok($dev->seek_file($file),
-               "seek_file $file");
-           is($dev->file, $file, "..file num is correct");
-           is($dev->block, 0, "..block num is correct");
-
-           # read the file, writing to our temp file.  We'll check that the byte
-           # sequence is correct later
-           my $xfer = Amanda::Xfer->new([
-                   Amanda::Xfer::Source::Device->new($dev),
-                   Amanda::Xfer::Dest::Fd->new($dest_fh) ]);
-
-           $xfer->start(make_cb(xmsg_cb => sub {
-               my ($src, $msg, $xfer) = @_;
-               if ($msg->{'type'} == $XMSG_ERROR) {
-                   die $msg->{'elt'} . " failed: " . $msg->{'message'};
-               } elsif ($msg->{'type'} == $XMSG_DONE) {
-                   Amanda::MainLoop::quit();
-               }
-           }));
-           Amanda::MainLoop::run();
-
-           pass("read back file " . $file);
-       }
-
-       $dev->finish();
-       close $dest_fh;
-
-       # now read back and verify that file
-       open(my $src_fh, "<", $filename);
-       my $xfer = Amanda::Xfer->new([
-               Amanda::Xfer::Source::Fd->new($src_fh),
-               Amanda::Xfer::Dest::Null->new(0xB00) ]);
-
-       $xfer->start(make_cb(xmsg_cb => sub {
-           my ($src, $msg, $xfer) = @_;
-           if ($msg->{'type'} == $XMSG_ERROR) {
-               die $msg->{'elt'} . " failed: " . $msg->{'message'};
-           } elsif ($msg->{'type'} == $XMSG_DONE) {
-               Amanda::MainLoop::quit();
-           }
-       }));
-       Amanda::MainLoop::run();
-
-       pass("data in the three parts is correct");
-       unlink $filename;
-    }
-
-    ####
-    # Test read_to_connection
-    #
-    # This requires something that can connect to a device and read from
-    # it; the XFA does not have an XFER_MECH_DIRECTTCP_CONNECT, so we fake
-    # it by manually connecting and then setting up an xfer with a regular
-    # XferSourceFd.  This works because the NDMP server will accept an
-    # incoming connection before the Device API accept() method is called;
-    # this trick may not work with other DirectTCP-capable devices.  Also,
-    # this doesn't work so well if there's an error in the xfer (e.g., a
-    # random value mismatch).  But tests are supposed to succeed!
-
-    sub test_read2conn {
-       my ($finished_cb) = @_;
-       my @events;
-       my $file = 1;
-       my ($conn, $sock);
-
-       my $steps = define_steps
-           cb_ref => \$finished_cb;
-
-       step setup => sub {
-           my $addrs = $dev->listen(0);
-
-           # now connect to that
-           $sock = IO::Socket::INET->new(
-               Proto => "tcp",
-               PeerHost => $addrs->[0][0],
-               PeerPort => $addrs->[0][1],
-               Blocking => 1,
-           );
-
-           # and set up a transfer to read from that socket
-           my $xfer = Amanda::Xfer->new([
-                   Amanda::Xfer::Source::Fd->new($sock),
-                   Amanda::Xfer::Dest::Null->new(0xB00) ]);
-
-           $xfer->start(make_cb(xmsg_cb => sub {
-               my ($src, $msg, $xfer) = @_;
-               if ($msg->{'type'} == $XMSG_ERROR) {
-                   die $msg->{'elt'} . " failed: " . $msg->{'message'};
-               }
-               if ($msg->{'type'} == $XMSG_DONE) {
-                   push @events, "DONE";
-                   $steps->{'quit'}->();
-               }
-           }));
-
-           $steps->{'accept'}->();
-       };
-
-       step accept => sub {
-           $conn = $dev->accept();
-           die $dev->error_or_status() unless ($conn);
-
-           Amanda::MainLoop::call_later($steps->{'start_dev'});
-       };
-
-       step start_dev => sub {
-           ok($dev->start($ACCESS_READ, undef, undef),
-               "start device in read mode")
-               or diag $dev->error_or_status();
-
-           Amanda::MainLoop::call_later($steps->{'read_part_cb'});
-       };
-
-       step read_part_cb => sub {
-           my $hdr = $dev->seek_file($file);
-           die $dev->error_or_status() unless ($hdr);
-           my $size = $dev->read_to_connection(0);
-           push @events, "READ-$size";
-
-           if (++$file <= 3) {
-               Amanda::MainLoop::call_later($steps->{'read_part_cb'});
-           } else {
-               # close the connection, which will end the xfer, which will
-               # result in a call to finished_cb.  So there.
-               push @events, "CLOSE";
-               $conn->close();
-           }
-       };
-
-       step quit => sub {
-           close $sock or die "close: $!";
-
-           is_deeply([@events],
-               [ "READ-491520", "READ-491520", "READ-131072", "CLOSE", "DONE" ],
-               "sequential read_to_connection operations read the right amounts " .
-               "and bytestream matches");
-
-           $finished_cb->();
-       };
-    }
-    test_read2conn(\&Amanda::MainLoop::quit);
-    Amanda::MainLoop::run();
-
-    # try two seek_file's in a row
-    $hdr = $dev->seek_file(2);
-    is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the first time");
-    $hdr = $dev->seek_file(2);
-    is($hdr? $hdr->{'type'} : -1, $Amanda::Header::F_DUMPFILE, "seek_file the second time");
-
-    ## test seek_file's handling of EOM
-
-    $hdr = $dev->seek_file(3);
-    is($hdr->{type}, $Amanda::Header::F_DUMPFILE, "file 3 is a dumpfile");
-    $hdr = $dev->seek_file(4);
-    is($hdr->{type}, $Amanda::Header::F_TAPEEND, "file 4 is tapeend");
-    $hdr = $dev->seek_file(5);
-    is($hdr, undef, "file 5 is an error");
-    $hdr = $dev->seek_file(6);
-    is($hdr, undef, "file 6 is an error");
 
     $ndmp->cleanup();
 }