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