sshwrap/Shell/SSH.pm

package Shell::SSH;
use strict;
use warnings;
#use base qw( Shell );
our($VERSION, $AUTOLOAD);

$VERSION = '0.01';

# this is just needed for checking $VERSION of Shell.pm which we inherit from
# alternative: don't "use warnings;" else this modules throws "Subroutine AUTOLOAD redefined at Shell/SSH.pm line ..."
# we try to imitate "use base qw( Shell 0.4 );" which of course will never work since it "arrays" all values inside qw()
# but it also calls 'require' under the hood - rendering a "use base ('Shell 0.4');" useless, too, hmmm.....
# question: can this already be done in a more formal way?
#BEGIN { my $requires = 0.4; die "Shell version $requires required--this is only version $Shell::VERSION" if ($Shell::VERSION lt $requires); }
BEGIN {
  sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
}

use Data::Dumper;
use IPC::Run qw( start pump finish timeout timer );
#use IPC::Run::Win32Helper;

# debugging for IPC::Run
#$ENV{IPCRUNDEBUG} = 10;
#$ENV{IPCRUNDEBUG} = 2;
$ENV{IPCRUNDEBUG} = 32;

local *IN;
local *OUT;
local *ERR;

my $in; my $out; my $err; my $handle;
my $t;

sub new {
  my $class = shift;
  my $self = { @_ };
  bless $self, $class;
  $self->_init();
  $self->_start();
  return $self;
}

sub DESTROY { }

sub AUTOLOAD {
  #my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
  #my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
  my $self = shift;
  my $cmd = $AUTOLOAD;
  $cmd =~ s/^.*:://;
  #if ($self) {
    # TODO: handle asynchronizity(?) here!
    return $self->_run_command($cmd, @_);
  #}
}

sub _init {
  my $self = shift;
  $self->{in}  = '';
  $self->{out} = '';
  $self->{err} = '';
  $in = $out = $err = '';
  $self->{method} ||= 'ssh';
}


sub _start {
  my $self = shift;

  my @cmd = ();
  die "please supply method" if (!$self->{method});
  die "please supply target" if (!$self->{target});
  
  push @cmd, $self->{method};
  push @cmd, @{$self->{args}} if ($self->{args});
  push @cmd, $self->{target} if ($self->{target});

  my $cmd = join(" ", @cmd);
  #print "command: ", $cmd, "\n";

#  $self->{handle} = start
#     \@cmd,
#        '<pipe', \*IN,
#        '>pipe', \*OUT,
#        '2>pipe', \*ERR,
#        timeout( 20 )
#     or die "could not open IPC::Run - handle: $?" ;
  #$self->{handle} = start \@cat, \$in, \$out
  #$self->{handle} = 

  #print "command: ", join(' ', @cmd), "\n";

  if (!RUNNING_IN_HELL) {
    #$t = timeout(15);
    $t = timer(10);
    $handle = 
       start(\@cmd, \$in, \$out, \$err, $t)
       or print "NO HANDLE: $?\n";
       #or die "could not open IPC::Run - handle: $?" ;
  } else {
    $handle = start
       \@cmd,
          '<pipe', \*IN,
          '>pipe', \*OUT,
          '2>pipe', \*ERR,
          timeout( 20 )
       or print "NO HANDLE: $?\n";
       #or die "could not open IPC::Run - handle: $?" ;

    # make filehandles hot
    IN->autoflush(1);
    OUT->autoflush(1);
    ERR->autoflush(1);
  }
  
  print "STARTUP FINISHED\n";
  #sleep 10;
  
}

sub _stop {
  my $self = shift;
  #finish $self->{handle};
  #finish $self->{handle};
  finish $handle;
}

sub _run_command {
  my $self = shift;
  my $rcommand = shift;
#print "rcmd: $rcommand\n";
  my $rargs = join(' ', @_);
  $rargs ||= '';
  my $rcommandstring = join(' ', $rcommand, $rargs);
  $rcommandstring =~ s/\s//g;
  #print "cmd: '", $rcommandstring, "'\n";
  #open IN, '';
  #$self->_read_output();
  #print IN $rcommandstring;
  #close IN;
  #pump $self->{handle};
  #$self->{in} = $rcommandstring;

  print "COMMAND SENT: $rcommandstring\n";

  if (!RUNNING_IN_HELL) {
    $in = $rcommandstring . "\n";
  } else {
    print IN $rcommandstring, "\n";
    #close IN;
  }
  #$in = $rcommandstring;
  #pump $self->{handle};
  #$out = '';
  #pump $handle while length $in;
  pump $handle;
  #pump $handle;

  #print "first pumping ready", "\n";

  #$self->_read_output();

  return '';
}

