Net::SSH2 - Support for the SSH 2 protocol via libssh2.

  use Net::SSH2;

  my $ssh2 = Net::SSH2->new();

  $ssh2->connect('example.com') or die $!;

  if ($ssh2->auth_keyboard('fizban')) {
      my $chan = $ssh2->channel();
      $chan->exec('program');

      my $sftp = $ssh2->sftp();
      my $fh = $sftp->open('/etc/passwd') or die;
      print $_ while <$fh>;
  }

    my $ssh2 = Net::SSH2->new(trace => -1);

    $ssh2->trace(-1);

package Net::SSH2;

use 5.006;
use strict;
use warnings;
use Carp;

require Exporter;
use AutoLoader;

use Socket;
use IO::File;
use File::Basename;

use base 'Exporter';

# constants

my @EX_callback = qw(
        LIBSSH2_CALLBACK_DEBUG
        LIBSSH2_CALLBACK_DISCONNECT
        LIBSSH2_CALLBACK_IGNORE
        LIBSSH2_CALLBACK_MACERROR
        LIBSSH2_CALLBACK_X11
);

my @EX_channel = qw(
        LIBSSH2_CHANNEL_EXTENDED_DATA_IGNORE
        LIBSSH2_CHANNEL_EXTENDED_DATA_MERGE
        LIBSSH2_CHANNEL_EXTENDED_DATA_NORMAL
);

my @EX_socket = qw(
        LIBSSH2_SOCKET_BLOCK_INBOUND
        LIBSSH2_SOCKET_BLOCK_OUTBOUND
);

my @EX_trace = qw(
        LIBSSH2_TRACE_TRANS
        LIBSSH2_TRACE_KEX
        LIBSSH2_TRACE_AUTH
        LIBSSH2_TRACE_CONN
        LIBSSH2_TRACE_SCP
        LIBSSH2_TRACE_SFTP
        LIBSSH2_TRACE_ERROR
        LIBSSH2_TRACE_PUBLICKEY
        LIBSSH2_TRACE_SOCKET
);

my @EX_error = qw(
        LIBSSH2_ERROR_ALLOC
        LIBSSH2_ERROR_BANNER_NONE
        LIBSSH2_ERROR_BANNER_SEND
        LIBSSH2_ERROR_CHANNEL_CLOSED
        LIBSSH2_ERROR_CHANNEL_EOF_SENT
        LIBSSH2_ERROR_CHANNEL_FAILURE
        LIBSSH2_ERROR_CHANNEL_OUTOFORDER
        LIBSSH2_ERROR_CHANNEL_PACKET_EXCEEDED
        LIBSSH2_ERROR_CHANNEL_REQUEST_DENIED
        LIBSSH2_ERROR_CHANNEL_UNKNOWN
        LIBSSH2_ERROR_CHANNEL_WINDOW_EXCEEDED
        LIBSSH2_ERROR_DECRYPT
        LIBSSH2_ERROR_FILE
        LIBSSH2_ERROR_HOSTKEY_INIT
        LIBSSH2_ERROR_HOSTKEY_SIGN
        LIBSSH2_ERROR_INVAL
        LIBSSH2_ERROR_INVALID_MAC
        LIBSSH2_ERROR_INVALID_POLL_TYPE
        LIBSSH2_ERROR_KEX_FAILURE
        LIBSSH2_ERROR_KEY_EXCHANGE_FAILURE
        LIBSSH2_ERROR_METHOD_NONE
        LIBSSH2_ERROR_METHOD_NOT_SUPPORTED
        LIBSSH2_ERROR_PASSWORD_EXPIRED
        LIBSSH2_ERROR_PROTO
        LIBSSH2_ERROR_PUBLICKEY_UNRECOGNIZED
        LIBSSH2_ERROR_PUBLICKEY_UNVERIFIED
        LIBSSH2_ERROR_REQUEST_DENIED
        LIBSSH2_ERROR_SCP_PROTOCOL
        LIBSSH2_ERROR_SFTP_PROTOCOL
        LIBSSH2_ERROR_SOCKET_DISCONNECT
        LIBSSH2_ERROR_SOCKET_NONE
        LIBSSH2_ERROR_SOCKET_SEND
        LIBSSH2_ERROR_SOCKET_TIMEOUT
        LIBSSH2_ERROR_TIMEOUT
        LIBSSH2_ERROR_ZLIB
        LIBSSH2_ERROR_EAGAIN
);

