Imported Upstream version 3.3.3
[debian/amanda] / installcheck / Amanda_Device.pl
index 92ab1626920609dc617716a497f5ec5c3f066a92..2b5fcb65966d7e3db988e02debc7a44f8735138b 100644 (file)
@@ -1,8 +1,9 @@
 # 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
@@ -16,7 +17,7 @@
 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
 
-use Test::More tests => 609;
+use Test::More tests => 541;
 use File::Path qw( mkpath rmtree );
 use Sys::Hostname;
 use Carp;
@@ -1313,7 +1314,7 @@ SKIP: {
 }
 
 SKIP: {
-    skip "not built with ndmp and server", 94 unless
+    skip "not built with ndmp and server", 26 unless
        Amanda::Util::built_with_component("ndmp") and
        Amanda::Util::built_with_component("server");
 
@@ -1455,371 +1456,6 @@ SKIP: {
        "finish device")
        or diag $dev->error_or_status();
 
-    #
-    # test the directtcp-target implementation
-    #
-
-    ok($dev->directtcp_supported(), "is a directtcp target");
-    for my $dev_use ('initiator', 'listener') {
-       my ($xfer, $addrs, $dest_elt);
-       if ($dev_use eq 'listener') {
-           $addrs = $dev->listen(1);
-           ok($addrs, "listen returns successfully") or die($dev->error_or_status());
-
-           # set up an xfer to write to the device
-           $dest_elt = Amanda::Xfer::Dest::DirectTCPConnect->new($addrs);
-       } else {
-           # set up an xfer to write to the device
-           $dest_elt = Amanda::Xfer::Dest::DirectTCPListen->new();
-       }
-       $xfer = Amanda::Xfer->new([
-               Amanda::Xfer::Source::Random->new(32768*34, 0xB00),
-               $dest_elt,
-           ]);
-
-       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 ($finish_connection, $start_device, $write_file_cb);
-
-
-       $finish_connection = make_cb(finish_connection => sub {
-           if ($dev_use eq 'listener') {
-               $conn = $dev->accept();
-           } else {
-               $addrs = $dest_elt->get_addrs();
-               $conn = $dev->connect(1, $addrs);
-           }
-           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($finish_connection);
-       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("indirect", 1);
-
-       my $addrs = $dev->listen(1);
-       ok($addrs, "listen returns successfully") 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) {
-           # allow other process to start listening.
-           sleep 1;
-           my $nc = $Amanda::Constants::NC;
-           $nc = $Amanda::Constants::NC6 if !$nc;
-           $nc = $Amanda::Constants::NETCAT if !$nc;
-           my $sockresult = `$nc localhost $addrs->[0][1] < /dev/null`;
-
-           my @sockresult = map { [ split(/:/, $_) ] } split(/ /, $sockresult);
-           $addrs = [ map { $_->[1] = 0 + $_->[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(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();
 }