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