my @EX_hash = qw(
        LIBSSH2_HOSTKEY_HASH_MD5
        LIBSSH2_HOSTKEY_HASH_SHA1
);

my @EX_method = qw(
        LIBSSH2_METHOD_COMP_CS
        LIBSSH2_METHOD_COMP_SC
        LIBSSH2_METHOD_CRYPT_CS
        LIBSSH2_METHOD_CRYPT_SC
        LIBSSH2_METHOD_HOSTKEY
        LIBSSH2_METHOD_KEX
        LIBSSH2_METHOD_LANG_CS
        LIBSSH2_METHOD_LANG_SC
        LIBSSH2_METHOD_MAC_CS
        LIBSSH2_METHOD_MAC_SC
);

my @EX_fxf = qw(
        LIBSSH2_FXF_APPEND
        LIBSSH2_FXF_CREAT
        LIBSSH2_FXF_EXCL
        LIBSSH2_FXF_READ
        LIBSSH2_FXF_TRUNC
        LIBSSH2_FXF_WRITE
);

my @EX_fx = qw(
        LIBSSH2_FX_BAD_MESSAGE
        LIBSSH2_FX_CONNECTION_LOST
        LIBSSH2_FX_DIR_NOT_EMPTY
        LIBSSH2_FX_EOF
        LIBSSH2_FX_FAILURE
        LIBSSH2_FX_FILE_ALREADY_EXISTS
        LIBSSH2_FX_INVALID_FILENAME
        LIBSSH2_FX_INVALID_HANDLE
        LIBSSH2_FX_LINK_LOOP
        LIBSSH2_FX_LOCK_CONFlICT
        LIBSSH2_FX_NOT_A_DIRECTORY
        LIBSSH2_FX_NO_CONNECTION
        LIBSSH2_FX_NO_MEDIA
        LIBSSH2_FX_NO_SPACE_ON_FILESYSTEM
        LIBSSH2_FX_NO_SUCH_FILE
        LIBSSH2_FX_NO_SUCH_PATH
        LIBSSH2_FX_OK
        LIBSSH2_FX_OP_UNSUPPORTED
        LIBSSH2_FX_PERMISSION_DENIED
        LIBSSH2_FX_QUOTA_EXCEEDED
        LIBSSH2_FX_UNKNOWN_PRINCIPLE
        LIBSSH2_FX_WRITE_PROTECT
);

my @EX_sftp = qw(
        LIBSSH2_SFTP_ATTR_ACMODTIME
        LIBSSH2_SFTP_ATTR_EXTENDED
        LIBSSH2_SFTP_ATTR_PERMISSIONS
        LIBSSH2_SFTP_ATTR_SIZE
        LIBSSH2_SFTP_ATTR_UIDGID
        LIBSSH2_SFTP_LSTAT
        LIBSSH2_SFTP_OPENDIR
        LIBSSH2_SFTP_OPENFILE
        LIBSSH2_SFTP_PACKET_MAXLEN
        LIBSSH2_SFTP_READLINK
        LIBSSH2_SFTP_REALPATH
        LIBSSH2_SFTP_RENAME_ATOMIC
        LIBSSH2_SFTP_RENAME_NATIVE
        LIBSSH2_SFTP_RENAME_OVERWRITE
        LIBSSH2_SFTP_SETSTAT
        LIBSSH2_SFTP_STAT
        LIBSSH2_SFTP_SYMLINK
        LIBSSH2_SFTP_TYPE_BLOCK_DEVICE
        LIBSSH2_SFTP_TYPE_CHAR_DEVICE
        LIBSSH2_SFTP_TYPE_DIRECTORY
        LIBSSH2_SFTP_TYPE_FIFO
        LIBSSH2_SFTP_TYPE_REGULAR
        LIBSSH2_SFTP_TYPE_SOCKET
        LIBSSH2_SFTP_TYPE_SPECIAL
        LIBSSH2_SFTP_TYPE_SYMLINK
        LIBSSH2_SFTP_TYPE_UNKNOWN
        LIBSSH2_SFTP_VERSION
);

