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

Sean Blanton sean at blanton.com
Mon Nov 9 07:43:08 PST 2009


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/83c262ff/attachment-0001.html>


More information about the Chicago-talk mailing list