[Chicago-talk] Net::SSH::W32Perl

Young, Darren Darren.Young at chicagobooth.edu
Mon Nov 9 09:08:01 PST 2009

Thanks a bunch, I'll fiddle around with it this week.


The remote I'm connecting to is a NetApp filer and I only need to
execute remote commands and grab the results. Even then it's only the
pieces that their SDK doesn't implement.


From: chicago-talk-bounces+darren.young=chicagobooth.edu at pm.org
[mailto:chicago-talk-bounces+darren.young=chicagobooth.edu at pm.org] On
Behalf Of Sean Blanton
Sent: Monday, November 09, 2009 9:43 AM
To: Chicago.pm chatter
Subject: Re: [Chicago-talk] Net::SSH::W32Perl


How many of these apply to you with a different environment, I don't
know. Here it is, unfinished, "as is" warts and all, but mostly working.


* I couldn't get the 'shell' to work, so only used exec, put and get

* The key is to manage the blocking around grabbing a channel and
executing the different ops.

* Below, I let the program continue when there is an error, and you will
want your own error messages (and to rework the entire error handling).

* The put operation did not update the timestamp of the remote file -
there is a hack to update it.

* The Solaris box I was connecting to was running the KeON security
application - I doubt that had an effect, but who knows?



package XXX::DeploySSH;



=head1 NAME


XXX::DeploySSH - Use SSH from within Perl for build and deploy




 #-- Import module

 use XXX::DeploySSH;


 #-- Set connection parameters

 my $ds = XXX::DeploySSH->new() or die;




 #-- Initiate connection including authentication

 $ds->connect() or die "Couldn't connect to $hostname";


 #-- Execute a command. Non-zero return code is bad

 my ($rc, @output) = $ds->exec("ls -la");


 print "Output:\n at output\n";

 print "Remote command executed successfully.\n" unless $rc;

 print "ERROR: Remote command failed.\n" if $rc;


 #-- Transfer a file. Note opposite sense of return code. 1 is good now.

 my $rc = $ds->put( $full_target, "$stage_dir/$target_file" )

          or die "SFTP put of '$full_target' to
'$stage_dir/$target_file' failed";




Uses the SSH2 protocol to create session, execute commands or transfer
files from iwthin Perl.

Each command is issued on its own "channel'. The execution method is by
C<exec>, so you can only

run programs with arguments, not shell commands.


The connection method is via publickey authentication. The public and
private key names as well as

the password for encrypting the private key are all hardcoded in the
module itself. Sure there is a

better way, but that is the current state.




=head2 Constructor


The constructor is called with no arguments.


 my $ds = XXX::DeploySSH->new();


=head2 Accessors


=over 4


=item $ds->set_user($user)


The user authenticating via SSH2. Must set the user before calling


=item $ds->set_hostname($hostname)


The hostname that you want to connect to. Must set the hostname before
calling connect().




=head2 Operators


=over 4


=item $ds->exec($remote_cmd)


Executes C<$remote_cmd> on the machine you are connected to. This method


 ($rc, at output)


Where C<$rc> is the return code and C<@output> is any output. Note that
the return

value of this method is different from put() and get() because they only

success/fail, whereas exec() needs to return the return code of the
program execution

and output.


=item $ds->put($local_file,$remote_file)


Transfers C<$local_file> to C<$remote_file> on the connected machine.


=item $ds->get($remote_file,$local_file)


Retrieves C<$local_file> from C<$remote_file> on the connected machine.




=head2 Other


=over 4


=item $ds->disconnect()


Terminates the connection.






Install required modules on Windows using the C<< ppm install <module>
>> command.


=over 4


=item * Net::SSH2 - Base methods handling the SSH2 protocol.


=item * Carp - For error handling.






=over 4


=item * Occasional flakiness occurs where a command returns an error for
no apparent reason. If this 

happens, re-execute the workflow.


=item * Output is not being returned by exec() in some cases.




=head1 TODO'S


=over 4


=item * Have constructor accept user and hostname arguments.




=head1 AUTHOR


Sean Blanton of OpenMake Software for XXX


