Home | History | Annotate | Download | only in misc 
      1 #!/usr/bin/perl
      2 #
      3 # Copyright (c) 2006-2010 by Karl J. Runge <runge (at] karlrunge.com>
      4 #
      5 # connect_switch is free software; you can redistribute it and/or modify
      6 # it under the terms of the GNU General Public License as published by
      7 # the Free Software Foundation; either version 2 of the License, or (at
      8 # your option) any later version.
      9 # 
     10 # connect_switch is distributed in the hope that it will be useful,
     11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
     12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     13 # GNU General Public License for more details.
     14 # 
     15 # You should have received a copy of the GNU General Public License
     16 # along with connect_switch; if not, write to the Free Software
     17 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA
     18 # or see <http://www.gnu.org/licenses/>.
     19 # 
     20 # 
     21 # connect_switch:
     22 #
     23 # A kludge script that sits between web clients and a mod_ssl (https)
     24 # enabled apache webserver.  
     25 #
     26 # If an incoming web client connection makes a proxy CONNECT request
     27 # it is handled directly by this script (apache is not involved).
     28 # Otherwise, all other connections are forwarded to the apache webserver.
     29 #
     30 # This can be useful for VNC redirection using an existing https (port
     31 # 443) webserver, thereby not requiring a 2nd (non-https) port open on
     32 # the firewall for the CONNECT requests.
     33 #
     34 # It does not seem possible (to me) to achieve this entirely within apache
     35 # because the CONNECT request appears to be forwarded encrypted to
     36 # the remote host and so the SSL dies immediately. 
     37 #
     38 # It can also be used to redirect ANY protocol, e.g. SSH, not just VNC.
     39 # See CONNECT_SWITCH_APPLY_VNC_OFFSET=0 to disable VNC 5900 shift.
     40 #
     41 # Note: There is no need to use this script for a non-ssl apache webserver
     42 # port because mod_proxy works fine for doing the switching all inside
     43 # apache (see ProxyRequests and AllowCONNECT parameters).
     44 #
     45 #
     46 # Apache configuration:
     47 #
     48 # The mod_ssl configuration is often in a file named ssl.conf.  In the
     49 # simplest case you change something like this:
     50 #
     51 #   From:
     52 #   
     53 #     Listen 443
     54 #     
     55 #     <VirtualHost _default_:443>
     56 #     ...
     57 #     </VirtualHost>
     58 #     
     59 #   To:
     60 #   
     61 #     Listen 127.0.0.1:443
     62 #     
     63 #     <VirtualHost _default_:443>
     64 #     ...
     65 #     </VirtualHost>
     66 #
     67 # (i.e. just change the Listen directive).
     68 #
     69 # If you have mod_ssl listening on a different internal port, you do
     70 # not need to specify the localhost Listen address.
     71 #
     72 # It is probably a good idea to set $listen_host below to the known
     73 # IP address you want the service to listen on (to avoid localhost where
     74 # apache is listening).
     75 #
     76 
     77 ####################################################################
     78 # NOTE: For more info on configuration settings, read below for
     79 #       all of the CONNECT_SWITCH_* env. var. parameters.
     80 ####################################################################
     81 
     82 
     83 ####################################################################
     84 # Allow env vars to also be specified on cmdline:
     85 #
     86 foreach my $arg (@ARGV) {
     87 	if ($arg =~ /^(CONNECT_SWITCH.*?)=(.*)$/) {
     88 		$ENV{$1} = $2;
     89 	}
     90 }
     91 
     92 # Set up logging:
     93 #
     94 if (exists $ENV{CONNECT_SWITCH_LOGFILE}) {
     95 	close STDOUT;
     96 	if (!open(STDOUT, ">>$ENV{CONNECT_SWITCH_LOGFILE}")) {
     97 		die "connect_switch: $ENV{CONNECT_SWITCH_LOGFILE} $!\n";
     98 	}
     99 	close STDERR;
    100 	open(STDERR, ">&STDOUT");
    101 }
    102 select(STDERR); $| = 1;
    103 select(STDOUT); $| = 1;
    104 
    105 # interrupt handler:
    106 #
    107 my $looppid = '';
    108 my $pidfile = '';
    109 my $listen_sock = '';	# declared here for get_out()
    110 #
    111 sub get_out {
    112 	print STDERR "$_[0]:\t$$ looppid=$looppid\n";
    113 	close $listen_sock if $listen_sock;
    114 	if ($looppid) {
    115 		kill 'TERM', $looppid;
    116 		fsleep(0.2);
    117 	}
    118 	unlink $pidfile if $pidfile;
    119 	exit 0;
    120 }
    121 $SIG{INT}  = \&get_out;
    122 $SIG{TERM} = \&get_out;
    123 
    124 # pidfile:
    125 #
    126 sub open_pidfile {
    127 	if (exists $ENV{CONNECT_SWITCH_PIDFILE}) {
    128 		my $pf = $ENV{CONNECT_SWITCH_PIDFILE};
    129 		if (open(PID, ">$pf")) {
    130 			print PID "$$\n";
    131 			close PID;
    132 			$pidfile = $pf;
    133 		} else {
    134 			print STDERR "could not open pidfile: $pf - $! - continuing...\n";
    135 		}
    136 		delete $ENV{CONNECT_SWITCH_PIDFILE};
    137 	}
    138 }
    139 
    140 ####################################################################
    141 # Set CONNECT_SWITCH_LOOP=1 to have this script create an outer loop
    142 # restarting itself if it ever exits.  Set CONNECT_SWITCH_LOOP=BG to
    143 # do this in the background as a daemon.
    144 
    145 if (exists $ENV{CONNECT_SWITCH_LOOP}) {
    146 	my $csl = $ENV{CONNECT_SWITCH_LOOP};
    147 	if ($csl ne 'BG' && $csl ne '1') {
    148 		die "connect_switch: invalid CONNECT_SWITCH_LOOP.\n";
    149 	}
    150 	if ($csl eq 'BG') {
    151 		# go into bg as "daemon":
    152 		setpgrp(0, 0);
    153 		my $pid = fork();
    154 		if (! defined $pid) {
    155 			die "connect_switch: $!\n";
    156 		} elsif ($pid) {
    157 			wait;
    158 			exit 0;
    159 		}
    160 		if (fork) {
    161 			exit 0;
    162 		}
    163 		setpgrp(0, 0);
    164 		close STDIN;
    165 		if (! $ENV{CONNECT_SWITCH_LOGFILE}) {
    166 			close STDOUT;
    167 			close STDERR;
    168 		}
    169 	}
    170 	delete $ENV{CONNECT_SWITCH_LOOP};
    171 
    172 	if (exists $ENV{CONNECT_SWITCH_PIDFILE}) {
    173 		open_pidfile();
    174 	}
    175 
    176 	print STDERR "connect_switch: starting service at ", scalar(localtime), " master-pid=$$\n";
    177 	while (1) {
    178 		$looppid = fork;
    179 		if (! defined $looppid) {
    180 			sleep 10;
    181 		} elsif ($looppid) {
    182 			wait;
    183 		} else {
    184 			exec $0;	
    185 			exit 1;
    186 		}
    187 		print STDERR "connect_switch: re-starting service at ", scalar(localtime), " master-pid=$$\n";
    188 		sleep 1;
    189 	}
    190 	exit 0;
    191 }
    192 if (exists $ENV{CONNECT_SWITCH_PIDFILE}) {
    193 	open_pidfile();
    194 }
    195 
    196 
    197 ############################################################################
    198 # The defaults for hosts and ports (you can override them below if needed):
    199 #
    200 # Look below for these environment variables that let you set the various
    201 # parameters without needing to edit this script:
    202 #
    203 #	CONNECT_SWITCH_LISTEN
    204 #	CONNECT_SWITCH_HTTPD
    205 #	CONNECT_SWITCH_ALLOWED
    206 #	CONNECT_SWITCH_ALLOW_FILE
    207 #	CONNECT_SWITCH_VERBOSE
    208 #	CONNECT_SWITCH_APPLY_VNC_OFFSET
    209 #	CONNECT_SWITCH_VNC_OFFSET
    210 #	CONNECT_SWITCH_LISTEN_IPV6
    211 #	CONNECT_SWITCH_BUFSIZE
    212 #	CONNECT_SWITCH_LOGFILE
    213 #	CONNECT_SWITCH_PIDFILE
    214 #	CONNECT_SWITCH_MAX_CONNECTIONS
    215 #
    216 # You can also set these on the cmdline:
    217 #      connect_switch CONNECT_SWITCH_LISTEN=X CONNECT_SWITCH_ALLOW_FILE=Y ...
    218 #
    219 
    220 # By default we will use hostname and assume it resolves:
    221 #
    222 my $hostname = `hostname`;
    223 chomp $hostname;
    224 
    225 my $listen_host = $hostname;	
    226 my $listen_port = 443;	
    227 
    228 # Let user override listening situation, e.g. multihomed:
    229 #
    230 if (exists $ENV{CONNECT_SWITCH_LISTEN}) {
    231 	#
    232 	# E.g. CONNECT_SWITCH_LISTEN=192.168.0.32:443
    233 	#
    234 	$listen_host = '';
    235 	$listen_port = '';
    236 	if ($ENV{CONNECT_SWITCH_LISTEN} =~ /^(.*):(\d+)$/) {
    237 		($listen_host, $listen_port) = ($1, $2);
    238 	}
    239 }
    240 
    241 my $httpd_host = 'localhost';	
    242 my $httpd_port = 443;	
    243 
    244 if (exists $ENV{CONNECT_SWITCH_HTTPD}) {
    245 	#
    246 	# E.g. CONNECT_SWITCH_HTTPD=127.0.0.1:443
    247 	#
    248 	$httpd_host = '';
    249 	$httpd_port = '';
    250 	if ($ENV{CONNECT_SWITCH_HTTPD} =~ /^(.*):(\d+)$/) {
    251 		($httpd_host, $httpd_port) = ($1, $2);
    252 	}
    253 }
    254 
    255 my $bufsize = 8192;
    256 if (exists $ENV{CONNECT_SWITCH_BUFSIZE}) {
    257 	#
    258 	# E.g. CONNECT_SWITCH_BUFSIZE=32768
    259 	#
    260 	$bufsize = $ENV{CONNECT_SWITCH_BUFSIZE};
    261 }
    262 
    263 
    264 ############################################################################
    265 # You can/should override the host/port settings here:
    266 #
    267 #$listen_host = '23.45.67.89';		# set to your interface IP number.
    268 #$listen_port = 555;			# and/or nonstandard port.
    269 #$httpd_host  = 'somehost';		# maybe you redir https to another machine.
    270 #$httpd_port  = 666;			# and/or nonstandard port.
    271 
    272 # You must set the allowed host:port CONNECT redirection list.
    273 # Only these host:port pairs will be redirected to.
    274 # Port ranges are allowed too:  host:5900-5930.
    275 # If there is one entry named ALL all connections are allow.
    276 # You must supply something, default is deny.
    277 #
    278 my @allowed = qw(
    279 	machine1:5915
    280 	machine2:5900
    281 );
    282 
    283 if (exists $ENV{CONNECT_SWITCH_ALLOWED}) {
    284 	#
    285 	# E.g. CONNECT_SWITCH_ALLOWED=machine1:5915,machine2:5900
    286 	#
    287 	@allowed = split(/,/, $ENV{CONNECT_SWITCH_ALLOWED});
    288 }
    289 
    290 # Or you could also use an external "allow file".
    291 # They get added to the @allowed list.
    292 # The file is re-read for each new connection.
    293 #
    294 # Format of $allow_file:
    295 #
    296 #     host1 vncdisp
    297 #     host2 vncdisp
    298 #
    299 # where, e.g. vncdisp = 15 => port 5915, say
    300 #
    301 #     joesbox  15 
    302 #     fredsbox 15 
    303 #     rupert    1 
    304 
    305 # For examply, mine is:
    306 #
    307 my $allow_file = '/dist/apache/2.0/conf/vnc.hosts';
    308 $allow_file = '';
    309 
    310 if (exists $ENV{CONNECT_SWITCH_ALLOW_FILE}) {
    311 	# E.g. CONNECT_SWITCH_ALLOW_FILE=/usr/local/etc/allow.txt
    312 	$allow_file = $ENV{CONNECT_SWITCH_ALLOW_FILE};
    313 }
    314 
    315 # Set to 1 to re-map to vnc port, e.g. 'hostname 15' to 'hostname 5915'
    316 # i.e. assume a port 0 <= port < 200 is actually a VNC display
    317 # and add 5900 to it.  Set to 0 to not do the mapping.
    318 # Note that negative ports, e.g. 'joesbox -22' go directly to -port.
    319 #
    320 my $apply_vnc_offset = 1;
    321 my $vnc_offset = 5900;
    322 
    323 if (exists $ENV{CONNECT_SWITCH_APPLY_VNC_OFFSET}) {
    324 	#
    325 	# E.g. CONNECT_SWITCH_APPLY_VNC_OFFSET=0
    326 	#
    327 	$apply_vnc_offset = $ENV{CONNECT_SWITCH_APPLY_VNC_OFFSET};
    328 }
    329 if (exists $ENV{CONNECT_SWITCH_VNC_OFFSET}) {
    330 	#
    331 	# E.g. CONNECT_SWITCH_VNC_OFFSET=6000
    332 	#
    333 	$vnc_offset = $ENV{CONNECT_SWITCH_VNC_OFFSET};
    334 }
    335 
    336 # Set to 1 or higher for more info output:
    337 #
    338 my $verbose = 0;
    339 
    340 if (exists $ENV{CONNECT_SWITCH_VERBOSE}) {
    341 	#
    342 	# E.g. CONNECT_SWITCH_VERBOSE=1
    343 	#
    344 	$verbose = $ENV{CONNECT_SWITCH_VERBOSE};
    345 }
    346 
    347 # zero means loop forever, positive value means exit after handling that
    348 # many connections.
    349 #
    350 my $cmax = 0;
    351 if (exists $ENV{CONNECT_SWITCH_MAX_CONNECTIONS}) {
    352 	$cmax = $ENV{CONNECT_SWITCH_MAX_CONNECTIONS};
    353 }
    354 
    355 
    356 #===========================================================================
    357 #  No need for any changes below here.
    358 #===========================================================================
    359 
    360 use IO::Socket::INET;
    361 use strict;
    362 use warnings;
    363 
    364 # Test for INET6 support:
    365 #
    366 my $have_inet6 = 0;
    367 eval "use IO::Socket::INET6;";
    368 $have_inet6 = 1 if $@ eq "";
    369 
    370 my $killpid = 1;
    371 
    372 setpgrp(0, 0);
    373 
    374 if (exists $ENV{CONNECT_SWITCH_LISTEN_IPV6}) {
    375 	# note we leave out LocalAddr.
    376 	my $cmd = '
    377 		$listen_sock = IO::Socket::INET6->new(
    378 			Listen    => 10,
    379 			LocalPort => $listen_port,
    380 			ReuseAddr => 1,
    381 			Domain    => AF_INET6,
    382 			Proto     => "tcp"
    383 		);
    384 	';
    385 	eval $cmd;
    386 	die "$@\n" if $@;
    387 } else {
    388 	$listen_sock = IO::Socket::INET->new(
    389 		Listen    => 10,
    390 		LocalAddr => $listen_host,
    391 		LocalPort => $listen_port,
    392 		ReuseAddr => 1,
    393 		Proto     => "tcp"
    394 	);
    395 }
    396 
    397 if (! $listen_sock) {
    398 	die "connect_switch: $!\n";
    399 }
    400 
    401 my $current_fh1 = '';
    402 my $current_fh2 = '';
    403 
    404 my $conn = 0;
    405 
    406 while (1) {
    407 	$conn++;
    408 	if ($cmax > 0 && $conn > $cmax) {
    409 		print STDERR "last connection ($cmax)\n" if $verbose; 
    410 		last;
    411 	}
    412 	print STDERR "listening for connection: $conn\n" if $verbose; 
    413 	my ($client, $ip) = $listen_sock->accept();
    414 	if (! $client) {
    415 		fsleep(0.5);
    416 		next;
    417 	}
    418 	print STDERR "conn: $conn -- ", $client->peerhost(), " at ", scalar(localtime), "\n" if $verbose;
    419 
    420 	my $pid = fork();
    421 	if (! defined $pid) {
    422 		die "connect_switch: $!\n";
    423 	} elsif ($pid) {
    424 		wait;
    425 		next;
    426 	} else {
    427 		close $listen_sock;
    428 		if (fork) {
    429 			exit 0;
    430 		}
    431 		setpgrp(0, 0);
    432 		handle_conn($client);
    433 	}
    434 }
    435 
    436 exit 0;
    437 
    438 sub handle_conn {
    439 	my $client = shift;
    440 
    441 	my $start = time();
    442 
    443 	my @allow = @allowed;
    444 
    445 	# read allow file.  Note we read it for every connection
    446 	# to allow the admin to modify it w/o restarting us.
    447 	# better way would be to read in parent and check mtime.
    448 	#
    449 	if ($allow_file && -f $allow_file) {
    450 		if (open(ALLOW, "<$allow_file")) {
    451 			while (<ALLOW>) {
    452 				next if /^\s*#/;
    453 				next if /^\s*$/;
    454 				chomp;
    455 				my ($host, $dpy) = split(' ', $_); 
    456 				next if ! defined $host;
    457 				next if ! defined $dpy;
    458 				if ($dpy < 0) {
    459 					$dpy = -$dpy;
    460 				} elsif ($apply_vnc_offset) {
    461 					$dpy += $vnc_offset if $dpy < 200;
    462 				}
    463 				push @allow, "$host:$dpy";
    464 			}
    465 			close(ALLOW);
    466 		} else {
    467 			warn "$allow_file: $!\n";
    468 		}
    469 	}
    470 
    471 	# Read the first 7 bytes of connection, see if it is 'CONNECT'
    472 	#
    473 	my $str = '';
    474 	my $N = 0;
    475 	my $isconn = 1;
    476 	for (my $i = 0; $i < 7; $i++) {
    477 		my $b;
    478 		sysread($client, $b, 1);
    479 		$str .= $b;
    480 		$N++;
    481 		print STDERR "read: '$str'\n" if $verbose > 1;
    482 		my $cstr = substr('CONNECT', 0, $i+1);
    483 		if ($str ne $cstr) {
    484 			$isconn = 0;
    485 			last;
    486 		}
    487 	}
    488 
    489 	my $sock = '';
    490 
    491 	if ($isconn) {
    492 		# it is CONNECT, read rest of HTTP header:
    493 		#
    494 		while ($str !~ /\r\n\r\n/) {
    495 			my $b;
    496 			sysread($client, $b, 1);
    497 			$str .= $b;
    498 		}
    499 		print STDERR "read:  $str\n" if $verbose > 1;
    500 
    501 		# get http version and host:port
    502 		#
    503 		my $ok = 0;
    504 		my $hostport = '';
    505 		my $http_vers = '1.0';
    506 		if ($str =~ /^CONNECT\s+(\S+)\s+HTTP\/(\S+)/) {
    507 			$hostport = $1;
    508 			$http_vers = $2;
    509 			my $h = '';
    510 			my $p = '';
    511 
    512 			if ($hostport =~ /^(.*):(\d+)$/) {
    513 				($h, $p) = ($1, $2);
    514 			}
    515 			if ($p =~ /^\d+$/) {
    516 				# check allowed host list:
    517 				foreach my $hp (@allow) {
    518 					if ($hp eq 'ALL') {
    519 						$ok = 1;
    520 					}
    521 					if ($hp eq $hostport) {
    522 						$ok = 1;
    523 					}
    524 					if ($hp =~ /^(.*):(\d+)-(\d+)$/) {
    525 						my $ahost = $1;
    526 						my $pmin  = $2;
    527 						my $pmax  = $3;
    528 						if ($h eq $ahost) {
    529 							if ($p >= $pmin && $p <= $pmax) {
    530 								$ok = 1;
    531 							}
    532 						}
    533 					}
    534 					last if $ok;
    535 				}
    536 			}
    537 		}
    538 
    539 		my $msg_1 = "HTTP/$http_vers 200 Connection Established\r\n"
    540 		     . "Proxy-agent: connect_switch v0.2\r\n\r\n";
    541 		my $msg_2 = "HTTP/$http_vers 502 Bad Gateway\r\n"
    542 			     . "Connection: close\r\n\r\n";
    543 
    544 		if (! $ok) {
    545 			# disallowed. drop with message.
    546 			#
    547 			syswrite($client, $msg_2, length($msg_2));
    548 			close $client;
    549 			exit 0;
    550 		}
    551 
    552 		my $host = '';
    553 		my $port = '';
    554 
    555 		if ($hostport =~ /^(.*):(\d+)$/) {
    556 			($host, $port) = ($1, $2);
    557 		}
    558 
    559 		print STDERR "connecting to: $host:$port\n" if $verbose;
    560 
    561 		$sock = IO::Socket::INET->new(
    562 			PeerAddr => $host,
    563 			PeerPort => $port,
    564 			Proto => "tcp"
    565 		);
    566 		print STDERR "connect to host='$host' port='$port' failed: $!\n" if !$sock;
    567 		if (! $sock && $have_inet6) {
    568 			eval {$sock = IO::Socket::INET6->new(
    569 				PeerAddr => $host,
    570 				PeerPort => $port,
    571 				Proto => "tcp"
    572 			);};
    573 			print STDERR "connect to host='$host' port='$port' failed: $! (ipv6)\n" if !$sock;
    574 		}
    575 		my $msg;
    576 
    577 		# send the connect proxy reply:
    578 		#
    579 		if ($sock) {
    580 			$msg = $msg_1;
    581 		} else {
    582 			$msg = $msg_2;
    583 		}
    584 		syswrite($client, $msg, length($msg));
    585 		$str = '';
    586 	} else {
    587 		# otherwise, redirect to apache for normal https:
    588 		#
    589 		print STDERR "connecting to: $httpd_host:$httpd_port\n" if $verbose;
    590 		$sock = IO::Socket::INET->new(
    591 			PeerAddr => $httpd_host,
    592 			PeerPort => $httpd_port,
    593 			Proto => "tcp"
    594 		);
    595 		if (! $sock && $have_inet6) {
    596 			eval {$sock = IO::Socket::INET6->new(
    597 				PeerAddr => $httpd_host,
    598 				PeerPort => $httpd_port,
    599 				Proto => "tcp"
    600 			);};
    601 		}
    602 	}
    603 
    604 	if (! $sock) {
    605 		close $client;
    606 		die "connect_switch: $!\n";
    607 	}
    608 
    609 	# get ready for xfer phase:
    610 	#
    611 	$current_fh1 = $client;
    612 	$current_fh2 = $sock;
    613 
    614 	$SIG{TERM} = sub {print STDERR "got sigterm\[$$]\n" if $verbose; close $current_fh1; close $current_fh2; exit 0};
    615 
    616 	my $parent = $$;
    617 	if (my $child = fork()) {
    618 		xfer($sock, $client, 'S->C');
    619 		if ($killpid) {
    620 			fsleep(0.5);
    621 			kill 'TERM', $child;
    622 		}
    623 	} else {
    624 		# write those first bytes if not CONNECT:
    625 		#
    626 		if ($str ne '' && $N > 0) {
    627 			syswrite($sock, $str, $N);
    628 		}
    629 		xfer($client, $sock, 'C->S');
    630 		if ($killpid) {
    631 			fsleep(0.75);
    632 			kill 'TERM', $parent;
    633 		}
    634 	}
    635 	if ($verbose > 1) {
    636 		my $dt = time() - $start;
    637 		print STDERR "duration\[$$]: $dt seconds. ", scalar(localtime), "\n";
    638 	}
    639 	exit 0;
    640 }
    641 
    642 sub xfer {
    643 	my($in, $out, $lab) = @_;
    644 	my ($RIN, $WIN, $EIN, $ROUT);
    645 	$RIN = $WIN = $EIN = "";
    646 	$ROUT = "";
    647 	vec($RIN, fileno($in), 1) = 1;
    648 	vec($WIN, fileno($in), 1) = 1;
    649 	$EIN = $RIN | $WIN;
    650 	my $buf;
    651 
    652 	while (1) {
    653 		my $nf = 0;
    654 		while (! $nf) {
    655 			$nf = select($ROUT=$RIN, undef, undef, undef);
    656 		}
    657 		my $len = sysread($in, $buf, $bufsize);
    658 		if (! defined($len)) {
    659 			next if $! =~ /^Interrupted/;
    660 			print STDERR "connect_switch\[$lab/$conn/$$]: $!\n";
    661 			last;
    662 		} elsif ($len == 0) {
    663 			print STDERR "connect_switch\[$lab/$conn/$$]: "
    664 			    . "Input is EOF.\n";
    665 			last;
    666 		}
    667 
    668 		if (0) {
    669 			# very verbose debugging of data:
    670 			syswrite(STDERR , "\n$lab: ", 6);
    671 			syswrite(STDERR , $buf, $len);
    672 		}
    673 
    674 		my $offset = 0;
    675 		my $quit = 0;
    676 		while ($len) {
    677 			my $written = syswrite($out, $buf, $len, $offset);
    678 			if (! defined $written) {
    679 				print STDERR "connect_switch\[$lab/$conn/$$]: "
    680 				    . "Output is EOF. $!\n";
    681 				$quit = 1;
    682 				last;
    683 			}
    684 			$len -= $written;
    685 			$offset += $written;
    686 		}
    687 		last if $quit;
    688 	}
    689 	close($in);
    690 	close($out);
    691 }
    692 
    693 sub fsleep {
    694 	my ($time) = @_;
    695 	select(undef, undef, undef, $time) if $time;
    696 }
    697