view release on metacpan or  search on metacpan

t/Net-SSH2.t  view on Meta::CPAN

my $sha1 = $ssh2->hostkey_hash('sha1');
is(length $sha1, 20, 'have SHA1 hostkey hash');

ok($ssh2->check_hostkey('advisory', $known_hosts), "check remote key - advisory")
    or diag(join " ", "Error:", $ssh2->error);

ok($ssh2->check_hostkey($policy, $known_hosts), "check remote key - ask")
    or diag(join " ", "Error:", $ssh2->error);

# (3) authentication methods
unless ($user) {
    my $def_user = eval { getpwuid $< };
    $user = $ssh2->_ask_user("Enter username" . ($def_user ? " [$def_user]: " : ": "), 1);
    $user = $def_user unless defined $user and length $user;
}
my $auth = $ssh2->auth_list($user);
ok($auth, "authenticate: $auth");
my @auth_methods = split /,/, $auth;
is_deeply(\@auth_methods, [$ssh2->auth_list($user)], 'list matches comma-separated');
ok(!$ssh2->auth_ok, 'not authenticated yet');

# (2) authenticate
my $type;
my $home = $ssh2->_local_home;
if (defined $home) {
    for my $key (qw(dsa rsa)) {
        my $path = "$home/.ssh/id_$key";
        if ($ssh2->auth_publickey($user, "$path.pub", $path,
                                  $passphrase)) {
            diag "authenticated with key at $path";
            $type = 'pubkey';
            last;
        }
        else {
            diag "failed to authenticate with key at $path";
        }
    }
}

unless ($type) {
    diag "reverting to password authentication";
    $type = $ssh2->auth(username => $user,
                        password => $password,
                        interact => 1);
}

ok($ssh2->auth_ok, 'authenticated successfully');
ok($type, "authentication type is defined (".($type||undef).")");

# (5) channels
ok(!defined eval { $ssh2->channel("direct-tcpip") }, "only session channels");

my $chan = $ssh2->channel();
isa_ok($chan, 'Net::SSH2::Channel');
$chan->blocking(0); pass('set blocking');
ok(!$chan->eof(), 'not at EOF');
ok($chan->ext_data('normal'), 'normal extended data handling');
ok($chan->ext_data('merge'), 'merge extended data');

# (3) environment
is($chan->setenv(), 1, 'empty setenv');
my %env = (test1 => 'A', test2 => 'something', test3 => 'E L S E', LANG => 'C');
# most sshds disallow set, so we're happy if these don't crash
ok($chan->setenv(%env) || 1, 'set environment variables, it is ok if it fails');
is($chan->session, $ssh2, 'verify session');

# (1) callback
ok($ssh2->callback(disconnect => sub { warn "SSH_MSG_DISCONNECT!\n"; }),
 'set disconnect callback');

# (2) SFTP
$ssh2->blocking(1);  # creating channel may block
my $sftp = $ssh2->sftp();
isa_ok($sftp, 'Net::SSH2::SFTP');

is($sftp->session, $ssh2, 'verify session');

# (4) directories
my $dir = "net_ssh2_$$";
ok($sftp->mkdir($dir), "create directory $dir");
my %stat = $sftp->stat($dir);
ok(scalar keys %stat, 'stat directory');
ok($stat{mode} & 0x4000, 'type is directory');
is($stat{name}, $dir, 'directory name matches');

# (4) SCP

my $fn = "ppport.h";
my ($local_vol, $local_dir) = File::Spec->splitpath(File::Spec->rel2abs($0));
my $local_fn = File::Spec->join($local_vol, $local_dir, File::Spec->updir, $fn);
my $local_data = slurp($local_fn);
my @local_lines = slurp($local_fn);

my $remote_fn = "$dir/$fn";
ok($ssh2->scp_put($local_fn, $remote_fn), "put $local_fn to remote $remote_fn");

SKIP: { # SKIP-scalar
    eval { require IO::Scalar };
    skip '- IO::Scalar required', 2 if $@;
    my $tmp = IO::Scalar->new;
    ok($ssh2->scp_get($remote_fn, $tmp), "get $remote_fn from remote");
    my $remote_data = ${$tmp->sref};
    if (length $remote_data == length $local_data) {
        is($remote_data, $local_data, 'files match');
    }
    else {
        fail('file size match');
        if (length $remote_data == 0) {
            diag <<MSG
This is a known bug of Straberry perl: there is a mismatch between perl and libssh2 about the layout of 'struct stat'.
The best way to avoid it is to upgrade libssh2 to version 1.6.1 or later.
This bug affects SCP methods only.
MSG
        }
    }
} # SKIP-scalar

my $remote_fn_quoted = quote($remote_fn);
$chan = $ssh2->channel();
# $ssh2->trace(-1);
$chan->ext_data('ignore');
$chan->send_eof;
ok($chan->exec("cat $remote_fn_quoted"), "exec cat $remote_fn_quoted");
my $remote_data = do { local $/; <$chan> };