File Coverage

blib/lib/Net/SSH/Perl/WithSocks.pm
Criterion Covered Total %
statement 18 38 47.3
branch 0 12 0.0
condition 0 4 0.0
subroutine 6 8 75.0
pod n/a
total 24 62 38.7


line stmt bran cond sub pod time code
1             package Net::SSH::Perl::WithSocks;
2 1     1   643 use strict;
  1         1  
  1         26  
3 1     1   4 use warnings;
  1         1  
  1         31  
4 1     1   9 use base qw(Net::SSH::Perl);
  1         2  
  1         517  
5 1     1   63441 use vars qw($VERSION);
  1         1  
  1         45  
6              
7             $VERSION = '0.02';
8              
9             =head1 NAME
10              
11             Net::SSH::Perl::WithSocks - connect to an SSH host through a TCP proxy
12              
13             =head1 SYNOPSIS
14              
15             my $ssh = Net::SSH::Perl::WithSocks->new( 'motherbrain.nanabox.net',
16             with_socks => {
17             socks_host => 'motherbrain.nanabox.net',
18             socks_port => 9000,
19             }
20             );
21              
22             $ssh->login(); # Use it just like a regular Net::SSH object
23              
24             =head1 DESCRIPTION
25              
26             This is a utility to make simple the process of connecting to an SSH
27             host by way of a TCP proxy, such as those provided by OpenSSH servers
28             for tunneling. It is based off of C so that it can work
29             in Windows as well, though the basic idea could be expounded upon to
30             support C as well.
31              
32             =cut
33              
34 1     1   4 use Carp;
  1         1  
  1         52  
35 1     1   695 use IO::Socket::Socks;
  1         15874  
  1         404  
36              
37             sub _init {
38 0     0     my( $self, %params ) = @_;
39 0 0         if( $params{SocksHost} ) {
40             $self->{WithSocks} = {
41             ProxyAddr => $params{SocksHost},
42             ProxyPort => $params{SocksPort},
43 0           };
44             }
45 0           $self->SUPER::_init(%params);
46             }
47              
48             sub _connect {
49 0     0     my $ssh = shift;
50 0 0         return $ssh->SUPER::_connect(@_) unless $ssh->{WithSocks};
51              
52 0           my $raddr = inet_aton($ssh->{host});
53 0 0         croak "Net::SSH::Perl::WithSocks: Bad Hostname: $ssh->{host}"
54             unless defined $raddr;
55 0   0       my $rport = $ssh->{config}->get('port') || 'ssh';
56 0 0         if( $rport =~ /\D/ ) {
57 0           my @serv = getservbyname(my $serv = $rport, 'tcp');
58 0   0       $rport = $serv[2] || 22;
59             }
60 0           $ssh->debug("Connecting to $ssh->{host}:$rport");
61             my $sock = IO::Socket::Socks->new(
62             ConnectAddr => $raddr,
63             ConnectPort => $rport,
64 0 0         %{$ssh->{WithSocks}}
  0            
65             ) or die "Can't connect to $ssh->{host}:$rport : $!";
66              
67 0           select((select($sock), $|=1)[0]);
68              
69 0           $ssh->{session}{sock} = $sock;
70 0           $ssh->_exchange_identification;
71              
72 0 0         defined( $sock->blocking(0) ) or die "Can't set non-blocking: $!";
73 0           $ssh->debug("Connection established.");
74             }
75              
76             1;
77              
78             __END__