<div>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.</div><div><br></div>* I couldn't get the 'shell' to work, so only used exec, put and get operations.<div>
* The key is to manage the blocking around grabbing a channel and executing the different ops.<br><div>* 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).<div>
* The put operation did not update the timestamp of the remote file - there is a hack to update it.</div><div>* The Solaris box I was connecting to was running the KeON security application - I doubt that had an effect, but who knows?</div>
<div><br></div><div><div>------------------------------------------------------------------------</div><div>package XXX::DeploySSH;</div><div><br></div><div><br></div><div>=head1 NAME</div><div><br></div><div>XXX::DeploySSH - Use SSH from within Perl for build and deploy operations.</div>
<div><br></div><div>=head1 SYNOPSIS</div><div><br></div><div> #-- Import module</div><div> use XXX::DeploySSH;</div><div><br></div><div> #-- Set connection parameters</div><div> my $ds = XXX::DeploySSH->new() or die;</div>
<div> $ds->set_user($user);</div><div> $ds->set_hostname($hostname);</div><div><br></div><div> #-- Initiate connection including authentication</div><div> $ds->connect() or die "Couldn't connect to $hostname";</div>
<div><br></div><div> #-- Execute a command. Non-zero return code is bad</div><div> my ($rc, @output) = $ds->exec("ls -la");</div><div><br></div><div> print "Output:\n@output\n";</div><div> print "Remote command executed successfully.\n" unless $rc;</div>
<div> print "ERROR: Remote command failed.\n" if $rc;</div><div><br></div><div> #-- Transfer a file. Note opposite sense of return code. 1 is good now.</div><div> my $rc = $ds->put( $full_target, "$stage_dir/$target_file" )</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>or die "SFTP put of '$full_target' to '$stage_dir/$target_file' failed";</div><div><br></div><div>=head1 DESCRIPTION</div><div><br>
</div><div>Uses the SSH2 protocol to create session, execute commands or transfer files from iwthin Perl.</div><div>Each command is issued on its own "channel'. The execution method is by C<exec>, so you can only</div>
<div>run programs with arguments, not shell commands.</div><div><br></div><div>The connection method is via publickey authentication. The public and private key names as well as</div><div>the password for encrypting the private key are all hardcoded in the module itself. Sure there is a</div>
<div>better way, but that is the current state.</div><div><br></div><div>=head1 OBJECT METHODS</div><div><br></div><div>=head2 Constructor</div><div><br></div><div>The constructor is called with no arguments.</div><div><br>
</div><div> my $ds = XXX::DeploySSH->new();</div><div><br></div><div>=head2 Accessors</div><div><br></div><div>=over 4</div><div><br></div><div>=item $ds->set_user($user)</div><div><br></div><div>The user authenticating via SSH2. Must set the user before calling connect().</div>
<div><br></div><div>=item $ds->set_hostname($hostname)</div><div><br></div><div>The hostname that you want to connect to. Must set the hostname before calling connect().</div><div><br></div><div>=back</div><div><br></div>
<div>=head2 Operators</div><div><br></div><div>=over 4</div><div><br></div><div>=item $ds->exec($remote_cmd)</div><div><br></div><div>Executes C<$remote_cmd> on the machine you are connected to. This method returns</div>
<div><br></div><div> ($rc,@output)</div><div><br></div><div>Where C<$rc> is the return code and C<@output> is any output. Note that the return</div><div>value of this method is different from put() and get() because they only indicate</div>
<div>success/fail, whereas exec() needs to return the return code of the program execution</div><div>and output.</div><div><br></div><div>=item $ds->put($local_file,$remote_file)</div><div><br></div><div>Transfers C<$local_file> to C<$remote_file> on the connected machine.</div>
<div><br></div><div>=item $ds->get($remote_file,$local_file)</div><div><br></div><div>Retrieves C<$local_file> from C<$remote_file> on the connected machine.</div><div><br></div><div>=back</div><div><br></div>
<div>=head2 Other</div><div><br></div><div>=over 4</div><div><br></div><div>=item $ds->disconnect()</div><div><br></div><div>Terminates the connection.</div><div><br></div><div>=back</div><div><br></div><div>=head1 REQUIRED MODULES</div>
<div><br></div><div>Install required modules on Windows using the C<< ppm install <module> >> command.</div><div><br></div><div>=over 4</div><div><br></div><div>=item * Net::SSH2 - Base methods handling the SSH2 protocol.</div>
<div><br></div><div>=item * Carp - For error handling.</div><div><br></div><div>=back</div><div><br></div><div>=head1 BUGS AND CAVEATS</div><div><br></div><div>=over 4</div><div><br></div><div>=item * Occasional flakiness occurs where a command returns an error for no apparent reason. If this </div>
<div>happens, re-execute the workflow.</div><div><br></div><div>=item * Output is not being returned by exec() in some cases.</div><div><br></div><div>=back</div><div><br></div><div>=head1 TODO'S</div><div><br></div>
<div>
=over 4</div><div><br></div><div>=item * Have constructor accept user and hostname arguments.</div><div><br></div><div>=back</div><div><br></div><div>=head1 AUTHOR</div><div><br></div><div>Sean Blanton of OpenMake Software for XXX</div>
<div><br></div><div>=head1 SEE ALSO</div><div><br></div><div> Net::SSH2, XXX::DeployProperties</div><div><br></div><div>=cut</div><div><br></div><div><br></div><div><br></div><div>BEGIN {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>use Exporter ();</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>use vars qw(@ISA @EXPORT $VERSION);</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>@ISA = qw(Exporter);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>@EXPORT = qw(</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>);</div><div><br></div><div>}</div><div><br></div><div>
use Net::SSH2;</div><div>use Carp qw{confess cluck};</div><div>use strict;</div><div><br></div><div>our $AUTOLOAD; # it's a package global</div><div><br></div><div>our %fields = (</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>hostname => undef,</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>user => undef,</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>private_key => undef,</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>public_key => undef,</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>private_key_password => undef,</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>ssh2_handle => undef,</div><div>);</div>
<div><br></div><div>our $home_dir = $^O =~ /win/i ? $ENV{USERPROFILE} . "/.ssh" : $ENV{HOME} . "/.ssh";</div><div><br></div><div>#TODO: The password should be found by lookup instead of hardcoded here</div>
<div>our $password =</div><div> 'XYXYXYX'; #-- password that encrypts the private key, not the logon</div><div>our $private_key = "$home_dir/ccbuilder";</div><div>our $public_key = "$home_dir/ccbuilder.pub";</div>
<div><br></div><div>die "Private key file '$private_key' does not exist as a file."</div><div> unless -f $private_key;</div><div>die "Public key file '$public_key' does not exist as a file."</div>
<div> unless -f $public_key;</div><div><br></div><div>sub new {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $proto = shift;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $class = ref($proto) || $proto;</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>_permitted => \%fields,</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>%fields,</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>};</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>bless( $self, $class );</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$self->set_private_key($private_key);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>$self->set_public_key($public_key);</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$self->set_private_key_password($password);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = Net::SSH2->new() or confess("couldn't create ssh2 handle");</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$self->set_ssh2_handle($ssh2);</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return $self;</div><div>}</div><div><br></div><div>sub connect {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = shift</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span> or confess "FATAL: Wrong args!";</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $hostname = $self->get_hostname() or confess('');</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $user = $self->get_user() or confess('');</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $private_key = $self->get_private_key() or confess('');</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $public_key = $self->get_public_key() or confess('');</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $password = $self->get_private_key_password() or confess('');</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = $self->get_ssh2_handle() or confess('');</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->connect($hostname) or die "ERROR: Couldn't connect to $hostname.";</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->auth_publickey( $user, $public_key, $private_key, $password );</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>unless ( $ssh2->auth_ok ) {</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my ( $rc, $err_msg ) = $ssh2->error;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->disconnect;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>cluck("ERROR: can't log in: $rc : $err_msg");</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>return undef;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>}</div><div><br></div><div>}</div><div><br></div><div>sub disconnect {</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = shift</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> or confess "FATAL: Wrong args!";</div><div><br></div><div>
<span class="Apple-tab-span" style="white-space:pre"> </span>if ( my $ssh2 = $self->get_ssh2_handle() ) {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->disconnect;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>}</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$self->set_ssh2_handle(undef);</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return 1;</div><div>}</div><div><br>
</div><div>sub exec {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = shift or die;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $cmd = shift or die;</div><div>
<br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = $self->get_ssh2_handle() or confess();</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $chan = _get_channel($ssh2);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>$chan->exec("$cmd\n");</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my @output = <$chan>;</div><div><br></div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $rc = $chan->exit_status;</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>cluck("ERROR: $rc\n@output\n") if $rc;</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$chan->close; #-- channel is useless after exec</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return $rc, @output;</div>
<div><br></div><div>}</div><div><br></div><div>sub put {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = shift or die;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $local_file = shift or die;</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $remote_file = shift or die;</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = $self->get_ssh2_handle() or confess();</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->blocking(1);</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->scp_put( "$local_file", "$remote_file" );</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>#-- Note bug from scp_put puts wrong mtime. Put it right.</div><div><span class="Apple-tab-span" style="white-space:pre"> </span># take care to actually transfer the file.</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $sftp = $ssh2->sftp();</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>check_ssh2_error($ssh2);</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$sftp->setstat( "$remote_file", 'mtime', time() );</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>check_ssh2_error($ssh2);</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->blocking(0);</div><div><br></div>
<div>
<span class="Apple-tab-span" style="white-space:pre"> </span>return check_ssh2_error($ssh2);</div><div><br></div><div>}</div><div><br></div><div>sub get {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = shift or die;</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $remote_file = shift or die;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $local_file = shift or die;</div><div><br></div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = $self->get_ssh2_handle() or confess();</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->blocking(1);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->scp_get( "$remote_file", "$local_file" );</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->blocking(0);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>return check_ssh2_error($ssh2);</div><div><br></div><div>}</div><div><br></div><div>#-- Get a(nother) channel for this logon session</div><div># NOTE: Class function, not an object method</div>
<div>sub _get_channel {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = shift or confess();</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->blocking(1);</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $chan = $ssh2->channel();</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$ssh2->blocking(0);</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return $chan;</div>
<div><br></div><div>}</div><div><br></div><div>sub check_ssh2_error {</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>#-- be careful here, we are not returning an error code,</div><div>
<span class="Apple-tab-span" style="white-space:pre"> </span># but 'true' if operation was successful</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $ssh2 = shift or die;</div><div><br>
</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>return 1 unless $ssh2->error;</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my @errs = $ssh2->error;</div><div>
<span class="Apple-tab-span" style="white-space:pre"> </span>cluck("Errors from Net::SSH2: @errs") if @errs;</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return undef;</div>
<div><br></div><div>}</div><div><br></div><div>#-- this function allows automatic getters and setters</div><div># based on what is in the %fields at the beginning of the module</div><div><br></div><div>sub AUTOLOAD {</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $self = shift;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $type = ref($self)</div><div><span class="Apple-tab-span" style="white-space:pre"> </span> or confess "$self is not an object";</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>my $name = $AUTOLOAD;</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$name =~ s/.*://; # strip fully-qualified portion</div>
<div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>my $field = $name;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>$field =~ s/^(set_|get_)//;</div><div><br></div><div>
<span class="Apple-tab-span" style="white-space:pre"> </span>unless ( exists $self->{_permitted}->{$field} ) {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>confess "Can't access `$name' for field '$field' in class $type";</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>}</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>if ( $name =~ /^set_/ ) {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>if (@_) {</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>return $self->{$field} = shift;</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>} else {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return $self->{$field} = "";</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>}</div><div><br></div><div><span class="Apple-tab-span" style="white-space:pre"> </span>} elsif ( $name =~ /^get_/ ) {</div><div><span class="Apple-tab-span" style="white-space:pre"> </span>return $self->{$field};</div>
<div><span class="Apple-tab-span" style="white-space:pre"> </span>}</div><div>}</div><div><br></div><div>1;</div><div><br></div></div><div><div><br></div>Regards,<br>Sean<br><br>Sean Blanton, Ph.D.<br><br>Connect: <a href="http://www.linkedin.com/in/seanblanton">http://www.linkedin.com/in/seanblanton</a><br>
<br>
<br><br><div class="gmail_quote">On Fri, Nov 6, 2009 at 4:33 PM, Young, Darren <span dir="ltr"><<a href="mailto:Darren.Young@chicagobooth.edu">Darren.Young@chicagobooth.edu</a>></span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
<div class="im">> That module has a lot of known issues. I couldn't get it to work<br>
> consistently (win <-> Solaris). See <a href="http://perlmonks.org" target="_blank">perlmonks.org</a>. I abandoned it for<br>
> Net::SSH2, and that only worked in limited ways.<br>
<br>
</div>Yea, I found all sorts of similar postings there.<br>
<div class="im"><br>
> I can send you my wrapper utils, but right now am on the train<br>
<br>
</div>Sure, if it works I'd love to take a look.<br>
<div><div></div><div class="h5"><br>
_______________________________________________<br>
Chicago-talk mailing list<br>
<a href="mailto:Chicago-talk@pm.org">Chicago-talk@pm.org</a><br>
<a href="http://mail.pm.org/mailman/listinfo/chicago-talk" target="_blank">http://mail.pm.org/mailman/listinfo/chicago-talk</a><br>
</div></div></blockquote></div><br></div></div></div>