File Coverage

blib/lib/Footprintless/Tunnel.pm
Criterion Covered Total %
statement 33 111 29.7
branch 0 22 0.0
condition 0 36 0.0
subroutine 11 21 52.3
pod 5 5 100.0
total 49 195 25.1


line stmt bran cond sub pod time code
1 1     1   50514 use strict;
  1         2  
  1         23  
2 1     1   4 use warnings;
  1         2  
  1         45  
3              
4             package Footprintless::Tunnel;
5             $Footprintless::Tunnel::VERSION = '1.28';
6             # ABSTRACT: Provides tunneling over ssh
7             # PODNAME: Footprintless::Tunnel
8              
9 1     1   335 use parent qw(Footprintless::MixableBase);
  1         324  
  1         4  
10              
11 1     1   31 use Carp;
  1         2  
  1         38  
12 1     1   4 use File::Path qw(make_path);
  1         2  
  1         43  
13 1     1   5 use File::Spec;
  1         1  
  1         13  
14 1     1   531 use File::Temp;
  1         13912  
  1         54  
15 1         43 use Footprintless::Mixins qw(
16             _entity
17 1     1   323 );
  1         2  
18 1     1   384 use IO::Socket::INET;
  1         9705  
  1         5  
19 1     1   352 use Log::Any;
  1         2  
  1         4  
20 1     1   478 use POSIX ":sys_wait_h";
  1         4598  
  1         4  
21              
22             my $logger = Log::Any->get_logger();
23              
24             my $number = 0;
25              
26             sub _build_command {
27 0     0     my ( $self, $command ) = @_;
28              
29 0           my @command = ( $self->{ssh}, ' -S ', $self->{control_socket} );
30              
31 0 0         if ( $command eq 'open' ) {
32 0           push( @command, ' -nfN -oControlMaster=yes -L ' );
33 0 0         if ( $self->{local_hostname} ) {
34 0           push( @command, $self->{local_hostname}, ':' );
35             }
36             push( @command,
37             $self->{local_port}, ':', $self->{destination_hostname},
38 0           ':', $self->{destination_port} );
39             }
40             else {
41 0           push( @command, ' -O ', $command );
42             }
43              
44 0           push( @command, ' ' );
45 0 0         if ( $self->{tunnel_username} ) {
46 0           push( @command, $self->{tunnel_username}, '@' );
47             }
48 0           push( @command, $self->{tunnel_hostname}, ' 2> /dev/null' );
49              
50 0           return join( '', @command );
51             }
52              
53             sub close {
54 0     0 1   my ($self) = @_;
55              
56 0 0         if ( $self->{pid} ) {
57 0           my $command = $self->_build_command('exit');
58 0           $logger->tracef( 'closing tunnel with: `%s`', $command );
59 0           `$command`;
60 0           my $child = waitpid( $self->{pid}, WNOHANG );
61 0           $logger->debugf( 'forked child closed: %s', $child );
62 0           delete( $self->{control_socket} );
63 0           delete( $self->{pid} );
64 0 0         if ( $self->{dynamic_local_port} ) {
65 0           delete( $self->{local_port} );
66 0           delete( $self->{dynamic_local_port} );
67             }
68             }
69             }
70              
71             sub DESTROY {
72 0     0     $_[0]->close();
73             }
74              
75             sub _find_port {
76              
77             # results in slight race condition, but for now, its ok.
78 0     0     my $sock = IO::Socket::INET->new(
79             Proto => 'tcp',
80             LocalPort => 0,
81             LocalAddr => 'localhost'
82             );
83 0           my $port = $sock->sockport();
84 0           $sock->close();
85 0           return $port;
86             }
87              
88             sub get_local_hostname {
89 0     0 1   return $_[0]->{local_hostname};
90             }
91              
92             sub get_local_port {
93 0     0 1   return $_[0]->{local_port};
94             }
95              
96             sub _init {
97 0     0     my ( $self, %options ) = @_;
98              
99 0           my $entity = $self->_entity( $self->{coordinate} );
100 0   0       $self->{ssh} = $options{ssh} || $entity->{ssh} || 'ssh -q';
101             $self->{local_hostname} = $options{local_hostname}
102 0   0       || $entity->{local_hostname};
103 0   0       $self->{local_port} = $options{local_port} || $entity->{local_port};
104             $self->{tunnel_hostname} = $options{tunnel_hostname}
105 0   0       || $entity->{tunnel_hostname};
106             $self->{tunnel_username} = $options{tunnel_username}
107 0   0       || $entity->{tunnel_username};
108             $self->{destination_hostname} = $options{destination_hostname}
109 0   0       || $entity->{destination_hostname};
110             $self->{destination_port} = $options{destination_port}
111 0   0       || $entity->{destination_port};
112             $self->{control_socket_dir} =
113             $options{control_socket_dir}
114             || $entity->{control_socket_dir}
115 0   0       || File::Spec->catdir( ( $ENV{HOME} ? $ENV{HOME} : $ENV{USERPROFILE} ),
116             '.ssh', 'control_socket' );
117 0   0       $self->{tries} = $options{tries} || $entity->{tries} || 10;
118             $self->{wait_seconds} =
119             $options{wait_seconds}
120             || $entity->{wait_seconds}
121 0   0       || 1;
122              
123 0           return $self;
124             }
125              
126             sub is_open {
127 0     0 1   my ($self) = @_;
128              
129 0 0         if ( !$self->{control_socket} ) {
130 0           return 0;
131             }
132              
133 0           my $command = $self->_build_command('check');
134 0           $logger->tracef( 'checking tunnel with: `%s`', $command );
135 0           `$command`;
136 0   0       return ( WIFEXITED( ${^CHILD_ERROR_NATIVE} ) && WEXITSTATUS( ${^CHILD_ERROR_NATIVE} ) == 0 );
137             }
138              
139             sub open {
140 0     0 1   my ( $self, %options ) = @_;
141              
142 0 0         if ( !$self->{local_port} ) {
143 0           $self->{local_port} = $self->_find_port();
144 0           $self->{dynamic_local_port} = 1;
145             }
146 0           $self->{control_socket} = $self->_temp_control_socket();
147 0           $self->{pid} = fork();
148 0 0         croak("too few resources to open tunnel") if ( !defined( $self->{pid} ) );
149              
150 0 0         if ( $self->{pid} == 0 ) {
151 0           my $command = $self->_build_command('open');
152 0           $logger->debugf( 'opening tunnel with: `%s`', $command );
153 0           exec($command);
154 0           exit(0);
155             }
156              
157 0           my $open = 0;
158 0   0       my $remaining_tries = $options{tries} || $self->{tries};
159 0   0       my $wait_seconds = $options{wait_seconds} || $self->{wait_seconds};
160 0           while ( $remaining_tries-- > 0 ) {
161 0 0         if ( $self->is_open() ) {
162 0           $open = 1;
163 0           last;
164             }
165 0           $logger->tracef( 'not yet open, %s tries remaining. sleeping...', $remaining_tries );
166 0           sleep($wait_seconds);
167             }
168              
169 0 0         croak('failed to open tunnel') if ( !$open );
170              
171 0           $logger->debug('tunnel open');
172             }
173              
174             sub _temp_control_socket {
175 0     0     my ($self) = shift;
176              
177 0           make_path( $self->{control_socket_dir} );
178 0           return File::Spec->catfile( $self->{control_socket_dir}, $$ . '_' . $number++ );
179             }
180              
181             1;
182              
183             __END__