Commit | Line | Data |
43ee6732 |
1 | #!/usr/bin/perl |
2 | use strictures 1; |
3 | |
4 | use Test::More; |
855df2ea |
5 | use Carp; |
6 | use Devel::Dwarn; |
43ee6732 |
7 | |
8 | { |
9 | package Net::SSH::Perl::ProxiedIPC; |
10 | use strict; use warnings; |
11 | use Net::SSH::Perl::WithSocks; |
12 | use IPC::PerlSSH; |
13 | |
14 | sub new { |
15 | my $proto = shift; |
16 | my $class = ref $proto || $proto; |
17 | bless( { @_ }, $class ); |
18 | } |
19 | |
20 | sub _ssh { |
21 | $_[0]->{ssh} ||= $_[0]->_build_ssh |
22 | } |
23 | |
24 | sub _build_ssh { |
25 | Net::SSH::Perl::WithSocks->new(); |
26 | } |
27 | |
855df2ea |
28 | sub _ssh_env_vars { |
1764dd1b |
29 | if( defined $_[1] ) { |
30 | $_[0]->{ssh_env_vars} = $_[1]; |
31 | } else { |
32 | $_[0]->{ssh_env_vars} ||= $_[0]->_build_ssh_env_vars; |
33 | } |
855df2ea |
34 | } |
35 | |
36 | sub _build_ssh_env_vars { |
506d80b1 |
37 | return ''; |
855df2ea |
38 | # this needs work I think. First off, it won't work. |
39 | # +{ $_[0]->_firsthop_perlssh->eval(; 'chomp(my @env = `ssh-agent`); my %new_env; foreach (@env) { /^(.*?)=(.*)/; $ENV{$1} =$new_env{$1}=$2; } return %new_env;' ); } |
40 | } |
41 | |
43ee6732 |
42 | sub _open_perlssh { |
43 | my( $self, @hosts ) = @_; |
44 | my $ssh = $self->_ssh; |
855df2ea |
45 | |
506d80b1 |
46 | my $env_str = $self->_ssh_env_vars; |
47 | my $command = join ' ', (map "ssh -o StrictHostKeyChecking=no -A $_", @hosts), "perl"; |
48 | $command = "sh -c '$env_str$command'"; |
49 | my( $read, $write ) = $ssh->open2($command); |
43ee6732 |
50 | |
51 | my $readfunc = sub { sysread( $read, $_[0], $_[1] ) }; |
52 | my $writefunc = sub { syswrite( $write, $_[0] ) }; |
53 | |
6ac47b9c |
54 | ($command, IPC::PerlSSH->new( Readfunc => $readfunc, Writefunc => $writefunc )); |
43ee6732 |
55 | } |
56 | |
57 | |
58 | } |
59 | |
60 | my $ssh = Net::SSH::Perl->new('localhost'); |
61 | $ssh->login('test', 'test'); |
62 | |
63 | my $pipc = Net::SSH::Perl::ProxiedIPC->new(ssh => $ssh); |
64 | |
6ac47b9c |
65 | my ($cmd, $perlssh) = $pipc->_open_perlssh; |
43ee6732 |
66 | |
6ac47b9c |
67 | is( ref $perlssh, "IPC::PerlSSH", "\$perlssh isa IPC::PerlSSH (via $cmd)" ); |
43ee6732 |
68 | |
69 | $perlssh->eval( "use POSIX qw(uname)" ); |
70 | my @remote_uname = $perlssh->eval( "uname()" ); |
71 | |
72 | ## This is a really shitty idea for a test but fuck you. |
73 | is( $remote_uname[1], "minerva", 'localhost uname() returns minerva' ); |
28a69662 |
74 | |
75 | my $homedir = $perlssh->eval( '$ENV{HOME}' ); |
76 | fail( "we require a little sensibility in our \$ENV thank you." ) |
77 | unless defined $homedir; |
78 | |
79 | $perlssh->eval( "use File::HomeDir" ); |
80 | my $homedir2 = $perlssh->eval( 'File::HomeDir->my_home' ); |
81 | is( $homedir2, "/home/test", 'got $ENV{HOME} the smart way' ); |
82 | |
506d80b1 |
83 | my $new_env = $perlssh->eval( 'chomp(my @env = `ssh-agent`); my %new_env; foreach (@env) { /^(.*?)=([^;]+)/ or next; $ENV{$1} =$new_env{$1}=$2; } my $output; $output .= "$_=$new_env{$_} " foreach ( keys %new_env ); $output;' ); |
84 | Dwarn $new_env; |
85 | $pipc->{ssh_env_vars} = $new_env; |
55331616 |
86 | |
87 | my @test_hosts = ( 'stagetwo@localhost', 'stagethree@localhost' ); |
6ac47b9c |
88 | my ($cmd2, $pssh2) = $pipc->_open_perlssh(@test_hosts); |
89 | is( ref $pssh2, "IPC::PerlSSH", "\$pssh2 isa IPC::PerlSSH (via $cmd2)" ); |
90 | |
91 | $pssh2->eval( "use POSIX qw(uname)" ); |
92 | @remote_uname = $pssh2->eval( "uname()" ); |
93 | is( $remote_uname[1], "minerva", 'uname() returns minerva three jumps into localhost!' ); |
94 | |
43ee6732 |
95 | done_testing; |