| 1 |
package Shell::SSH; |
| 2 |
use strict; |
| 3 |
use warnings; |
| 4 |
use base qw( Shell ); |
| 5 |
our($VERSION, $AUTOLOAD); |
| 6 |
|
| 7 |
$VERSION = '0.01'; |
| 8 |
|
| 9 |
# this is just needed for checking $VERSION of Shell.pm which we inherit from |
| 10 |
# alternative: don't "use warnings;" else this modules throws "Subroutine AUTOLOAD redefined at Shell/SSH.pm line ..." |
| 11 |
# we try to imitate "use base qw( Shell 0.4 );" which of course will never work since it "arrays" all values inside qw() |
| 12 |
# but it also calls 'require' under the hood - rendering a "use base ('Shell 0.4');" useless, too, hmmm..... |
| 13 |
# question: can this already be done in a more formal way? |
| 14 |
BEGIN { my $requires = 0.4; die "Shell version $requires required--this is only version $Shell::VERSION" if ($Shell::VERSION lt $requires); } |
| 15 |
|
| 16 |
use Data::Dumper; |
| 17 |
use IPC::Run qw( start pump finish timeout ); |
| 18 |
|
| 19 |
# debugging for IPC::Run |
| 20 |
# $ENV{IPCRUNDEBUG} = 2; |
| 21 |
|
| 22 |
local *IN; |
| 23 |
local *OUT; |
| 24 |
local *ERR; |
| 25 |
|
| 26 |
$Shell::hasHandler = 1; |
| 27 |
|
| 28 |
sub new { |
| 29 |
my $class = shift; |
| 30 |
my $self = { @_ }; |
| 31 |
bless $self, $class; |
| 32 |
$self->_init(); |
| 33 |
$self->_start(); |
| 34 |
return $self; |
| 35 |
} |
| 36 |
|
| 37 |
sub DESTROY { } |
| 38 |
|
| 39 |
sub AUTOLOAD { |
| 40 |
my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' ); |
| 41 |
my $cmd = $AUTOLOAD; |
| 42 |
$cmd =~ s/^.*:://; |
| 43 |
#print Dumper(@_); |
| 44 |
#exit; |
| 45 |
if ($self) { |
| 46 |
# TODO: handle asynchronizity(?) here! |
| 47 |
return $self->_run_command($cmd, @_); |
| 48 |
} |
| 49 |
} |
| 50 |
|
| 51 |
sub _init { |
| 52 |
my $self = shift; |
| 53 |
$self->{method} ||= 'ssh'; |
| 54 |
} |
| 55 |
|
| 56 |
|
| 57 |
sub _start { |
| 58 |
my $self = shift; |
| 59 |
|
| 60 |
my @cmd = (); |
| 61 |
die "please supply method" if (!$self->{method}); |
| 62 |
die "please supply target" if (!$self->{target}); |
| 63 |
|
| 64 |
push @cmd, $self->{method}; |
| 65 |
push @cmd, @{$self->{args}} if ($self->{args}); |
| 66 |
push @cmd, $self->{target} if ($self->{target}); |
| 67 |
|
| 68 |
my $cmd = join(" ", @cmd); |
| 69 |
#print "command: ", $cmd, "\n"; |
| 70 |
|
| 71 |
$self->{handle} = start |
| 72 |
\@cmd, |
| 73 |
'<pipe', \*IN, |
| 74 |
'>pipe', \*OUT, |
| 75 |
'2>pipe', \*ERR, |
| 76 |
timeout( 5 ) |
| 77 |
or die "could not open IPC::Run - handle: $?" ; |
| 78 |
|
| 79 |
} |
| 80 |
|
| 81 |
sub _stop { |
| 82 |
my $self = shift; |
| 83 |
finish $self->{handle}; |
| 84 |
} |
| 85 |
|
| 86 |
sub _run_command { |
| 87 |
my $self = shift; |
| 88 |
my $rcommand = shift; |
| 89 |
my $rargs = join(' ', @_); |
| 90 |
$rargs ||= ''; |
| 91 |
my $rcommandstring = join(' ', $rcommand, $rargs); |
| 92 |
#open IN, ''; |
| 93 |
print IN $rcommandstring; |
| 94 |
close IN; |
| 95 |
$self->_read_output(); |
| 96 |
return ''; |
| 97 |
} |
| 98 |
|
| 99 |
sub _read_output { |
| 100 |
my $self = shift; |
| 101 |
$self->{buffer} = []; |
| 102 |
my $buffer = ''; |
| 103 |
#print "=read\n"; |
| 104 |
#print Dumper($self->{handle}); |
| 105 |
while (<OUT>) { |
| 106 |
#print "line: ", $_, "\n"; |
| 107 |
chomp(); |
| 108 |
push @{$self->{buffer}}, $_; |
| 109 |
$buffer .= $_ . "\n"; |
| 110 |
} |
| 111 |
#print "=read okay\n"; |
| 112 |
# TODO: async! |
| 113 |
#return $buffer; |
| 114 |
$self->{response}->($buffer); |
| 115 |
} |
| 116 |
|
| 117 |
sub get_output { |
| 118 |
my $self = shift; |
| 119 |
return $self->{buffer}; |
| 120 |
} |
| 121 |
|
| 122 |
sub disconnect { |
| 123 |
my $self = shift; |
| 124 |
$self->_stop(); |
| 125 |
} |
| 126 |
|
| 127 |
1; |
Parent Directory
| 
Revision Log
