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