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	joko	1.1	package Shell::SSH;
2			use strict;
3			use warnings;
4	joko	1.2	#use base qw( Shell );
5	joko	1.1	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	joko	1.2	#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	joko	1.1
19			use Data::Dumper;
20	joko	1.2	use IPC::Run qw( start pump finish timeout timer );
21			#use IPC::Run::Win32Helper;
22	joko	1.1
23			# debugging for IPC::Run
24	joko	1.2	#$ENV{IPCRUNDEBUG} = 10;
25			#$ENV{IPCRUNDEBUG} = 2;
26			$ENV{IPCRUNDEBUG} = 32;
27	joko	1.1
28			local *IN;
29			local *OUT;
30			local *ERR;
31
32	joko	1.2	my $in; my $out; my $err; my $handle;
33			my $t;
34	joko	1.1
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	joko	1.2	#my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
48			#my $self = shift if ref $_[0] && $_[0]->isa( 'Shell' );
49			my $self = shift;
50	joko	1.1	my $cmd = $AUTOLOAD;
51			$cmd =~ s/^.*:://;
52	joko	1.2	#if ($self) {
53	joko	1.1	# TODO: handle asynchronizity(?) here!
54			return $self->_run_command($cmd, @_);
55	joko	1.2	#}
56	joko	1.1	}
57
58			sub _init {
59			my $self = shift;
60	joko	1.2	$self->{in} = '';
61			$self->{out} = '';
62			$self->{err} = '';
63			$in = $out = $err = '';
64	joko	1.1	$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	joko	1.2	# $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	joko	1.1
120			}
121
122			sub _stop {
123			my $self = shift;
124	joko	1.2	#finish $self->{handle};
125			#finish $self->{handle};
126			finish $handle;
127	joko	1.1	}
128
129			sub _run_command {
130			my $self = shift;
131			my $rcommand = shift;
132	joko	1.2	#print "rcmd: $rcommand\n";
133	joko	1.1	my $rargs = join(' ', @_);
134			$rargs \|\|= '';
135			my $rcommandstring = join(' ', $rcommand, $rargs);
136	joko	1.2	$rcommandstring =~ s/\s//g;
137			#print "cmd: '", $rcommandstring, "'\n";
138	joko	1.1	#open IN, '';
139	joko	1.2	#$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	joko	1.1	return '';
165			}
166
167			sub _read_output {
168	joko	1.2	#print "_read_output\n";
169	joko	1.1	my $self = shift;
170			$self->{buffer} = [];
171			my $buffer = '';
172			#print "=read\n";
173	joko	1.2
174	joko	1.1	#print Dumper($self->{handle});
175	joko	1.2	#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	joko	1.1	}
229	joko	1.2
230			print "=read okay\n";
231
232			if ($tcmd->is_expired) {
233			print "command expired", "\n";
234			}
235
236	joko	1.1	# TODO: async!
237			#return $buffer;
238	joko	1.2	$self->{response}->($buffer) if $buffer;
239	joko	1.1	}
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