File Coverage

blib/lib/Metabrik/Proxy/Ssh2tcp.pm
Criterion Covered Total %
statement 12 165 7.2
branch 0 68 0.0
condition 0 12 0.0
subroutine 4 15 26.6
pod 2 7 28.5
total 18 267 6.7


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4             # proxy::ssh2tcp Brik
5             #
6             package Metabrik::Proxy::Ssh2tcp;
7 1     1   1078 use strict;
  1         3  
  1         31  
8 1     1   5 use warnings;
  1         2  
  1         28  
9              
10 1     1   6 use base qw(Metabrik::System::Process);
  1         2  
  1         510  
11              
12             sub brik_properties {
13             return {
14 0     0 1   revision => '$Revision$',
15             tags => [ qw(unstable ssh tcp socket netcat) ],
16             author => 'GomoR ',
17             license => 'http://opensource.org/licenses/BSD-3-Clause',
18             attributes => {
19             hostname => [ qw(listen_hostname) ],
20             port => [ qw(listen_port) ],
21             username => [ qw(username) ],
22             ssh_hostname_port => [ qw(ssh_hostname_port) ],
23             remote_hostname_port => [ qw(remote_hostname_port) ],
24             st => [ qw(INTERNAL) ],
25             so => [ qw(INTERNAL) ],
26             },
27             attributes_default => {
28             username => 'root',
29             hostname => '127.0.0.1',
30             port => 8888,
31             },
32             commands => {
33             start => [ qw(ssh_hostname_port|OPTIONAL remote_hostname_port|OPTIONAL) ],
34             tunnel_loop => [ qw(remote_hostname_port) ],
35             background_tunnel_loop => [ qw(remote_hostname_port) ],
36             is_started => [ ],
37             stop => [ ],
38             },
39             require_modules => {
40             'Metabrik::Client::Openssh' => [ ],
41             'Metabrik::Server::Tcp' => [ ],
42             },
43             };
44             }
45              
46             sub _handle_sigint {
47 0     0     my $self = shift;
48              
49 0           my $restore = $SIG{INT};
50              
51             $SIG{INT} = sub {
52 0     0     $self->log->debug("brik_init: INT caught");
53 0           $SIG{INT} = $restore;
54 0           $self->stop;
55 0           return 1;
56 0           };
57              
58 0           return 1;
59             }
60              
61             sub brik_init {
62 0     0 1   my $self = shift;
63              
64 0           $self->_handle_sigint;
65              
66 0           return $self->SUPER::brik_init(@_);
67             }
68              
69             sub is_started {
70 0     0 0   my $self = shift;
71              
72 0 0         if (defined($self->st)) {
73 0           return 1;
74             }
75              
76 0           return 0;
77             }
78              
79             sub background_tunnel_loop {
80 0     0 0   my $self = shift;
81 0           my $args = \@_;
82              
83 0 0   0     return $self->start(sub { $self->start(@$args) && $self->tunnel_loop(@$args) });
  0            
84             }
85              
86             sub start {
87 0     0 0   my $self = shift;
88 0           my ($ssh_hostname_port, $remote_hostname_port, $username) = @_;
89              
90 0           my $hostname = $self->hostname;
91 0           my $port = $self->port;
92 0   0       $ssh_hostname_port ||= $self->ssh_hostname_port;
93 0   0       $remote_hostname_port ||= $self->remote_hostname_port;
94 0   0       $username ||= $self->username;
95 0 0         $self->brik_help_run_undef_arg('start', $ssh_hostname_port) or return;
96 0 0         my $ref = $self->brik_help_run_invalid_arg('start', $ssh_hostname_port, 'ARRAY', 'SCALAR')
97             or return;
98 0 0         $self->brik_help_run_undef_arg('start', $remote_hostname_port) or return;
99 0 0         if ($remote_hostname_port !~ /^[^:]+:\d+$/) {
100 0           return $self->log->error("start: invalid format for remote_hostname_port [$remote_hostname_port], must be hostname:port");
101             }
102              
103 0           my $so;
104             # Only one hop
105 0 0         if ($ref eq 'SCALAR') {
    0          
106 0 0         if ($ssh_hostname_port !~ /^[^:]+:\d+$/) {
107 0           return $self->log->error("start: invalid format for ssh_hostname_port [$ssh_hostname_port], must be hostname:port");
108             }
109              
110 0           my ($ssh_hostname, $ssh_port) = split(':', $ssh_hostname_port);
111              
112 0 0         $so = Metabrik::Client::Openssh->new_from_brik_init($self) or return;
113 0           $so->username($username);
114 0 0         $so->connect($ssh_hostname, $ssh_port) or return;
115              
116 0           $self->log->verbose("start: connected to SSH [$ssh_hostname]:$ssh_port");
117             }
118             # Multiple hops :)
119             elsif ($ref eq 'ARRAY') {
120 0           my @ok = ();
121 0           for my $this (@$ssh_hostname_port) {
122 0 0         if ($this !~ /^[^:]+:\d+$/) {
123 0           $self->log->verbose("start: invalid format for this [$this], must be hostname:port");
124 0           next;
125             }
126 0           push @ok, $this;
127             }
128              
129 0 0         if (@ok < 2) {
130 0           return $self->log->error("start: cannot chain with only one proxy");
131             }
132              
133             # Build hop chain
134 0           my $path = [];
135 0           my $hop = 1;
136 0           my $lport = $port+1;
137 0           my $target = $remote_hostname_port;
138 0           while (1) {
139 0 0         if ($hop == 1) {
140 0           my $this = shift @ok;
141 0           my $next = shift @ok;
142 0 0         last unless defined $next;
143 0           push @$path, {
144             from => $this,
145             to => $next,
146             host => 'localhost',
147             port => $lport++,
148             };
149             }
150             else {
151 0           my $next = shift @ok;
152 0 0         last unless defined $next;
153             push @$path, {
154             from => $path->[-1]->{host}.':'.$path->[-1]->{port},
155 0           to => $next,
156             host => 'localhost',
157             port => $lport++,
158             };
159             }
160 0           $hop++;
161             }
162              
163             push @$path, {
164             from => $path->[-1]->{host}.':'.$path->[-1]->{port},
165 0           to => $remote_hostname_port,
166             host => 'localhost',
167             port => $port,
168             };
169              
170 1     1   8 use Data::Dumper;
  1         2  
  1         1214  
171 0           print Dumper($path)."\n";
172             #return 1;
173              
174 0           $hop = 1;
175 0           for my $this (@$path) {
176 0           $self->hostname($this->{host});
177 0           $self->port($this->{port});
178             $self->log->verbose("background_start: ".
179             "from: ".$this->{from}." to: ".$this->{to}. " listen: ".$this->{port}
180 0           );
181              
182             #$self->start($this->{from}, $this->{to}) or return;
183 0 0         $self->background_tunnel_loop($this->{from}, $this->{to}) or return;
184              
185 0           $self->log->verbose("start: connected to SSH hop [$hop] [".$this->{to}."]");
186              
187             # XXX: do better
188 0           sleep(5); # Wait for tunnel to be established
189              
190 0           $hop++;
191             }
192              
193 0           return 1;
194             }
195              
196 0 0         my $st = Metabrik::Server::Tcp->new_from_brik_init($self) or return;
197 0           $st->hostname($self->hostname);
198 0           $st->port($self->port);
199              
200 0 0         my $server = $st->start or return;
201 0           $self->st($st);
202 0           $self->so($so);
203              
204 0 0         $self->tunnel_loop($remote_hostname_port) or return;
205              
206 0           return 1;
207             }
208              
209             sub tunnel_loop {
210 0     0 0   my $self = shift;
211 0           my ($remote_hostname_port) = @_;
212              
213 0 0         if (! $self->is_started) {
214 0           return $self->log->error($self->brik_help_run('start'));
215             }
216              
217 0 0         $self->brik_help_run_undef_arg('tunnel_loop', $remote_hostname_port) or return;
218 0 0         if ($remote_hostname_port !~ /^[^:]+:\d+$/) {
219 0           return $self->log->error("start: invalid format for remote_hostname_port [$remote_hostname_port], must be hostname:port");
220             }
221              
222 0           my ($remote_hostname, $remote_port) = split(':', $remote_hostname_port);
223              
224 0           my $st = $self->st;
225 0           my $server = $st->socket;
226 0           my $select = $st->select;
227 0           my $clients = $st->clients;
228              
229 0           my $so = $self->so;
230              
231 0           while (1) {
232 0 0         last if ! $self->is_started; # Used to stop the process on SIGINT
233              
234 0 0         if (my $ready = $st->wait_readable) {
235 0           for my $sock (@$ready) {
236 0           my ($id, $this_client, $this_tunnel) = $self->_get_tunnel_from_sock($clients, $sock);
237 0 0         if ($sock == $server) {
238 0           $self->log->verbose("start: server socket ready");
239 0           my $client = $st->accept;
240              
241             $self->log->verbose("start: new connection from [".
242 0           $client->{ipv4}."]:".$client->{port});
243              
244 0 0         my $tunnel = $so->open_tunnel($remote_hostname, $remote_port) or return;
245 0           $select->add($tunnel);
246 0           $client->{tunnel} = $tunnel;
247              
248 0           $self->log->verbose("start: tunnel opened to [$remote_hostname]:$remote_port");
249             }
250             else {
251 0 0         if ($sock == $this_client) { # Client sent something
    0          
252 0           my $buf = $st->read($this_client);
253 0 0         if (! defined($buf)) {
254 0           $self->log->verbose("start: client disconnected");
255 0           $select->remove($this_client);
256             }
257             else {
258 0           $self->log->verbose("start: read from client [".length($buf)."]");
259 0           $self->log->verbose("start: write to tunnel [".length($buf)."]");
260 0           $this_tunnel->syswrite($buf);
261             }
262             }
263             elsif ($sock == $this_tunnel) {
264 0           my $buf = $st->read($this_tunnel);
265 0 0         if (! defined($buf)) {
266             # If tunnel is disconnected, we can wipe the full connecting client state.
267             # And only at that time.
268 0           $self->log->verbose("start: tunnel disconnected");
269 0           $select->remove($this_tunnel);
270 0           close($this_tunnel);
271 0           $st->client_disconnected($id);
272             }
273             else {
274 0           $self->log->verbose("start: read from tunnel [".length($buf)."]");
275 0           $self->log->debug("start: read from tunnel [$buf]");
276 0           $self->log->verbose("start: write to client [".length($buf)."]");
277 0           $self->log->debug("start: write to client [$buf]");
278 0           $this_client->syswrite($buf);
279             }
280             }
281             }
282             }
283             }
284             }
285              
286 0           return 1;
287             }
288              
289             sub stop {
290 0     0 0   my $self = shift;
291              
292 0 0         if (! $self->is_started) {
293 0           return $self->log->verbose("stop: not started");
294             }
295              
296 0           my $st = $self->st;
297              
298             # server::tcp know nothing about tunnels, we have to clean by ourselves
299 0           my $clients = $st->clients;
300 0           for my $this (keys %$clients) {
301 0 0         if (exists($clients->{$this}{tunnel})) {
302 0           close($clients->{$this}{tunnel});
303 0           $self->log->verbose("stop: tunnel for client [$this] closed");
304             }
305             }
306              
307 0           $st->stop;
308              
309 0           $self->_handle_sigint; # Reharm the signal
310              
311 0           $self->st(undef);
312              
313 0           return 1;
314             }
315              
316             sub _get_tunnel_from_sock {
317 0     0     my $self = shift;
318 0           my ($clients, $sock) = @_;
319              
320 0           my $client;
321             my $this_client;
322 0           my $this_tunnel;
323 0           for my $k (keys %$clients) {
324 0 0 0       if ($sock == $clients->{$k}{socket} || $sock == $clients->{$k}{tunnel}) {
325 0           $client = $k;
326 0           $this_client = $clients->{$k}{socket};
327 0           $this_tunnel = $clients->{$k}{tunnel};
328 0           last;
329             }
330             }
331              
332 0           return ( $client, $this_client, $this_tunnel );
333             }
334              
335             1;
336              
337             __END__