sub _read_output {
  #print "_read_output\n";
  my $self = shift;
  $self->{buffer} = [];
  my $buffer = '';
  #print "=read\n";

  #print Dumper($self->{handle});
  #while (<OUT>) {
  #pump $self->{handle};
  #sleep 1; pump $self->{handle};
  #sleep 1; pump $self->{handle};
  #pump $self->{handle};
  #pump $handle;

  #pump $handle while length $out;
  #pump $handle;
  #pump $handle;
  #pump $handle;
  #pump $handle until length $out;
  #$self->{response}->($out) if $out;
  #return;

#print Dumper($self->{handle});

  # the command-response-roundtrip should
  # take a smaller amount of time than the initial connection
  my $tcmd = timer(5);

  until ($tcmd->is_expired) {

    if (!RUNNING_IN_HELL) {
  
      pump $handle;
      #while (!$t->is_expired) {
      while ($out && !$tcmd->is_expired) {
        print ".\n";
        chomp($out);
        print "line: ", $out, "\n";
        $self->{response}($out) if $out;
        #push @{$self->{buffer}}, $_;
        $buffer .= $out . "\n";
        #pump $self->{handle};
        pump $handle;
      }
  
    } else {
  
      print "=========WIN32\n";
      
      #pump $handle;
      #until (my $line = <OUT> || $tcmd->is_expired) {
      my $line = <OUT>;
      chomp($line);
      print "line: ", $line, "\n";
      $buffer .= $out . "\n";
      #pump $self->{handle};
      pump $handle;
  
    }

  }

  print "=read okay\n";
  
  if ($tcmd->is_expired) {
    print "command expired", "\n";
  }
  
  # TODO: async!
  #return $buffer;
  $self->{response}->($buffer) if $buffer;
}

sub get_output {
  my $self = shift;
  return $self->{buffer};
}

sub disconnect {
  my $self = shift;
  $self->_stop();
}

