1# $OpenBSD: Remote.pm,v 1.10 2017/12/18 17:01:27 bluhm Exp $ 2 3# Copyright (c) 2010-2014 Alexander Bluhm <bluhm@openbsd.org> 4# 5# Permission to use, copy, modify, and distribute this software for any 6# purpose with or without fee is hereby granted, provided that the above 7# copyright notice and this permission notice appear in all copies. 8# 9# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 10# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 11# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 12# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 13# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 14# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 15# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 16 17use strict; 18use warnings; 19 20package Remote; 21use parent 'Proc'; 22use Carp; 23use Cwd; 24use File::Basename; 25use File::Copy; 26 27sub new { 28 my $class = shift; 29 my %args = @_; 30 $args{ktracefile} ||= "remote.ktrace"; 31 $args{logfile} ||= "remote.log"; 32 $args{up} ||= "Started"; 33 $args{down} ||= "Shutdown"; 34 $args{func} = sub { Carp::confess "$class func may not be called" }; 35 $args{remotessh} 36 or croak "$class remote ssh host not given"; 37 my $self = Proc::new($class, %args); 38 $self->{af} 39 or croak "$class address family not given"; 40 $self->{bindaddr} 41 or croak "$class bind addr not given"; 42 $self->{connectaddr} 43 or croak "$class connect addr not given"; 44 defined $self->{connectport} 45 or croak "$class connect port not given"; 46 return $self; 47} 48 49sub up { 50 my $self = Proc::up(shift, @_); 51 my $timeout = shift || 20; 52 if ($self->{connect}) { 53 $self->loggrep(qr/^Connected$/, $timeout) 54 or croak ref($self), " no Connected in $self->{logfile} ". 55 "after $timeout seconds"; 56 return $self; 57 } 58 my $lsock = $self->loggrep(qr/^listen sock: /, $timeout) 59 or croak ref($self), " no listen sock in $self->{logfile} ". 60 "after $timeout seconds"; 61 my($addr, $port) = $lsock =~ /: (\S+) (\S+)$/ 62 or croak ref($self), " no listen addr and port in $self->{logfile}"; 63 $self->{listenaddr} = $addr; 64 $self->{listenport} = $port; 65 return $self; 66} 67 68sub down { 69 my $self = Proc::down(shift, @_); 70 71 if ($ENV{KTRACE}) { 72 my @sshopts = $ENV{SSH_OPTIONS} ? 73 split(' ', $ENV{SSH_OPTIONS}) : (); 74 my $dir = dirname($0); 75 $dir = getcwd() if ! $dir || $dir eq "."; 76 my $ktr; 77 78 my @cmd = ("ssh", "-n", @sshopts, $self->{remotessh}, 79 "cat", "$dir/remote.ktrace"); 80 do { local $< = $>; open($ktr, '-|', @cmd) } 81 or die ref($self), " open pipe from '@cmd' failed: $!"; 82 unlink $self->{ktracefile}; 83 copy($ktr, $self->{ktracefile}); 84 close($ktr) or die ref($self), $! ? 85 " close pipe from '@cmd' failed: $!" : 86 " '@cmd' failed: $?"; 87 88 if ($self->{packet}) { 89 @cmd = ("ssh", "-n", @sshopts, $self->{remotessh}, 90 "cat", "$dir/packet.ktrace"); 91 do { local $< = $>; open($ktr, '-|', @cmd) } 92 or die ref($self), 93 " open pipe from '@cmd' failed: $!"; 94 unlink "packet.ktrace"; 95 copy($ktr, "packet.ktrace"); 96 close($ktr) or die ref($self), $! ? 97 " close pipe from '@cmd' failed: $!" : 98 " '@cmd' failed: $?"; 99 } 100 } 101 return $self; 102} 103 104sub child { 105 my $self = shift; 106 my @remoteopts; 107 108 if ($self->{opts}) { 109 my %opts = %{$self->{opts}}; 110 foreach my $k (sort keys %opts) { 111 push @remoteopts, "-$k"; 112 my $v = $opts{$k}; 113 push @remoteopts, $v if $k =~ /[A-Z]/ or $v ne 1; 114 } 115 } 116 117 print STDERR $self->{up}, "\n"; 118 my @sshopts = $ENV{SSH_OPTIONS} ? split(' ', $ENV{SSH_OPTIONS}) : (); 119 my @sudo = $ENV{SUDO} ? ($ENV{SUDO}, "SUDO=$ENV{SUDO}") : (); 120 my @ktrace = $ENV{KTRACE} ? "KTRACE=$ENV{KTRACE}" : (); 121 my $dir = dirname($0); 122 $dir = getcwd() if ! $dir || $dir eq "."; 123 my @cmd = ("ssh", $self->{remotessh}, 124 @sudo, @ktrace, "perl", 125 "-I", $dir, "$dir/".basename($0), @remoteopts, $self->{af}, 126 $self->{bindaddr}, $self->{connectaddr}, $self->{connectport}, 127 ($self->{bindport} ? $self->{bindport} : ()), 128 ($self->{testfile} ? "$dir/".basename($self->{testfile}) : ())); 129 print STDERR "execute: @cmd\n"; 130 $< = $>; 131 exec @cmd; 132 die ref($self), " exec '@cmd' failed: $!"; 133} 134 1351; 136