=head1 SEE ALSO


 Net::SSH2, XXX::DeployProperties







          use Exporter ();


          use vars qw(@ISA @EXPORT $VERSION);


          @ISA    = qw(Exporter);

          @EXPORT = qw(






use Net::SSH2;

use Carp qw{confess cluck};

use strict;


our $AUTOLOAD;    # it's a package global


our %fields = (

          hostname             => undef,

          user                 => undef,

          private_key          => undef,

          public_key           => undef,

          private_key_password => undef,

          ssh2_handle          => undef,



our $home_dir = $^O =~ /win/i ? $ENV{USERPROFILE} . "/.ssh" : $ENV{HOME}
. "/.ssh";


#TODO: The password should be found by lookup instead of hardcoded here

our $password =

  'XYXYXYX';    #-- password that encrypts the private key, not the

our $private_key = "$home_dir/ccbuilder";

our $public_key  = "$home_dir/ccbuilder.pub";


die "Private key file '$private_key' does not exist as a file."

  unless -f $private_key;

die "Public key file '$public_key' does not exist as a file."

  unless -f $public_key;


sub new {

          my $proto = shift;

          my $class = ref($proto) || $proto;

          my $self  = {

                      _permitted => \%fields,




          bless( $self, $class );





          my $ssh2 = Net::SSH2->new() or confess("couldn't create ssh2



          return $self;



sub connect {

          my $self = shift

           or confess "FATAL: Wrong args!";


          my $hostname    = $self->get_hostname()    or confess('');

          my $user        = $self->get_user()        or confess('');

          my $private_key = $self->get_private_key() or confess('');

          my $public_key  = $self->get_public_key()  or confess('');

          my $password = $self->get_private_key_password() or

          my $ssh2     = $self->get_ssh2_handle()          or


          $ssh2->connect($hostname) or die "ERROR: Couldn't connect to


          $ssh2->auth_publickey( $user, $public_key, $private_key,
$password );


          unless ( $ssh2->auth_ok ) {

                      my ( $rc, $err_msg ) = $ssh2->error;


                      cluck("ERROR: can't log in: $rc : $err_msg");

                      return undef;





sub disconnect {

          my $self = shift

           or confess "FATAL: Wrong args!";


          if ( my $ssh2 = $self->get_ssh2_handle() ) {





          return 1;



sub exec {

          my $self = shift or die;

          my $cmd  = shift or die;


          my $ssh2 = $self->get_ssh2_handle() or confess();


          my $chan = _get_channel($ssh2);


          my @output = <$chan>;


          my $rc = $chan->exit_status;


          cluck("ERROR: $rc\n at output\n") if $rc;


          $chan->close;    #-- channel is useless after exec


          return $rc, @output;




sub put {

          my $self        = shift or die;

          my $local_file  = shift or die;

          my $remote_file = shift or die;


          my $ssh2 = $self->get_ssh2_handle() or confess();



          $ssh2->scp_put( "$local_file", "$remote_file" );


          #-- Note bug from scp_put puts wrong mtime. Put it right.

          # take care to actually transfer the file.

          my $sftp = $ssh2->sftp();



          $sftp->setstat( "$remote_file", 'mtime', time() );





          return check_ssh2_error($ssh2);




sub get {

          my $self        = shift or die;

          my $remote_file = shift or die;

          my $local_file  = shift or die;


          my $ssh2 = $self->get_ssh2_handle() or confess();



          $ssh2->scp_get( "$remote_file", "$local_file" );


          return check_ssh2_error($ssh2);




#-- Get a(nother) channel for this logon session

# NOTE: Class function, not an object method

sub _get_channel {

          my $ssh2 = shift or confess();



          my $chan = $ssh2->channel();


          return $chan;




sub check_ssh2_error {


          #-- be careful here, we are not returning an error code,

          # but 'true' if operation was successful

          my $ssh2 = shift or die;


          return 1 unless $ssh2->error;


          my @errs = $ssh2->error;

          cluck("Errors from Net::SSH2: @errs") if @errs;


          return undef;




#-- this function allows automatic getters and setters

# based on what is in the %fields at the beginning of the module



          my $self = shift;

          my $type = ref($self)

           or confess "$self is not an object";

          my $name = $AUTOLOAD;


          $name =~ s/.*://;    # strip fully-qualified portion


          my $field = $name;

          $field =~ s/^(set_|get_)//;


          unless ( exists $self->{_permitted}->{$field} ) {

                      confess "Can't access `$name' for field '$field'
in class $type";



          if ( $name =~ /^set_/ ) {

                      if (@_) {

                                  return $self->{$field} = shift;

                      } else {

                                  return $self->{$field} = "";



          } elsif ( $name =~ /^get_/ ) {

                      return $self->{$field};








Sean Blanton, Ph.D.

Connect: http://www.linkedin.com/in/seanblanton

On Fri, Nov 6, 2009 at 4:33 PM, Young, Darren
<Darren.Young at chicagobooth.edu> wrote:

> That module has a lot of known issues. I couldn't get it to work
> consistently (win <-> Solaris). See perlmonks.org. I abandoned it for
> Net::SSH2, and that only worked in limited ways.

Yea, I found all sorts of similar postings there.

> I can send you my wrapper utils, but right now am on the train

Sure, if it works I'd love to take a look.

Chicago-talk mailing list
Chicago-talk at pm.org


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.pm.org/pipermail/chicago-talk/attachments/20091109/097e8665/attachment-0001.html>

More information about the Chicago-talk mailing list