1;
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	BEGIN {
16	sub RUNNING_IN_HELL () { $^O eq 'MSWin32' }
17	}
18
19	use Data::Dumper;
20	use IPC::Run qw( start pump finish timeout timer );
21	#use IPC::Run::Win32Helper;
22
23	# debugging for IPC::Run
24	#$ENV{IPCRUNDEBUG} = 10;
25	#$ENV{IPCRUNDEBUG} = 2;
26	$ENV{IPCRUNDEBUG} = 32;
27
28	local *IN;
29	local *OUT;
30	local *ERR;
31
32	my $in; my $out; my $err; my $handle;
33	my $t;
34
35	sub new {
36	my $class = shift;
37	my $self = { @_ };
38	bless $self, $class;
39	$self->_init();
40	$self->_start();
41	return $self;
42	}
43
44	sub DESTROY { }
45
46	sub AUTOLOAD {
47	#my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
48	#my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
49	my $self = shift;
50	my $cmd = $AUTOLOAD;
51	$cmd =~ s/^.*:://;
52	#if ($self) {
53	# TODO: handle asynchronizity(?) here!
54	return $self->_run_command($cmd, @_);
55	#}
56	}
57
58	sub _init {
59	my $self = shift;
60	$self->{in} = '';
61	$self->{out} = '';
62	$self->{err} = '';
63	$in = $out = $err = '';
64	$self->{method} \|\|= 'ssh';
65	}
66
67
68	sub _start {
69	my $self = shift;
70
71	my @cmd = ();
72	die "please supply method" if (!$self->{method});
73	die "please supply target" if (!$self->{target});
74
75	push @cmd, $self->{method};
76	push @cmd, @{$self->{args}} if ($self->{args});
77	push @cmd, $self->{target} if ($self->{target});
78
79	my $cmd = join(" ", @cmd);
80	#print "command: ", $cmd, "\n";
81
82	# $self->{handle} = start
83	# \@cmd,
84	# '<pipe', \*IN,
85	# '>pipe', \*OUT,
86	# '2>pipe', \*ERR,
87	# timeout( 20 )
88	# or die "could not open IPC::Run - handle: $?" ;
89	#$self->{handle} = start \@cat, \$in, \$out
90	#$self->{handle} =
91
92	#print "command: ", join(' ', @cmd), "\n";
93
94	if (!RUNNING_IN_HELL) {
95	#$t = timeout(15);
96	$t = timer(10);
97	$handle =
98	start(\@cmd, \$in, \$out, \$err, $t)
99	or print "NO HANDLE: $?\n";
100	#or die "could not open IPC::Run - handle: $?" ;
101	} else {
102	$handle = start
103	\@cmd,
104	'<pipe', \*IN,
105	'>pipe', \*OUT,
106	'2>pipe', \*ERR,
107	timeout( 20 )
108	or print "NO HANDLE: $?\n";
109	#or die "could not open IPC::Run - handle: $?" ;
110
111	# make filehandles hot
112	IN->autoflush(1);
113	OUT->autoflush(1);
114	ERR->autoflush(1);
115	}
116
117	print "STARTUP FINISHED\n";
118	#sleep 10;
119
120	}
121
122	sub _stop {
123	my $self = shift;
124	#finish $self->{handle};
125	#finish $self->{handle};
126	finish $handle;
127	}
128
129	sub _run_command {
130	my $self = shift;
131	my $rcommand = shift;
132	#print "rcmd: $rcommand\n";
133	my $rargs = join(' ', @_);
134	$rargs \|\|= '';
135	my $rcommandstring = join(' ', $rcommand, $rargs);
136	$rcommandstring =~ s/\s//g;
137	#print "cmd: '", $rcommandstring, "'\n";
138	#open IN, '';
139	#$self->_read_output();
140	#print IN $rcommandstring;
141	#close IN;
142	#pump $self->{handle};
143	#$self->{in} = $rcommandstring;
144
145	print "COMMAND SENT: $rcommandstring\n";
146
147	if (!RUNNING_IN_HELL) {
148	$in = $rcommandstring . "\n";
149	} else {
150	print IN $rcommandstring, "\n";
151	#close IN;
152	}
153	#$in = $rcommandstring;
154	#pump $self->{handle};
155	#$out = '';
156	#pump $handle while length $in;
157	pump $handle;
158	#pump $handle;
159
160	#print "first pumping ready", "\n";
161
162	#$self->_read_output();
163
164	return '';
165	}
166
167	sub _read_output {
168	#print "_read_output\n";
169	my $self = shift;
170	$self->{buffer} = [];
171	my $buffer = '';
172	#print "=read\n";
173
174	#print Dumper($self->{handle});
175	#while (<OUT>) {
176	#pump $self->{handle};
177	#sleep 1; pump $self->{handle};
178	#sleep 1; pump $self->{handle};
179	#pump $self->{handle};
180	#pump $handle;
181
182	#pump $handle while length $out;
183	#pump $handle;
184	#pump $handle;
185	#pump $handle;
186	#pump $handle until length $out;
187	#$self->{response}->($out) if $out;
188	#return;
189
190	#print Dumper($self->{handle});
191
192	# the command-response-roundtrip should
193	# take a smaller amount of time than the initial connection
194	my $tcmd = timer(5);
195
196	until ($tcmd->is_expired) {
197
198	if (!RUNNING_IN_HELL) {
199
200	pump $handle;
201	#while (!$t->is_expired) {
202	while ($out && !$tcmd->is_expired) {
203	print ".\n";
204	chomp($out);
205	print "line: ", $out, "\n";
206	$self->{response}($out) if $out;
207	#push @{$self->{buffer}}, $_;
208	$buffer .= $out . "\n";
209	#pump $self->{handle};
210	pump $handle;
211	}
212
213	} else {
214
215	print "=========WIN32\n";
216
217	#pump $handle;
218	#until (my $line = <OUT> \|\| $tcmd->is_expired) {
219	my $line = <OUT>;
220	chomp($line);
221	print "line: ", $line, "\n";
222	$buffer .= $out . "\n";
223	#pump $self->{handle};
224	pump $handle;
225
226	}
227
228	}
229
230	print "=read okay\n";
231
232	if ($tcmd->is_expired) {
233	print "command expired", "\n";
234	}
235
236	# TODO: async!
237	#return $buffer;
238	$self->{response}->($buffer) if $buffer;
239	}
240
241	sub get_output {
242	my $self = shift;
243	return $self->{buffer};
244	}
245
246	sub disconnect {
247	my $self = shift;
248	$self->_stop();
249	}
250
251	1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26