1#!/usr/bin/perl 2# $OpenBSD: remote.pl,v 1.9 2017/12/18 17:01:27 bluhm Exp $ 3 4# Copyright (c) 2010-2015 Alexander Bluhm <bluhm@openbsd.org> 5# 6# Permission to use, copy, modify, and distribute this software for any 7# purpose with or without fee is hereby granted, provided that the above 8# copyright notice and this permission notice appear in all copies. 9# 10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES 11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF 12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR 13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES 14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN 15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF 16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. 17 18use strict; 19use warnings; 20 21BEGIN { 22 if ($> == 0 && $ENV{SUDO_UID}) { 23 $> = $ENV{SUDO_UID}; 24 } 25} 26 27use File::Basename; 28use File::Copy; 29use Getopt::Std; 30use Socket; 31use Socket6; 32 33use Client; 34use Server; 35use Remote; 36use Packet; 37require 'funcs.pl'; 38 39sub usage { 40 die <<"EOF"; 41usage: 42 remote.pl af bindaddr connectaddr connectport test-args.pl 43 Only start remote relay. 44 remote.pl af bindaddr connectaddr connectport bindport test-args.pl 45 Only start remote relay with fixed port, needed for reuse. 46 remote.pl af localaddr fakeaddr remotessh test-args.pl 47 Run test with local client and server. Remote relay is 48 started automatically with ssh on remotessh. 49 remote.pl af localaddr fakeaddr remotessh clientport serverport test-args.pl 50 Run test with local client and server and fixed port, needed for reuse. 51 -f flush regress states 52EOF 53} 54 55my $command = "$0 @ARGV"; 56my $test; 57our %args; 58if (@ARGV) { 59 $test = pop; 60 do $test 61 or die "Do test file $test failed: ", $@ || $!; 62} 63my %opts; 64getopts("f", \%opts) or usage(); 65my($af, $domain, $protocol); 66if (@ARGV) { 67 $af = shift; 68 $domain = 69 $af eq "inet" ? AF_INET : 70 $af eq "inet6" ? AF_INET6 : 71 die "address family must be 'inet' or 'inet6\n"; 72 $protocol = $args{protocol}; 73 $protocol = $protocol->({ %args, af => $af, domain => $domain, }) 74 if ref $protocol eq 'CODE'; 75} 76my $mode = 77 @ARGV >= 3 && $ARGV[0] !~ /^\d+$/ && $ARGV[2] =~ /^\d+$/ ? "divert" : 78 @ARGV >= 3 && $ARGV[0] !~ /^\d+$/ && $ARGV[2] !~ /^\d+$/ ? "auto" : 79 usage(); 80my($clientport, $serverport, $bindport); 81if (@ARGV == 5 && $mode eq "auto") { 82 ($clientport, $serverport) = @ARGV[3,4]; 83} elsif (@ARGV == 4 && $mode eq "divert") { 84 ($bindport) = $ARGV[3]; 85} elsif (@ARGV != 3) { 86 usage(); 87} 88 89my $divert = $args{divert}; 90my ($local, $remote) = ("client", "server"); 91($local, $remote) = ($remote, $local) if $mode eq "divert"; 92($local, $remote) = ($remote, $local) if $divert =~ /reply|out/; 93my ($srcaddr, $dstaddr) = @ARGV[0,1]; 94($srcaddr, $dstaddr) = ($dstaddr, $srcaddr) if $mode eq "divert"; 95($srcaddr, $dstaddr) = ($dstaddr, $srcaddr) if $divert =~ /reply|out/; 96 97my ($logfile, $ktracefile, $packetlog, $packetktrace); 98if ($mode eq "divert") { 99 $logfile = dirname($0)."/remote.log"; 100 $ktracefile = dirname($0)."/remote.ktrace"; 101 $packetlog = dirname($0)."/packet.log"; 102 $packetktrace = dirname($0)."/packet.ktrace"; 103} 104 105my ($c, $l, $r, $s); 106if ($local eq "server") { 107 $l = $s = Server->new( 108 ktrace => $ENV{KTRACE}, 109 %args, 110 %{$args{server}}, 111 logfile => $logfile, 112 ktracefile => $ktracefile, 113 af => $af, 114 domain => $domain, 115 protocol => $protocol, 116 listenaddr => 117 $mode ne "divert" || $divert =~ /packet/ ? $ARGV[0] : 118 $af eq "inet" ? "127.0.0.1" : "::1", 119 listenport => $serverport || $bindport, 120 srcaddr => $srcaddr, 121 dstaddr => $dstaddr, 122 ) if $args{server}; 123} 124if ($mode eq "auto") { 125 $r = Remote->new( 126 %args, 127 opts => \%opts, 128 down => $args{packet} && "Shutdown Packet", 129 logfile => "$remote.log", 130 ktracefile => "$remote.ktrace", 131 testfile => $test, 132 af => $af, 133 remotessh => $ARGV[2], 134 bindaddr => $ARGV[1], 135 bindport => $remote eq "client" ? 136 $clientport : $serverport, 137 connect => $remote eq "client", 138 connectaddr => $ARGV[0], 139 connectport => $s ? $s->{listenport} : 0, 140 ); 141 $r->run->up; 142 $r->loggrep(qr/^Diverted$/, 10) 143 or die "no Diverted in $r->{logfile}"; 144} 145if ($local eq "client") { 146 $l = $c = Client->new( 147 ktrace => $ENV{KTRACE}, 148 %args, 149 %{$args{client}}, 150 logfile => $logfile, 151 ktracefile => $ktracefile, 152 af => $af, 153 domain => $domain, 154 protocol => $protocol, 155 connectaddr => $ARGV[1], 156 connectport => $r ? $r->{listenport} : $ARGV[2], 157 bindany => $mode eq "divert", 158 bindaddr => $ARGV[0], 159 bindport => $clientport || $bindport, 160 srcaddr => $srcaddr, 161 dstaddr => $dstaddr, 162 ) if $args{client}; 163} 164$l->{log}->print("local command: $command\n") if $l; 165 166if ($mode eq "divert") { 167 open(my $log, '<', $l->{logfile}) 168 or die "Remote log file open failed: $!"; 169 $SIG{__DIE__} = sub { 170 die @_ if $^S; 171 copy($log, \*STDERR); 172 warn @_; 173 exit 255; 174 }; 175 copy($log, \*STDERR); 176 177 my ($p, $plog); 178 $p = Packet->new( 179 ktrace => $ENV{KTRACE}, 180 %args, 181 %{$args{packet}}, 182 logfile => $packetlog, 183 ktracefile => $packetktrace, 184 af => $af, 185 domain => $domain, 186 bindport => 666, 187 ) if $args{packet}; 188 189 if ($p) { 190 open($plog, '<', $p->{logfile}) 191 or die "Remote packet log file open failed: $!"; 192 $SIG{__DIE__} = sub { 193 die @_ if $^S; 194 copy($log, \*STDERR); 195 copy_prefix(ref $p, $plog, \*STDERR); 196 warn @_; 197 exit 255; 198 }; 199 copy_prefix(ref $p, $plog, \*STDERR); 200 $p->run; 201 copy_prefix(ref $p, $plog, \*STDERR); 202 $p->up; 203 copy_prefix(ref $p, $plog, \*STDERR); 204 } 205 206 my @cmd = qw(pfctl -a regress -f -); 207 my $pf; 208 do { local $> = 0; open($pf, '|-', @cmd) } 209 or die "Open pipe to pf '@cmd' failed: $!"; 210 if ($local eq "server") { 211 my $port = $protocol =~ /^(tcp|udp)$/ ? 212 "port $s->{listenport}" : ""; 213 my $divertport = $port || "port 1"; # XXX bad pf syntax 214 my $divertcommand = $divert =~ /packet/ ? 215 "divert-packet port 666" : 216 "divert-to $s->{listenaddr} $divertport"; 217 print $pf "pass in log $af proto $protocol ". 218 "from $ARGV[1] to $ARGV[0] $port $divertcommand ". 219 "label regress\n"; 220 } 221 if ($local eq "client") { 222 my $port = $protocol =~ /^(tcp|udp)$/ ? 223 "port $ARGV[2]" : ""; 224 my $divertcommand = $divert =~ /packet/ ? 225 "divert-packet port 666" : "divert-reply"; 226 print $pf "pass out log $af proto $protocol ". 227 "from $c->{bindaddr} to $ARGV[1] $port $divertcommand ". 228 "label regress\n"; 229 } 230 close($pf) or die $! ? 231 "Close pipe to pf '@cmd' failed: $!" : 232 "pf '@cmd' failed: $?"; 233 if ($opts{f}) { 234 @cmd = qw(pfctl -k label -k regress); 235 do { local $> = 0; system(@cmd) } 236 and die "Execute '@cmd' failed: $!"; 237 } 238 print STDERR "Diverted\n"; 239 240 $l->run; 241 copy($log, \*STDERR); 242 $l->up; 243 copy($log, \*STDERR); 244 $l->down; 245 copy($log, \*STDERR); 246 247 if ($p) { 248 copy_prefix(ref $p, $plog, \*STDERR); 249 $p->down; 250 copy_prefix(ref $p, $plog, \*STDERR); 251 } 252 253 exit; 254} 255 256$s->run if $s; 257$c->run->up if $c; 258$s->up if $s; 259 260$c->down if $c; 261# remote side has 20 seconds timeout, wait longer than that here 262$r->down(30) if $r; 263$s->down if $s; 264 265check_logs($c || $r, $r, $s || $r, %args); 266 267sub copy_prefix { 268 my ($prefix, $src, $dst) = @_; 269 270 local $_; 271 while (defined($_ = <$src>)) { 272 chomp; 273 print $dst "$prefix: $_\n" if length; 274 } 275} 276