my @EX_disconnect = qw(
        SSH_DISCONNECT_AUTH_CANCELLED_BY_USER
        SSH_DISCONNECT_BY_APPLICATION
        SSH_DISCONNECT_COMPRESSION_ERROR
        SSH_DISCONNECT_CONNECTION_LOST
        SSH_DISCONNECT_HOST_KEY_NOT_VERIFIABLE
        SSH_DISCONNECT_HOST_NOT_ALLOWED_TO_CONNECT
        SSH_DISCONNECT_ILLEGAL_USER_NAME
        SSH_DISCONNECT_KEY_EXCHANGE_FAILED
        SSH_DISCONNECT_MAC_ERROR
        SSH_DISCONNECT_NO_MORE_AUTH_METHODS_AVAILABLE
        SSH_DISCONNECT_PROTOCOL_ERROR
        SSH_DISCONNECT_PROTOCOL_VERSION_NOT_SUPPORTED
        SSH_DISCONNECT_RESERVED
        SSH_DISCONNECT_SERVICE_NOT_AVAILABLE
        SSH_DISCONNECT_TOO_MANY_CONNECTIONS
);

our %EXPORT_TAGS = (
    all        => [
        @EX_callback, @EX_channel, @EX_error, @EX_socket, @EX_trace, @EX_hash,
        @EX_method, @EX_fx, @EX_fxf, @EX_sftp, @EX_disconnect,
    ],
    # ssh
    callback   => \@EX_callback,
    channel    => \@EX_channel,
    error      => \@EX_error,
    socket     => \@EX_socket,
    trace      => \@EX_trace,
    hash       => \@EX_hash,
    method     => \@EX_method,
    disconnect => \@EX_disconnect,
    # sftp
    fx         => \@EX_fx,
    fxf        => \@EX_fxf,
    sftp       => \@EX_sftp,
);

our @EXPORT_OK = @{$EXPORT_TAGS{all}};

our $VERSION = '0.38';

# methods

sub new {
    my $class = shift;
    my %opts  = @_;

    my $self = $class->_new;

    $self->trace($opts{trace}) if exists $opts{trace};

    return $self;
}

sub connect {
    my $self = shift;
    croak "Net::SSH2::connect: not enough parameters" if @_ < 1;

    my $wantarray = wantarray;

    # try to connect, or get a file descriptor
    my ($fd, $sock);
    if (@_ == 1) {
        $sock = shift;
        if ($sock =~ /^\d{1,10}$/) {
            $fd = $sock;
        } elsif(ref $sock) {
            # handled below
        } else {
            @_ = ($sock, getservbyname(qw(ssh tcp)) || 22);
        }
    }

    my %opts = splice @_, 2 if @_ >= 4;
    $opts{Timeout} ||= 30;

    if (@_ == 2) {
        require IO::Socket::INET;
        $sock = IO::Socket::INET->new(
            PeerHost => $_[0],
            PeerPort => $_[1],
            Timeout => $opts{Timeout},
        );

        if (not $sock) {
            if (not defined $wantarray) {
                croak "Net::SSH2: failed to connect to $_[0]:$_[1]: $!"
            } else {
                return; # to support ->connect ... or die
            }
        }

        $sock->sockopt(SO_LINGER, pack('SS', 0, 0));
    }

    # get a file descriptor
    $fd ||= fileno($sock);
    croak "Net::SSH2::connect: can't get file descriptor for $sock"
     unless defined $fd;
    if ($^O eq 'MSWin32') {
        require Win32API::File;
        $fd = Win32API::File::FdGetOsFHandle($fd);
    }

    # pass it in, do protocol
    return $self->_startup($fd, $sock);
}

