ssh-test.pl

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;
use Net::SSH2;
use Net::SFTP;
use Carp;

use Fcntl;
use Fcntl ':DEFAULT';

use constant SSH_USER => 'root';
use constant SSH_PASS => 'toor';
use constant SSH_HOST => 'localhost';
use constant SSH_PORT => 21;

my ( $conn, $ssh, $sftp, $buf, $buffer, $len );

sub ssh_connect {
    my ( $ssh, $user, $host, $pass, $port );
    ( $user, $pass, $host, $port ) = @_;

    $host ||= 'localhost';
    $port ||= 22;

    $ssh = new Net::SSH2;
    $ssh->debug(1);
    $ssh->blocking(1);

    return 0 unless $ssh->connect($host . ':' . $port);
    print "[*] Connect OK!\n";
    return 0 unless $ssh->auth( username => $user, password => $pass);
    print "[*] Auth OK!\n";

    return $ssh;
}

sub ssh_test_docroot {
    my ( $result, $ssh, $docroot, $sftp, $remote, $hostname );
    ( $ssh, $docroot, $hostname ) = @_;

    croak "ssh_test_docroot: Arg 1(\$ssh) must be an instance of Net::SSH2." if ( ref $ssh ne 'Net::SSH2' );

    unless ( $sftp = $ssh->sftp() ) {
        # Set some error here.
        warn "[x] Could not extract Net::SSH2::SFTP object.\n";
        $ssh->close();
        return 0;
    }

    unless ( $remote = $sftp->open("$docroot/test.txt", O_CREAT, 0666) ) {
        # Set some error code here.
        warn "[x] Could not open remote file `$docroot/test.txt': " . join(":", $sftp->error) . "\n";
        $ssh->close();
        return 0;
    }

    unless ( $remote->write("Test Home Page") ) {
        # Set some error code here.
        warn "[x] Could not write contents.\n";
        $ssh->close();
        return 0;
    }

    print "[*] Wrote file. Garbage collect.\n";
    $sftp->unlink("$docroot/test.txt");

    return 1;
}

croak "[x] Unable to connect.\n" unless $ssh = ssh_connect( SSH_USER, SSH_PASS, SSH_HOST, SSH_PORT );
print "[*] Connected!\n";
print Dumper({ docroot => ssh_test_docroot( $ssh, '~/public_html' ) });
$ssh->close();