add support for Net::SSH::Perl emulation

Changes

@@ -1,5 +1,9 @@
 Revision history for Perl extension Net::OpenSSH::Compat.
 
+0.03 
+        - add support for Net::SSH::Perl
+        - minor doc corrections
+
 0.02  May 29, 2011
         - add support for auth_list
         - add support for "Net::SSH2::method" method.

MANIFEST

@@ -4,7 +4,9 @@ lib/Net/OpenSSH/Compat.pm
 lib/Net/OpenSSH/Compat/SSH2.pm
 lib/Net/OpenSSH/Compat/SSH2/Constants.pm
 lib/Net/OpenSSH/Compat/SSH2/Poll.pm
+lib/Net/OpenSSH/Compat/Perl.pm
 Makefile.PL
 MANIFEST
 README
 t/Net-OpenSSH-Compat.t
+t/pods.t

Makefile.PL

@@ -2,6 +2,6 @@ use ExtUtils::MakeMaker;
 
 WriteMakefile( NAME         => 'Net::OpenSSH::Compat',
                VERSION_FROM => 'lib/Net/OpenSSH/Compat.pm',
-               PREREQ_PM    => { "Net::OpenSSH" => "0.51_11" },
+               PREREQ_PM    => { "Net::OpenSSH" => "0.53_03" },
                AUTHOR       => 'Salvador Fandino <sfandino@yahoo.com>'
              );

lib/Net/OpenSSH/Compat.pm

@@ -1,12 +1,13 @@
 package Net::OpenSSH::Compat;
 
-our $VERSION = '0.02';
+our $VERSION = '0.03';
 
 use strict;
 use warnings;
 use Carp;
 
