File Coverage

blib/lib/Net/SSH/Mechanize.pm
Criterion Covered Total %
statement 28 34 82.3
branch 0 2 0.0
condition n/a
subroutine 8 9 88.8
pod n/a
total 36 45 80.0


line stmt bran cond sub pod time code
1             package Net::SSH::Mechanize;
2             #use AnyEvent::Log;
3             #use Coro;
4 5     5   121393 use Moose;
  5         2138662  
  5         36  
5 5     5   37950 use AnyEvent;
  5         19937  
  5         153  
6 5     5   1936 use Net::SSH::Mechanize::ConnectParams;
  5         23  
  5         268  
7 5     5   3071 use Net::SSH::Mechanize::Session;
  5         20  
  5         193  
8 5     5   2900 use AnyEvent::Subprocess;
  5         5397628  
  5         225  
9             #use Scalar::Util qw(refaddr);
10 5     5   44 use Carp qw(croak);
  5         10  
  5         2727  
11             our @CARP_NOT = qw(AnyEvent AnyEvent::Subprocess Coro::AnyEvent);
12              
13             # Stop our carp errors from being reported within AnyEvent::Coro
14             @Coro::AnyEvent::CARP_NOT = qw(AnyEvent::CondVar);
15              
16             our $VERSION = '0.1.2'; # VERSION
17              
18             #$AnyEvent::Log::FILTER->level("fatal");
19              
20              
21             my @connection_params = qw(host user port password);
22              
23             # An object which defines a connection.
24             has 'connection_params' => (
25             isa => 'Net::SSH::Mechanize::ConnectParams',
26             is => 'ro',
27             handles => \@connection_params,
28             );
29              
30              
31             has 'session' => (
32             isa => 'Net::SSH::Mechanize::Session',
33             is => 'ro',
34             lazy => 1,
35             default => sub {
36             shift->_create_session;
37             },
38             handles => [qw(login login_async capture capture_async sudo_capture sudo_capture_async logout)],
39             );
40              
41             # The log-in timeout limit in seconds
42             has 'login_timeout' => (
43             is => 'rw',
44             isa => 'Int',
45             default => 30,
46             );
47              
48              
49             # This wrapper exists to map @connection_params into a
50             # Net::SSH::Mechanize::ConnectParams instance, if one is not supplied
51             # explicitly.
52             around 'BUILDARGS' => sub {
53             my $orig = shift;
54             my $self = shift;
55              
56             my $params = $self->$orig(@_);
57              
58             # check for connection_params paramter
59             my $cp;
60             if (exists $params->{connection_params}) {
61             # Prevent duplication of parameters - if we have a connection_params
62             # parameter, forbid the shortcut alternatives.
63             foreach my $param (@connection_params) {
64             croak "Cannot specify both $param and connection_params parameters"
65             if exists $params->{$param};
66             }
67              
68             $cp = $params->{connection_params};
69             $cp = Net::SSH::Mechanize::ConnectParams->new($cp)
70             if ref $cp eq 'HASH';
71             }
72             else {
73             # Splice the short-cut @connection_params out of %$params and into %cp_params
74             my %cp_params;
75             foreach my $param (@connection_params) {
76             next unless exists $params->{$param};
77             $cp_params{$param} = delete $params->{$param};
78             }
79              
80             # Try and construct a ConnectParams instance
81             $cp = Net::SSH::Mechanize::ConnectParams->new(%cp_params);
82             }
83              
84             return {
85             %$params,
86             connection_params => $cp,
87             };
88             };
89              
90              
91             ######################################################################
92             # public methods
93              
94              
95              
96             sub _create_session {
97 4     4   12 my $self = shift;
98              
99             # We do this funny stuff with $session and $job so that the on_completion
100             # callback can tell the session it should clean up
101 4         10 my $session;
102             my $job = AnyEvent::Subprocess->new(
103             run_class => 'Net::SSH::Mechanize::Session',
104             delegates => [
105             'Pty',
106             'CompletionCondvar',
107             [Handle => {
108             name => 'stderr',
109             direction => 'r',
110             replace => \*STDERR,
111             }],
112             ],
113             on_completion => sub {
114 0     0   0 my $done = shift;
115            
116             # printf "xx completing child PID %d _error_event %s is %s \n",
117             # $session->child_pid, $session->_error_event, $session->_error_event->ready? "ready":"unready"; #DB
118 0         0 my $stderr = $done->delegate('stderr');
119 0         0 my $errtext = $stderr->rbuf;
120 0 0       0 my $msg = sprintf "child PID %d terminated unexpectedly with exit value %d",
121             $session->child_pid, $done->exit_value, $errtext? "\n$errtext" : '';
122 0         0 $session->_error_event->send($msg);
123 0         0 undef $session;
124             },
125             code => sub {
126 2     2   11634 my $cmd = shift->{cmd};
127 2         0 exec @$cmd;
128             },
129 4         158 );
130 4         317148 $session = $job->run({cmd => [$self->connection_params->ssh_cmd]});
131            
132             # Tack this on afterwards, mainly to supply the password. We
133             # can't add it to the constructor above because of the design of
134             # AnyEvent::Subprocess.
135 2         5600 $session->connection_params($self->connection_params);
136              
137             # And set the login_timeout
138 2         79 $session->login_timeout($self->login_timeout);
139              
140             # turn off terminal echo
141 2         52 $session->delegate('pty')->handle->fh->set_raw;
142              
143             # Rebless $session into a subclass of AnyEvent::Subprocess::Running
144             # which just supplies extra methods we need.
145             # bless $session, 'Net::SSH::Mechanize::Session';
146              
147 2         3285 return $session;
148             }
149              
150              
151              
152             __PACKAGE__->meta->make_immutable;
153             1;
154              
155             __END__
156              
157             =head1 NAME
158              
159             Net::SSH::Mechanize - asynchronous ssh command invocation
160              
161             =head1 VERSION
162              
163             version 0.1.2
164              
165             =head1 SYNOPSIS
166              
167             Somewhat like C<POE::Component::OpenSSH>, C<SSH::Batch>,
168             C<Net::OpenSSH::Parallel>, C<App::MrShell> etc, but:
169              
170             =over 4
171              
172             =item *
173              
174             It uses the asynchonous C<AnyEvent> event framework.
175              
176             =item *
177              
178             It aims to support sudoing smoothly.
179              
180             =back
181              
182             Synchronous usage:
183              
184             use Net::SSH::Mechanize;
185              
186             # Create an instance. This will not log in yet.
187             # All but the host name below are optional.
188             # Your .ssh/config will be used as normal, so if you
189             # define ssh settings for a host there they will be picked up.
190             my $ssh = Net::SSH::Mechanize->new(
191             host => 'somewhere.com',
192             user => 'jbloggs',
193             password => 'secret',
194             port => 22,
195             );
196              
197             my $ssh->login;
198              
199             my $output = $ssh->capture("id");
200              
201             # If successful, $output now contains something like:
202             # uid=1000(jbloggs) gid=1000(jbloggs) groups=1000(jbloggs)
203              
204             $output = $ssh->sudo_capture("id");
205              
206             # If successful, $output now contains something like:
207             # uid=0(root) gid=0(root) groups=0(root)
208              
209             $ssh->logout;
210              
211             As you can see, C<Net::SSH::Mechanize> instance connects to only
212             I<one> host. L<Net::SSH::Mechanize::Multi|Net::SSH::Mechanize::Multi>
213             manages connections to many.
214              
215             See below for further examples, and C<script/gofer> in the
216             distribution source for a working, usable example.
217              
218             This is work in progress. Expect rough edges. Feedback appreciated.
219              
220            
221             =head1 DESCRIPTION
222              
223             The point about using C<AnyEvent> internally is that "blocking" method
224             calls only block the current "thread", and so the above can be used in
225             parallel with (for example) other ssh sessions in the same process
226             (using C<AnyEvent>, or C<Coro>). Although a sub-process is spawned for
227             each ssh command, the parent process manages the child processes
228             asynchronously, without blocking or polling.
229              
230             Here is an example of asynchronous usage, using the
231             C<<AnyEvent->condvar>> API. Calls return an C<<AnyEvent::CondVar>>
232             instance, which you can call the usual C<< ->recv >> and C<< ->cb >>
233             methods on to perform a blocking wait (within the current thread), or
234             assign a callback to be called on completion (respectively). See
235             L<AnyEvent>.
236              
237             This is effectively what the example in the synopsis is doing, behind
238             the scenes.
239              
240             use Net::SSH::Mechanize;
241              
242             # Create an instance, as above.
243             my $ssh = Net::SSH::Mechanize->new(
244             host => 'somewhere.com',
245             user => 'jbloggs',
246             password => 'secret',
247             port => 22,
248             );
249              
250             # Accessing ->capture calls ->login automatically.
251             my $condvar = AnyEvent->condvar;
252             $ssh->login_async->cb(sub {
253             my ($session) = shift->recv;
254             $session->capture_async("id")->cb(sub {
255             my ($stderr_handle, $result) = shift->recv;
256              
257             $condvar->send($result);
258             });
259             });
260              
261             # ... this returns immediately. The callbacks assigned will get
262             # invoked behind the scenes, and we just need to wait and collect
263             # the result handed to our $condvar.
264              
265             my $result = $convar->recv;
266              
267             # If successful, $output now contains something like:
268             # uid=1000(jbloggs) gid=1000(jbloggs) groups=1000(jbloggs)
269              
270             $ssh->logout;
271              
272             You would only need to use this asynchronous style if you wanted to
273             interface with C<AnyEvent>, and/or add some C<Expect>-like interaction
274             into the code.
275              
276             However, see also C<Net::SSH::Mechanize::Multi> for a more convenient
277             way of running multiple ssh sessions in parallel. It uses Coro to
278             provide a (cooperatively) threaded model.
279              
280             =head2 gofer
281              
282             The C<script/> sub-directory includes a command-line tool called
283             C<gofer> which is designed to accept a list of connection definitions,
284             and execute shell commands supplied in the arguments in parallel on
285             each. See the documentation in the script for more information.
286              
287              
288             =head1 JUSTIFICATION
289              
290             The problem with all other SSH wrappers I've tried so far is that they
291             do not cope well when you need to sudo. Some of them do it but
292             unreliably (C<SSH::Batch>), others allow it with some help, but then
293             don't assist with parallel connections to many servers (C<Net::OpenSSH>).
294             The I tried C<POE::Component::OpenSSH>, but I found the
295             C<POE::Component::Generic> implementation forced a painful programming
296             style with long chains of functions, one for each step in an exchange
297             with the ssh process.
298              
299             Possibly I just didn't try them all, or hard enough, but I really
300             needed something which could do the job, and fell back to re-inventing
301             the wheel. Initial experiments with C<AnyEvent> and C<AnyEvent::Subprocess>
302             showed a lot of promise, and the result is this.
303              
304             =head1 CLASS METHODS
305              
306             =head2 C<< $obj = $class->new(%params) >>
307              
308             Creates a new instance. Parameters is a hash or a list of key-value
309             parameters. Valid parameter keys are:
310              
311             =over 4
312              
313             =item C<connection_params>
314              
315             A L<Net::SSH::Mechanize::ConnectParams> instance, which defines a host
316             connection. If this is given, any individual connection parameters
317             also supplied to the constructor (C<host>, C<user>, C<port> or
318             C<password>), will be ignored.
319              
320             If this is absent, a C<Net::SSH::Mechanize::ConnectParams> instance is
321             constructed from any other individual connection parameters - the
322             minimum which must be supplied is C<hostname>. See below.
323              
324             =item C<host>
325              
326             The hostname to connect to. Either this or C<connection_params> must
327             be supplied.
328              
329             =item C<user>
330              
331             The user account to log into. If not given, no user will be supplied
332             to C<ssh> (this typically means it will use the current user as
333             default).
334              
335             =item C<port>
336              
337             The port to connect to (C<ssh> will default to 22 if this is not
338             specificed).
339              
340             =item C<password>
341              
342             The password to connect with. This is only required if authentication
343             will be performed, either on log-in or when sudoing.
344              
345             =item C<login_timeout>
346              
347             How long to wait before breaking a connection (in seconds). It is
348             passed to C<AnyEvent->timer> handler, whose callback will terminate
349             the session if the period is exceeded. This avoids hung connections
350             when the remote end isn't answering, or isn't answering in a way that
351             will allow C<Net::SSH::Mechanize> to terminate.
352              
353             The default is 30.
354              
355             =back
356              
357              
358             =head1 INSTANCE ATTRIBUTES
359              
360             =head2 C<< $params = $obj->connection_params >>
361              
362             This is a read-only accessor for the C<connection_params> instance
363             passed to the constructor (or equivalently, constructed from the
364             constructor parameters).
365              
366             =head2 C<< $session = $obj->session >>
367              
368             This is read-only accessor to a lazily-instantiated
369             C<Net::SSH::Mechanize::Session> instance, which represents the C<ssh>
370             process. Accessing it causes the session to be created and the remote
371             host to be logged into.
372              
373             =head2 C<< $obj->login_timeout($integer) >>
374             =head2 C<< $integer = $obj->login_timeout >>
375              
376             This is a read-write accessor to the log-in timeout parameter passed
377             to the constructor.
378              
379             It is passed to C<Net::SSH::Mechanize::Session>'s constructor, so if
380             you plan to modify it, do so before C<< ->session >> has been
381             instantiated or will not have any effect on anything thereafter.
382              
383             =head1 INSTANCE METHODS
384              
385             =head2 C<login>
386             =head2 C<login_async>
387             =head2 C<capture>
388             =head2 C<capture_async>
389             =head2 C<sudo_capture>
390             =head2 C<sudo_capture_async>
391             =head2 C<logout>
392              
393             These methods exist here for convenience; they delegate to the
394             equivalent C<Net::SSH::Mechanize::Session> methods.
395              
396             =head1 SEE ALSO
397              
398             There are a lot of related tools, and this is just in Perl. Probably
399             the most similar are C<SSH::Batch>, C<POE::Component::OpenSSH>, and
400             C<App::MrShell> (which at the time of writing, I've not yet tried.) None
401             use C<AnyEvent>, so far as I can tell.
402              
403             L<SSH::Batch>, L<Net::OpenSSH>, L<Net::OpenSSH::Parallel>, L<Net::SSH>, L<Net::SSH2>,L<
404             Net::SSH::Expect>, L<Net::SSH::Perl>, L<POE::Component::OpenSSH>, L<App::MrShell>.
405              
406             =head1 AUTHOR
407              
408             Nick Stokoe C<< <wulee@cpan.org> >>
409              
410              
411             =head1 LICENCE AND COPYRIGHT
412              
413             Copyright (c) 2011, Nick Stokoe C<< <wulee@cpan.org> >>. All rights reserved.
414              
415             This module is free software; you can redistribute it and/or
416             modify it under the same terms as Perl itself. See L<perlartistic>.
417              
418              
419             =head1 DISCLAIMER OF WARRANTY
420              
421             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
422             FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
423             OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
424             PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
425             EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
426             WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
427             ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
428             YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
429             NECESSARY SERVICING, REPAIR, OR CORRECTION.
430              
431             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
432             WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
433             REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE
434             LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
435             OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
436             THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
437             RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
438             FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
439             SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
440             SUCH DAMAGES.