my %Auth = (
    'hostbased'     => {
        ssh    => 'hostbased',
        method => \&auth_hostbased,
        params => [qw(username publickey privatekey
                   hostname local_username? password?)],
    },
    'publickey'     => {
        ssh    => 'publickey',
        method => \&auth_publickey,
        params => [qw(username publickey privatekey password?)],
    },
    'keyboard'      => {
        ssh    => 'keyboard-interactive', 
        method => \&auth_keyboard,
        params => [qw(_interact username cb_keyboard?)]
    },
    'keyboard-auto' => {
        ssh    => 'keyboard-interactive',
        method => \&auth_keyboard,
        params => [qw(username password)],
    },
    'password'      => {
        ssh    => 'password',
        method => \&auth_password,
        params => [qw(username password cb_password?)],
    },
    'none'          => {
        ssh    => 'none',
        method => \&auth_password,
        params => [qw(username)],
    },
);

my @Rank = qw(hostbased publickey keyboard keyboard-auto password none);

sub auth {
    my ($self, %p) = @_;
    my $rank = delete $p{rank} || \@Rank;

    TYPE: for(my $i = 0; $i < @$rank; $i++) {
        my $type = $rank->[$i];
        my $data = $Auth{$type};
        confess "unknown authentication method '$type'" unless $data;

        # do we have the required parameters?
        my @pass;
        for my $param(@{$data->{params}}) {
            my $p = $param;
            my $opt = $p =~ s/\?$//;
            my $pseudo = $p =~ s/^_//;
            next TYPE if not $opt and not exists $p{$p};
            next if $pseudo;     # don't push pseudos
            push @pass, $p{$p};  # if it's optional, store undef
        }

        # invoke the authentication method
        return $type if $data->{method}->($self, @pass) and $self->auth_ok;
    }
    return;  # failure
}

sub scp_get {
    my ($self, $remote, $path) = @_;
    $path = basename $remote if not defined $path;

    my %stat;
    my $chan = $self->_scp_get($remote, \%stat);
    return unless $chan;

    # read and commit blocks until we're finished
    $chan->blocking(1);
    my $mode = $stat{mode} & 0777;
    my $file = ref $path ? $path
       : IO::File->new($path, O_WRONLY | O_CREAT | O_TRUNC, $mode);
    return unless $file;

    for (my ($size, $count) = ($stat{size}); $size > 0; $size -= $count) {
      my $buf = '';
      my $block = ($size > 8192) ? 8192 : $size;
      $count = $chan->read($buf, $block);
      return unless defined $count;
      $self->error(0, "read $block bytes but only got $count"), return
       unless $count == $block;
      $self->error(0, "error writing $count bytes to file"), return
       unless $file->syswrite($buf, $count) == $count;
    }

    # process SCP acknowledgment and send same
    my $eof;
    $chan->read($eof, 1);
    $chan->write("\0");
    undef $chan;  # close
    return 1;
}