-my %impl = ('Net::SSH2' => 'SSH2');
+my %impl = ('Net::SSH2' => 'SSH2',
+            'Net::SSH::Perl' => 'Perl');
 
 sub import {
     my $class = shift;
@@ -30,16 +31,16 @@ Net::OpenSSH::Compat - Compatibility modules for Net::OpenSSH
 =head1 SYNOPSIS
 
   use Net::OpenSSH::Compat 'Net::SSH2';
-
+  use Net::OpenSSH::Compat 'Net::SSH::Perl';
 
 =head1 DESCRIPTION
 
 This package contains a set of adapter modules that run on top of
 Net::OpenSSH providing the APIs of other SSH modules available from
 CPAN.
 
-Currently, there are an only adapter available for
-L<Net::SSH2>. Adapters for L<Net::SSH> and L<Net::SSH::Perl> are
+Currently, there are adapters available for L<Net::SSH2> and
+L<Net::SSH::Perl>. Adapters for L<Net::SSH> and L<Net::SFTP> are
 planned... maybe also for L<Net::SCP> and L<Net::SCP::Expect> if
 somebody request them.
 
@@ -66,7 +67,8 @@ upon: L<http://www.openssh.org/donations.html>.
 
 =head1 SEE ALSO
 
-L<Net::OpenSSH>, L<Net::OpenSSH::Compat::SSH2>.
+L<Net::OpenSSH>, L<Net::OpenSSH::Compat::SSH2>,
+L<Net::OpenSSH::Compat::Perl>.
 
 =head1 COPYRIGHT AND LICENSE
 

lib/Net/OpenSSH/Compat/Perl.pm

@@ -4,16 +4,19 @@ our $VERSION = '0.03';
 
 use strict;
 use warnings;
-use Carp;
+use Carp ();
 
 use Net::OpenSSH;
-use Net::OpenSSH::Constants qw(OSSH_MASTER_FAILED);
+use Net::OpenSSH::Constants qw(OSSH_MASTER_FAILED OSSH_SLAVE_CMD_FAILED) ;
 
 require Exporter;
+our @ISA = qw(Exporter);
 
 my $supplant;
+my $session_id = 1;
 
-our %DEFAULTS = ( session => [ port => 22, proto => '2' ] );
+our %DEFAULTS = ( session    => [proto => 2],
+                  connection => [] );
 
 sub import {
     my $class = shift;
@@ -39,21 +42,16 @@ sub import {
     __PACKAGE__->export_to_level(1, @_);
 }
 
+sub version { "1.34 (".__PACKAGE__."-$VERSION)" }
+
 sub new {
     my $class = shift;
     my $host = shift;
-    my %opts = @{$DEFAULTS{session}}, @_;
+    my $cfg = Net::OpenSSH::Compat::Perl::Config->new(@_);
     my $cpt = { host => $host,
-                state => 'new' };
-
-    $cpt{$_} = delete $opts{$_} for qw(port debug interactive
-                                       privileged identity_files
-                                       cipher ciphers
-                                       compression compression_level
-                                       use_pty options);
-
-    %opts and Carp::croak "unsupported option(s) given: ".join(", ", keys %opts);
-    $cpt{proto} =~ /\b2\b/ or croak "Unsupported protocol version requested $cpt{proto}";
+                state => 'new',
+                cfg => $cfg,
+                session_id => $session_id++ };
 
     bless $cpt, $class;
 }
@@ -75,7 +73,7 @@ sub _check_state {
     return 1 if $expected eq $state;
     my $method = $cpt->_entry_method;
     my $class = ref $cpt;
-    croak qq($class object can't do "$method" on state $state);
+    Carp::croak qq($class object can't do "$method" on state $state);
     return
 }
 
@@ -84,42 +82,52 @@ sub _check_error {
     my $ssh = $cpt->{ssh};
     return if (!$ssh->error or $ssh->error == OSSH_SLAVE_CMD_FAILED);
     my $method = $cpt->_entry_method;
-    $self->{state} = 'failed' if $ssh->error == OSSH_MASTER_FAILED;
-    croak "$method failed: " . $ssh->error;
+    $cpt->{state} = 'failed' if $ssh->error == OSSH_MASTER_FAILED;
+    Carp::croak "$method failed: " . $ssh->error;
 }
 
 sub login {
     my ($cpt, $user, $password, $suppress_shell) = @_;
     $cpt->_check_state('new');
 
     $cpt->{user} = $user;
-    $cpt->{password} = $password;
-    $cpt->{suppress_shell} = $shell;
-
-    my @args = (host => $cpt->{host},
-                port => $cpt->{port},
-                user => $cpt->{user});
+    $cpt->{password} = '*****' if defined $password;
+    $cpt->{suppress_shell} = $suppress_shell;
 
+    my @args = (host => $cpt->{host}, @{$DEFAULTS{connection}});
+    push @args, user => $user if defined $user;
     push @args, password => $password if defined $password;
-    push @args, batch_mode => 1 if $cpt->{interactive};
-    push @args, -o => 'UsePrivilegedPort=yes' if $cpt->{privileged};
-    push @args, -o => "Ciphers=$cpt->{ciphers}" if defined $cpt->{ciphers};
-    push @args, -o => "Compression=$cpt->{compression}" if defined $cpt->{compression};
-    push @args, -o => "CompressionLevel=$cpt->{compression_level}" if defined $cpt->{compression_level};
-    if ($cpt->{identity_files}) {
-        push @args, -o "IdentityFile=$_" for @{$cpt->{identity_files}};
+
+    my $cfg = $cpt->{cfg};
+    push @args, port => $cfg->{port} if defined $cfg->{port};
+    push @args, batch_mode => 1 unless $cfg->{interactive};
+
+    my @more;
+    push @more, 'UsePrivilegedPort=yes' if $cfg->{privileged};
+    push @more, "Ciphers=$cfg->{ciphers}" if defined $cfg->{ciphers};
+    push @more, "Compression=$cfg->{compression}" if defined $cfg->{compression};
+    push @more, "CompressionLevel=$cfg->{compression_level}" if defined $cfg->{compression_level};
+    if ($cfg->{identity_files}) {
+        push @more, "IdentityFile=$_" for @{$cfg->{identity_files}};
+    }
+    if ($cfg->{options}) {
+        push @more, @{$cfg->{options}};
     }
+    push @args, master_opts => [map { -o => $_ } @more];
+    # warn "args: @args";
 
     my $ssh = $cpt->{ssh} = Net::OpenSSH->new(@args);
-    $ssh->die_on_error;
-
+    if ($ssh->error) {
+        $ssh->{state} = 'failed';
+        $ssh->die_on_error;
+    }
     $cpt->{state} = 'connected';
 }
 
 sub cmd {
     my ($cpt, $cmd, $stdin) = @_;
     $cpt->_check_state('connected');
-    $ssh = $cpt->{ssh};
+    my $ssh = $cpt->{ssh};
     $stdin = '' unless defined $stdin;
     local $?;
     my ($out, $err) = $ssh->capture2({stdin_data => $stdin}, $cmd);
@@ -130,7 +138,172 @@ sub cmd {
 sub shell {
     my $cpt = shift;
     $cpt->_check_state('connected');
+    my $ssh = $cpt->{ssh};
+    $ssh->system({tty => 1});
 }
 
+sub config { shift->{cfg} }
+
+sub debug { Carp::carp("@_") if shift->{cfg}{debug} }
+
+sub session_id { shift->{session_id} }
+
+my $make_missing_methods = sub {
+    my $pkg = caller;
+    my $faked = $pkg;
+    $faked =~ s/^Net::OpenSSH::Compat::/Net::SSH::/;
+    for (@_) {
+        my $name = $_;
+        no strict 'refs';
+        *{$pkg.'::'.$name} = sub {
+            Carp::croak("method ${faked}::$name is not implemented by $pkg, report a bug if you want it supported!");
+        }
+    }
+};
+
+$make_missing_methods->(qw(register_handler
+                           sock
+                           incomming_data
+                           packet_start));
+
+package Net::OpenSSH::Compat::Perl::Config;
+
+sub new {
+    my $class = shift;
+    my %opts = (@{$DEFAULTS{session}}, @_);
+    my %cfg = map { my $v = delete $opts{$_};
+                    defined $v ? ($_, $v) : () } qw(port proto debug interactive
+                                                    privileged identity_files cipher
+                                                    ciphers compression
+                                                    compression_level use_pty
+                                                    options);
+
+
+    %opts and Carp::croak "unsupported configuration option(s) given: ".join(", ", keys %opts);
+    $cfg{proto} =~ /\b2\b/ or Carp::croak "Unsupported protocol version requested $cfg{proto}";
+
+    bless \%cfg, $class;
+}
+
+sub get { $_[0]->{$_[1]} }
+
+sub set {
+    my ($cfg, $k, $v) = @_;
+    $cfg->{$k} = $v if @_ == 3;
+    $cfg->{$k};
+}
+
+sub DESTROY {};
+
+$make_missing_methods->(qw(read_config merge_directive AUTOLOAD));
 
 1;
+
+__END__
+
+=head1
+
+Net::OpenSSH::Compat::Perl - Net::OpenSSH adapter for Net::SSH::Perl API compatibility
+
+=head1 SYNOPSIS
+
+  use Net::OpenSSH::Compat::Perl qw(:supplant);
+
+  use Net::SSH::Perl;
+
+  my $ssh = Net::SSH::Perl->new('host');
+  $ssh->login($user, $passwd);
+
+  my ($out, $err, $rc) = $ssh->cmd($cmd);
+
+=head1 DESCRIPTION
+
+This module implements a subset of L<Net::SSH::Perl> API on top of
+L<Net::OpenSSH>.
+
+After the module is loaded as...
+
+  use Net::OpenSSH::Compat::Perl qw(:supplant);
+
+... it supplants the Net::SSH::Perl module as if it were installed on
+the machine using L<Net::OpenSSH> under the hood to handle SSH
+operations.
+
+=head2 Setting defaults
+
+The hash C<%Net::OpenSSH::Compat::Perl::DEFAULTS> can be used to set
+default values for L<Net::OpenSSH> and other modules called under the
+hood and otherwise not accesible through the Net::SSH::Perl API.
+
+The entries currently supported are:
+
+=over
+
+=item connection => [ %opts ]
+
+Extra options passed to C<Net::OpenSSH::new> constructor.
+
+Example:
+
+  $Net::OpenSSH::Compat::SSH::Perl::DEFAULTS{connection} =
+    [ ssh_path => "/opt/SSH/bin/ssh" ];
+
+=back
+
+=head1 BUGS AND SUPPORT
+
+B<This is a work in progress.>
+
+C<register_handler> method is not supported.
+
+Net::SSH::Perl submodules (i.e. L<Net::SSH::Perl::Channel>) are not emulated.
+
+Anyway, if your Net::SSH::Perl script fails, fill a bug report at the CPAN
+RT bugtracker
+(L<https://rt.cpan.org/Ticket/Create.html?Queue=Net-OpenSSH-Compat>)
+or just send me an e-mail with the details.
+
+Include at least:
+
+=over 4
+
+=item 1 - The full source of the script
+
+=item 2 - A description of what happens in your machine
+
+=item 3 - What you thing it should be happening
+
+=item 4 - What happens when you use the real Net::SSH::Perl
+
+=item 5 - The version and name of your operating system
+
+=item 6 - The version of the OpenSSH ssh client installed on your machine (C<ssh -V>)
+
+=item 7 - The Perl version (C<perl -V>)
+
+=item 8 - The versions of the Perl packages Net::OpenSSH, IO::Pty and this Net::OpenSSH::Compat.
+
+=back
+
+=head2 Git repository
+
+The source code repository is at
+L<https://github.com/salva/p5-Net-OpenSSH-Compat>.
+
+=head2 My wishlist
+
+If you like this module and you're feeling generous, take a look at my
+Amazon Wish List: L<http://amzn.com/w/1WU1P6IR5QZ42>
+
+Also consider contributing to the OpenSSH project this module builds
+upon: L<http://www.openssh.org/donations.html>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2011 by Salvador FandiE<ntilde>o (sfandino@yahoo.com)
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut

t/pods.t

@@ -0,0 +1,12 @@
+#!/usr/bin/perl
+
+use strict;
+use Test::More;
+
+plan skip_all => "Only the author needs to check that POD docs are right"
+    unless eval "no warnings; getlogin eq 'salva'";
+
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+
+all_pod_files_ok( all_pod_files( qw(blib) ) );