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 { |
29 | $_[0]->{ssh_env_vars} ||= $_[0]->_build_ssh_env_vars; |
30 | } |
31 | |
32 | sub _build_ssh_env_vars { |
33 | return {}; |
34 | # this needs work I think. First off, it won't work. |
35 | # +{ $_[0]->_firsthop_perlssh->eval(; 'chomp(my @env = `ssh-agent`); my %new_env; foreach (@env) { /^(.*?)=(.*)/; $ENV{$1} =$new_env{$1}=$2; } return %new_env;' ); } |
36 | } |
37 | |
43ee6732 |
38 | sub _open_perlssh { |
39 | my( $self, @hosts ) = @_; |
40 | my $ssh = $self->_ssh; |
855df2ea |
41 | |
42 | my %vars = %{ $self->_ssh_env_vars }; |
43 | my $env_str = ''; $env_str .= "$_='$vars{$_}' " foreach ( keys %vars ); |
44 | my $command = join ' ', $env_str, (map "ssh -o StrictHostKeyChecking=no -A $_", @hosts), "perl"; |
45 | my( $read, $write ) = $ssh->open2("sh -c $env_str $command"); |
43ee6732 |
46 | |
47 | my $readfunc = sub { sysread( $read, $_[0], $_[1] ) }; |
48 | my $writefunc = sub { syswrite( $write, $_[0] ) }; |
49 | |
6ac47b9c |
50 | ($command, IPC::PerlSSH->new( Readfunc => $readfunc, Writefunc => $writefunc )); |
43ee6732 |
51 | } |
52 | |
53 | |
54 | } |
55 | |
56 | my $ssh = Net::SSH::Perl->new('localhost'); |
57 | $ssh->login('test', 'test'); |
58 | |
59 | my $pipc = Net::SSH::Perl::ProxiedIPC->new(ssh => $ssh); |
60 | |
6ac47b9c |
61 | my ($cmd, $perlssh) = $pipc->_open_perlssh; |
43ee6732 |
62 | |
6ac47b9c |
63 | is( ref $perlssh, "IPC::PerlSSH", "\$perlssh isa IPC::PerlSSH (via $cmd)" ); |
43ee6732 |
64 | |
65 | $perlssh->eval( "use POSIX qw(uname)" ); |
66 | my @remote_uname = $perlssh->eval( "uname()" ); |
67 | |
68 | ## This is a really shitty idea for a test but fuck you. |
69 | is( $remote_uname[1], "minerva", 'localhost uname() returns minerva' ); |
28a69662 |
70 | |
71 | my $homedir = $perlssh->eval( '$ENV{HOME}' ); |
72 | fail( "we require a little sensibility in our \$ENV thank you." ) |
73 | unless defined $homedir; |
74 | |
75 | $perlssh->eval( "use File::HomeDir" ); |
76 | my $homedir2 = $perlssh->eval( 'File::HomeDir->my_home' ); |
77 | is( $homedir2, "/home/test", 'got $ENV{HOME} the smart way' ); |
78 | |
855df2ea |
79 | my $new_env = $perlssh->eval( 'chomp(my @env = `ssh-agent`); my %new_env; foreach (@env) { /^(.*?)=(.*)/; $ENV{$1} =$new_env{$1}=$2; } my $output; $output .= "$_=$new_env{$_}" foreach ( keys %new_env ); $output;' ); |
80 | Dwarn %{ $new_env }; |
81 | $perlssh->_ssh_env_vars( %{ $new_env } ); |
55331616 |
82 | |
83 | my @test_hosts = ( 'stagetwo@localhost', 'stagethree@localhost' ); |
6ac47b9c |
84 | my ($cmd2, $pssh2) = $pipc->_open_perlssh(@test_hosts); |
85 | is( ref $pssh2, "IPC::PerlSSH", "\$pssh2 isa IPC::PerlSSH (via $cmd2)" ); |
86 | |
87 | $pssh2->eval( "use POSIX qw(uname)" ); |
88 | @remote_uname = $pssh2->eval( "uname()" ); |
89 | is( $remote_uname[1], "minerva", 'uname() returns minerva three jumps into localhost!' ); |
90 | |
43ee6732 |
91 | done_testing; |