sub scp_put {
    my ($self, $path, $remote) = @_;
    $remote = basename $path if not defined $remote;

    my $file = ref $path ? $path : IO::File->new($path, O_RDONLY);
    $self->error($!, $!), return unless $file;
    my @stat = $file->stat;
    $self->error($!, $!), return unless @stat;

    my $mode = $stat[2] & 0777;  # mask off extras such as S_IFREG
    my $chan = $self->_scp_put($remote, $mode, @stat[7, 8, 9]);
    return unless $chan;
    $chan->blocking(1);

    # read and transmit blocks until we're finished
    for (my ($size, $count) = ($stat[7]); $size > 0; $size -= $count) {
      my $buf;
      my $block = ($size > 8192) ? 8192 : $size;
      $count = $file->sysread($buf, $block);
      $self->error($!, $!), return unless defined $count;
      $self->error(0, "want $block, have $count"), return
       unless $count == $block;
      die 'sysread mismatch' unless length $buf == $count;
      my $wrote = 0;
      while ($wrote >= 0 && $wrote < $count) {
        my $wr = $chan->write($buf);
        last if $wr < 0;
        $wrote += $wr;
        $buf = substr $buf, $wr;
      }
      $self->error(0, "error writing $count bytes to channel"), return
       unless $wrote == $count;
    }

    # send/receive SCP acknowledgement
    $chan->write("\0");
    my $eof;
    $chan->read($eof, 1);
    return 1;
}

my %Event;

sub _init_poll {
    for my $event(qw(
     pollin pollpri pollext pollout pollerr pollhup pollnval pollex
     session_closed channel_closed listener_closed
    )) {
        no strict 'refs';
        my $name = 'LIBSSH2_POLLFD_'.uc($event);
        (my $_event = $event) =~ s/^poll//;
        $Event{$_event} = &$name;
    }
}

sub poll {
    my ($self, $timeout, $event) = @_;
    $timeout ||= 0;

    # map incoming event structure (files to handles, events to integers)
    my @event;
    for my $in (@$event) {
        my ($handle, $events) = @{$in}{qw(handle events)};
        $handle = fileno $handle
         unless ref $handle and ref($handle) =~ /^Net::SSH2::/;
        my $out = { handle => $handle, events => 0 };
        $events = [$events] if not ref $events and $events =~ /^\D+$/;
        if (UNIVERSAL::isa($events, 'ARRAY')) {
            for my $name(@$events) {
                my $value = $Event{$name};
                croak "Net::SSH2::poll: can't translate event '$name'"
                 unless defined $value;
                $out->{events} |= $value;
            }
        } else {
            $out->{events} = $events || 0;
        }
        push @event, $out;
    }

    my $count = $self->_poll($timeout, \@event);
    return if not defined $count;

    # map received event structure (bitmask to hash of flags)
    my $i = 0;
    for my $item(@event) {
        my $revents = $item->{revents};
        my $out = $event->[$i++]->{revents} = { value => $revents };
        my $found = 0;  # can't mask off values, since there are dupes
        while (my ($name, $value) = each %Event) {
            $out->{$name} = 1, $found |= $value if $revents & $value;
        }
        $out->{unknown} = $revents & ~$found if $revents & ~$found;
    }
    $count
}

sub _cb_kbdint_response_default {
    my ($self, $user, $name, $instr, @prompt) = @_;
    require Term::ReadKey;

    local $| = 1;
    my $prompt = "[user $user] ";
    $prompt .= "$name\n" if $name;
    $prompt .= "$instr\n" if $instr;
    $prompt =~ s/ $/\n/;
    print $prompt;

    my @out;
    for my $prompt(@prompt) {
        print STDERR "$prompt->{text}";

        Term::ReadKey::ReadMode('noecho') unless $prompt->{echo};
        chomp(my $value = Term::ReadKey::ReadLine(0));
        Term::ReadKey::ReadMode('normal') unless $prompt->{echo};
        push @out, $value;
    }
    @out
}


# mechanics

sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.

    my $constname;
    our $AUTOLOAD;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "&Net::SSH2::constant not defined" if $constname eq 'constant';
    my ($error, $val) = constant($constname);
    if ($error) { croak $error; }
    {
        no strict 'refs';
        *$AUTOLOAD = sub { $val };
    }
    goto &$AUTOLOAD;
}

require XSLoader;
XSLoader::load('Net::SSH2', $VERSION);

_init_poll();

require Net::SSH2::Channel;
require Net::SSH2::SFTP;
require Net::SSH2::File;
require Net::SSH2::Listener;

1;
__END__