I've gotten much farther
[p5sagit/IPC-PerlSSH-MultiHop.git] / t / scratch.t
CommitLineData
43ee6732 1#!/usr/bin/perl
2use strictures 1;
3
4use Test::More;
855df2ea 5use Carp;
6use 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
56my $ssh = Net::SSH::Perl->new('localhost');
57$ssh->login('test', 'test');
58
59my $pipc = Net::SSH::Perl::ProxiedIPC->new(ssh => $ssh);
60
6ac47b9c 61my ($cmd, $perlssh) = $pipc->_open_perlssh;
43ee6732 62
6ac47b9c 63is( ref $perlssh, "IPC::PerlSSH", "\$perlssh isa IPC::PerlSSH (via $cmd)" );
43ee6732 64
65$perlssh->eval( "use POSIX qw(uname)" );
66my @remote_uname = $perlssh->eval( "uname()" );
67
68## This is a really shitty idea for a test but fuck you.
69is( $remote_uname[1], "minerva", 'localhost uname() returns minerva' );
28a69662 70
71my $homedir = $perlssh->eval( '$ENV{HOME}' );
72fail( "we require a little sensibility in our \$ENV thank you." )
73 unless defined $homedir;
74
75$perlssh->eval( "use File::HomeDir" );
76my $homedir2 = $perlssh->eval( 'File::HomeDir->my_home' );
77is( $homedir2, "/home/test", 'got $ENV{HOME} the smart way' );
78
855df2ea 79my $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;' );
80Dwarn %{ $new_env };
81$perlssh->_ssh_env_vars( %{ $new_env } );
55331616 82
83my @test_hosts = ( 'stagetwo@localhost', 'stagethree@localhost' );
6ac47b9c 84my ($cmd2, $pssh2) = $pipc->_open_perlssh(@test_hosts);
85is( ref $pssh2, "IPC::PerlSSH", "\$pssh2 isa IPC::PerlSSH (via $cmd2)" );
86
87$pssh2->eval( "use POSIX qw(uname)" );
88@remote_uname = $pssh2->eval( "uname()" );
89is( $remote_uname[1], "minerva", 'uname() returns minerva three jumps into localhost!' );
90
43ee6732 91done_testing;