t/scratch.t

   1 #!/usr/bin/perl
   2 use strictures 1;
   3
   4 use Test::More;
   5 use Carp;
   6 use Devel::Dwarn;
   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
  28   sub _ssh_env_vars {
  29     if( defined $_[1] ) {
  30       $_[0]->{ssh_env_vars} = $_[1];
  31     } else {
  32       $_[0]->{ssh_env_vars} ||= $_[0]->_build_ssh_env_vars;
  33     }
  34   }
  35
  36   sub _build_ssh_env_vars {
  37     return '';
  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
  42   sub _open_perlssh {
  43     my( $self, @hosts ) = @_;
  44     my $ssh = $self->_ssh;
  45
  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);
  50
  51     my $readfunc = sub { sysread( $read, $_[0], $_[1] ) };
  52     my $writefunc = sub { syswrite( $write, $_[0] ) };
  53
  54     ($command, IPC::PerlSSH->new( Readfunc => $readfunc, Writefunc => $writefunc ));
  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
  65 my ($cmd, $perlssh) = $pipc->_open_perlssh;
  66
  67 is( ref $perlssh, "IPC::PerlSSH", "\$perlssh isa IPC::PerlSSH (via $cmd)" );
  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' );
  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
  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;
  86
  87 my @test_hosts = ( 'stagetwo@localhost', 'stagethree@localhost' );
  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
  95 done_testing;