[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
operations.

* 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
operations.

 

=head1 SYNOPSIS

 

 #-- Import module

 use XXX::DeploySSH;

 

 #-- Set connection parameters

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

 $ds->set_user($user);

 $ds->set_hostname($hostname);

 

 #-- 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";

 

=head1 DESCRIPTION

 

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.

 

=head1 OBJECT METHODS

 

=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
connect().

 

=item $ds->set_hostname($hostname)

 

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

 

=back

 

=head2 Operators

 

=over 4

 

=item $ds->exec($remote_cmd)

 

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

 

 ($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
indicate

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.

 

=back

 

=head2 Other

 

=over 4

 

=item $ds->disconnect()

 

Terminates the connection.

 

=back

 

=head1 REQUIRED MODULES

 

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.

 

=back

 

=head1 BUGS AND CAVEATS

 

=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.

 

=back

 

=head1 TODO'S

 

=over 4

 

=item * Have constructor accept user and hostname arguments.

 

=back

 

=head1 AUTHOR

 

Sean Blanton of OpenMake Software for XXX

 

=head1 SEE ALSO

 

 Net::SSH2, XXX::DeployProperties

 

=cut

 

 

 

BEGIN {

          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
logon

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,

                      %fields,

          };

 

          bless( $self, $class );

 

          $self->set_private_key($private_key);

          $self->set_public_key($public_key);

          $self->set_private_key_password($password);

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

          $self->set_ssh2_handle($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
confess('');

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

 

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

 

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

 

          unless ( $ssh2->auth_ok ) {

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

                      $ssh2->disconnect;

                      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() ) {

                      $ssh2->disconnect;

          }

 

          $self->set_ssh2_handle(undef);

          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);

          $chan->exec("$cmd\n");

          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->blocking(1);

          $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();

          check_ssh2_error($ssh2);

 

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

          check_ssh2_error($ssh2);

 

          $ssh2->blocking(0);

 

          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->blocking(1);

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

          $ssh2->blocking(0);

          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();

 

          $ssh2->blocking(1);

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

          $ssh2->blocking(0);

          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

 

sub AUTOLOAD {

          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};

          }

}

 

1;

 

 

Regards,
Sean

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
http://mail.pm.org/mailman/listinfo/chicago-talk

 

-------------- 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