Add a TCP proxy, forwarding TCP connections to experimental nodes.

configure

@@ -702,6 +702,7 @@ DIG
 ELVIN_CONFIG
 JAVAC
 JAR
+NC
 SUDO
 UUIDGEN
 SSH
@@ -4603,6 +4604,46 @@ $as_echo "no" >&6; }
 fi
 
 
+# Extract the first word of "nc", so it can be a program name with args.
+set dummy nc; ac_word=$2
+{ $as_echo "$as_me:$LINENO: checking for $ac_word" >&5
+$as_echo_n "checking for $ac_word... " >&6; }
+if test "${ac_cv_path_NC+set}" = set; then
+  $as_echo_n "(cached) " >&6
+else
+  case $NC in
+  [\\/]* | ?:[\\/]*)
+  ac_cv_path_NC="$NC" # Let the user override the test with a path.
+  ;;
+  *)
+  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR
+for as_dir in $PATH
+do
+  IFS=$as_save_IFS
+  test -z "$as_dir" && as_dir=.
+  for ac_exec_ext in '' $ac_executable_extensions; do
+  if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+    ac_cv_path_NC="$as_dir/$ac_word$ac_exec_ext"
+    $as_echo "$as_me:$LINENO: found $as_dir/$ac_word$ac_exec_ext" >&5
+    break 2
+  fi
+done
+done
+IFS=$as_save_IFS
+
+  ;;
+esac
+fi
+NC=$ac_cv_path_NC
+if test -n "$NC"; then
+  { $as_echo "$as_me:$LINENO: result: $NC" >&5
+$as_echo "$NC" >&6; }
+else
+  { $as_echo "$as_me:$LINENO: result: no" >&5
+$as_echo "no" >&6; }
+fi
+
+
 # Extract the first word of "sudo", so it can be a program name with args.
 set dummy sudo; ac_word=$2
 { $as_echo "$as_me:$LINENO: checking for $ac_word" >&5
@@ -7470,7 +7511,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
 	utils/spewconlog utils/xlogin \
 	utils/opsdb_control utils/opsdb_control.proxy \
 	utils/remove_old_www utils/epmodeset \
-	utils/mkblob utils/rmblob utils/ctrladdr \
+	utils/mkblob utils/rmblob utils/ctrladdr utils/tcppd \
 	www/GNUmakefile www/defs.php3 www/dbdefs.php3 www/xmlrpc.php3 \
 	www/xmlrpcpipe.php3 \
 	www/swish.conf www/websearch \

configure.in

@@ -107,6 +107,7 @@ AC_PATH_PROG(DIG,dig)
 AC_PATH_PROG(ELVIN_CONFIG,elvin-config)
 AC_PATH_PROG(JAVAC,javac)
 AC_PATH_PROG(JAR,jar)
+AC_PATH_PROG(NC,nc)
 AC_PATH_PROG(SUDO,sudo)
 AC_PATH_PROG(UUIDGEN,uuidgen)
 
@@ -1105,6 +1106,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
 	tbsetup/libArchive.pm tbsetup/archive_control \
 	tbsetup/tarfiles_setup \
 	tbsetup/fetchtar.proxy tbsetup/webfrisbeekiller \
+	tbsetup/tcpp \
 	tbsetup/plab/GNUmakefile tbsetup/plab/libplab.py \
         tbsetup/plab/mod_dslice.py tbsetup/plab/mod_PLC.py \
         tbsetup/plab/mod_PLCNM.py \
@@ -1137,7 +1139,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
 	utils/spewconlog utils/xlogin \
 	utils/opsdb_control utils/opsdb_control.proxy \
 	utils/remove_old_www utils/epmodeset \
-	utils/mkblob utils/rmblob utils/ctrladdr \
+	utils/mkblob utils/rmblob utils/ctrladdr utils/tcppd \
 	www/GNUmakefile www/defs.php3 www/dbdefs.php3 www/xmlrpc.php3 \
 	www/xmlrpcpipe.php3 \
 	www/swish.conf www/websearch \

tbsetup/GNUmakefile.in

@@ -63,7 +63,7 @@ SBIN_STUFF	= resetvlans console_setup.proxy sched_reload named_setup \
 		  elabinelab snmpit.proxy panic node_attributes \
 		  nfstrace plabinelab smbpasswd_setup smbpasswd_setup.proxy \
 		  rmproj snmpit.proxynew snmpit.proxyv2 pool_daemon \
-		  checknodes_daemon snmpit.proxyv3 image_setup
+		  checknodes_daemon snmpit.proxyv3 image_setup tcpp
 
 ifeq ($(ISMAINSITE),1)
 SBIN_STUFF     += repos_daemon

tbsetup/tbswap.in

@@ -64,6 +64,7 @@ my $wrapper        = "$TBROOT/libexec/assign_wrapper";
 my $SNMPIT	   = "$TBROOT/bin/snmpit";
 my $IMAGESETUP     = "$TBROOT/sbin/image_setup";
 my $portstats	   = "$TBROOT/bin/portstats";
+my $TCPP           = "$TBROOT/sbin/tcpp";
 my $NFSTRACESUPPORT= @NFSTRACESUPPORT@;
 my $PGENISUPPORT   = @PROTOGENI_SUPPORT@;
 
@@ -544,6 +545,16 @@ sub doSwapout($) {
 	    }
 	}
 
+	#
+	# Tear down TCP proxies.
+	#
+	if( $type != MODIFY ) {
+	    print "Closing TCP proxy ports...\n";
+	    if( system( "$TCPP -d $pid $eid" ) != 0 ) {
+		tbwarn( "TCP proxy setup failed!" );
+	    }
+	}
+
 	#
 	# Grab our per-experiment switch stack name.
 	#
@@ -1680,6 +1691,17 @@ sub doSwapin($) {
 	}
     }
 
+    #
+    # Establish TCP proxies where necessary.
+    #
+    if( !$elabinelab && ($type == REAL || $type == MODIFY ) ) {
+	print "Establishing proxy TCP ports...\n";
+	if( system( "$TCPP -a $pid $eid" ) != 0 ) {
+	    # Not a fatal error... things can come up with incomplete proxying.
+	    tbwarn( "TCP proxy setup failed!" );
+	}
+    }
+
     #
     # ElabinElab setup. This might not be the right place for this!
     #

tbsetup/tcpp.in

+#!/usr/bin/perl -wT
+
+#
+# Copyright (c) 2012 University of Utah and the Flux Group.
+# 
+# {{{EMULAB-LICENSE
+# 
+# This file is part of the Emulab network testbed software.
+# 
+# This file is free software: you can redistribute it and/or modify it
+# under the terms of the GNU Affero General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+# 
+# This file is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
+# License for more details.
+# 
+# You should have received a copy of the GNU Affero General Public License
+# along with this file.  If not, see <http://www.gnu.org/licenses/>.
+# 
+# }}}
+#
+
+use English;
+use Getopt::Std;
+use IO::Socket::INET;
+
+#
+# Control TCP proxy ports for an entire experiment.
+#
+sub usage()
+{
+    print STDOUT "Usage: tcpp [-a] [-d] <pid> <eid>\n";
+    exit(-1);
+}
+my  $optlist = "ad";
+
+#
+# Configure variables
+#
+my $TB		= "@prefix@";
+my $PORT        = 4127;
+
+my $add         = 0;
+my $delete      = 0;
+
+#
+# Load the Testbed support stuff. 
+#
+use lib "@prefix@/lib";
+use libdb;
+use libtestbed;
+use libtblog;
+use Experiment;
+use Interface;
+use Node;
+
+# un-taint path
+$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+# Turn off line buffering on output
+$| = 1; 
+
+#
+# Parse command arguments. Once we return from getopts, all that should be
+# left are the required arguments.
+#
+%options = ();
+if (! getopts($optlist, \%options)) {
+    usage();
+}
+if (@ARGV < 2) {
+    usage();
+}
+if (defined($options{"a"})) {
+    $add = 1;
+}
+if (defined($options{"d"})) {
+    $delete = 1;
+}
+
+my $pid   = shift(@ARGV);
+my $eid   = shift(@ARGV);
+
+#
+# Untaint the arguments.
+#
+if ($pid =~ /^([-\@\w]+)$/) {
+    $pid = $1;
+}
+else {
+    die("*** Bad data in pid: $pid\n");
+}	
+if ($eid =~ /^([-\@\w]+)$/) {
+    $eid = $1;
+}
+else {
+    die("*** Bad data in eid: $eid\n");
+}
+
+my $experiment = Experiment->Lookup( $pid, $eid );
+if( !defined( $experiment ) ) {
+    tbdie( "Could not locate experiment $pid/$eid" );
+}
+
+my $control = new IO::Socket::INET( PeerHost => '127.0.0.1',
+				    PeerPort => "$PORT", Proto => 'tcp' )
+    or die "socket: $!\n";
+
+if( !$add && !$delete ) {
+    die( "Nothing to do (please specify -a or -d)\n" );
+}
+
+#
+# Get the list of nodes in this experiment.
+#
+my @nodes = $experiment->NodeList(1, 1);
+if (! @nodes) {
+    # Silent.
+    exit(0);
+}
+
+foreach my $node (@nodes) {
+    my $nodeobj = Node->Lookup($node);
+    if( !defined( $nodeobj ) ) {
+	tbdie( "Could not look up node $node" );
+    }
+
+    next if( $nodeobj->isremotenode() ||
+	     $nodeobj->isswitch() );
+
+    my $interface = Interface->LookupControl($node);
+    if( !defined( $interface ) ) {
+	tbdie( "Could not resolve control interface for node $node" );
+    }
+
+    my $ctrlip = $interface->IP();
+    if( !defined( $ctrlip ) || $ctrlip eq "" ) {
+	tbdie( "Could not resolve control address for node $node" );
+    }
+
+    if( $add ) {
+	my $result = DBQueryWarn( "SELECT node_id FROM tcp_proxy WHERE " .
+				  "node_id='$node' AND node_ip='$ctrlip' " .
+				  "AND node_port='22';" );
+	# Don't attempt to replace existing proxies -- this gives better
+	# behaviour on swapmod
+	next if( $result && $result->numrows() );
+
+	$control->print( "+$node:$ctrlip:22\n" );
+	my $line = $control->getline();
+	
+	if( !defined( $line ) ) {
+	    tbdie( "Error reading proxy port for $node" );
+	}
+    } else {
+	my $result = DBQueryWarn( "SELECT proxy_port FROM tcp_proxy WHERE " .
+				  "node_id='$node';" );
+	my $proxy_port;
+
+	while( ( $proxy_port ) = $result->fetchrow_array() ) {
+	    $control->print( "-$proxy_port\n" );
+	}
+    }
+}
+
+exit( 0 );

utils/GNUmakefile.in

@@ -48,7 +48,7 @@ SBIN_SCRIPTS	= vlandiff vlansync withadminprivs export_tables cvsupd.pl \
 		  management_iface sharevlan check-shared-bw \
 		  addspecialdevice addspecialiface imagehash clone_image \
 		  addvpubaddr imageinfo ctrladdr image_import \
-		  prereserve_check
+		  prereserve_check tcppd
 
 WEB_SBIN_SCRIPTS= webnewnode webdeletenode webspewconlog webarchive_list \
                   webwanodecheckin webspewimage webdumpdescriptor

utils/tcppd.in

+#!/usr/bin/perl -w
+
+#
+# Copyright (c) 2012 University of Utah and the Flux Group.
+# 
+# {{{EMULAB-LICENSE
+# 
+# This file is part of the Emulab network testbed software.
+# 
+# This file is free software: you can redistribute it and/or modify it
+# under the terms of the GNU Affero General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or (at
+# your option) any later version.
+# 
+# This file is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
+# License for more details.
+# 
+# You should have received a copy of the GNU Affero General Public License
+# along with this file.  If not, see <http://www.gnu.org/licenses/>.
+# 
+# }}}
+#
+
+use English;
+use strict;
+use IO::Select;
+use IO::Socket::INET;
+use POSIX;
+
+#
+# Configure variables
+#
+my $TB			= "@prefix@";
+my $NC                  = "@NC@";
+my $PORT                = 4127;
+
+#
+# Turn off line buffering on output
+#
+$| = 1;
+
+#
+# Untaint the path
+# 
+$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/sbin:/usr/sbin";
+delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
+
+#
+# Testbed Support libraries
+#
+use lib "@prefix@/lib";
+use libdb;
+use libtestbed;
+
+$SIG{CHLD} = 'IGNORE'; # FreeBSD won't create zombies if we ignore SIGCHLD,
+		       # and we don't even try to be portable
+$SIG{PIPE} = 'IGNORE';
+
+# Listen ONLY on loopback interface -- don't accept control connections
+# from remote hosts.
+my $ctrl = new IO::Socket::INET( LocalAddr => '127.0.0.1',
+				 LocalPort => "$PORT", Proto => 'tcp',
+				 Listen => 10, ReuseAddr => 10,
+				 Blocking => 0 )
+    or die "socket: $!\n";
+
+my $readlist = IO::Select->new( $ctrl )
+    or die "select: $!\n";
+
+my $writelist = IO::Select->new()
+    or die "select: $!\n";
+
+my %connections = ();
+my %localport = ();
+
+# Try to match the state in the database as best we can.
+my ( $node_ip, $node_port, $proxy_port );
+my $result = DBQueryWarn( "SELECT node_ip, node_port, proxy_port " .
+			  "FROM tcp_proxy;" );
+while( ( $node_ip, $node_port, $proxy_port ) = $result->fetchrow_array() ) {
+    my $new = new IO::Socket::INET( LocalPort => "$proxy_port", Proto => 'tcp',
+				    Listen => 10, Blocking => 0 );
+
+    if( defined( $new ) ) {
+	$connections{ $new->fileno } = "proxy:$node_ip:$node_port";
+	$localport{ $proxy_port } = $new;
+	$readlist->add( $new );
+    }
+}
+
+while( 1 ) {
+    my ( $readable, $writeable, $except ) =
+	IO::Select->select( $readlist, $writelist, undef )
+	or die "select: $!\n";
+
+    foreach my $reader ( @$readable ) {
+	# Something is readable...
+	if( $reader == $ctrl ) {
+	    # It's the control (listening) port -- accept a new connection.
+	    my $new = $ctrl->accept();
+	    $new->blocking( 0 );
+
+	    $connections{ $new->fileno } = "control";
+
+	    $readlist->add( $new );
+	} elsif( exists( $connections{ $reader->fileno } ) &&
+	    $connections{ $reader->fileno } eq "control" ) {
+	    # We got something on a control connection.
+	    my $line = $reader->getline();
+	    if( defined( $line ) ) {
+		if( $line =~ /^\+([^:]+):([0-9.]+):([0-9]+)/ ) {
+		    # Add a new proxy listener.
+		    my $new = new IO::Socket::INET( Proto => 'tcp',
+						    Listen => 10,
+						    Blocking => 0 );
+
+		    my $port = $new->sockport();
+		    $reader->print( "$port\n" );
+
+		    DBQueryWarn( "REPLACE INTO tcp_proxy SET node_id='$1', " .
+				 "node_ip='$2', node_port='$3', " .
+				 "proxy_port='$port';" );
+
+		    $connections{ $new->fileno } = "proxy:$2:$3";
+		    $localport{ $port } = $new;
+
+		    $readlist->add( $new );
+		} elsif( $line =~ /^-([0-9]+)/ ) {
+		    # Delete a proxy listener.
+
+		    my $port = $1;
+		    my $fd = $localport{ $port };
+
+		    delete( $connections{ $fd } );
+		    delete( $localport{ $port } );
+
+		    $readlist->remove( $fd );
+		    $fd->close();
+
+		    DBQueryWarn( "DELETE FROM tcp_proxy WHERE " .
+				 "proxy_port=$port;" );
+		}
+	    } else {
+		delete( $connections{ $reader->fileno } );
+		$readlist->remove( $reader );
+		$reader->close();
+	    }
+	} elsif( exists( $connections{ $reader->fileno } ) &&
+		 $connections{ $reader->fileno } =~
+		 /^proxy:([0-9.]+):([0-9]+)$/ ) {
+	    # An incoming proxy connect attempt -- accept the connection,
+	    # and fork/exec off a netcat process to do the actual proxying.
+	    # Letting netcat do the job should work well: doing it all
+	    # in our own process would cause all sorts of buffering/flow
+	    # control mess, and forking (but not execing) would clog things
+	    # up with an entire Perl interpreter for each proxy connection
+	    # (and there might be lots).
+
+	    if( !fork() ) {
+		# Child process -- accept the connection, then become
+		# netcat.
+		my $new = $reader->accept();
+	    
+		POSIX::dup2( $new->fileno, 0 );
+		POSIX::dup2( $new->fileno, 1 );
+		POSIX::dup2( $new->fileno, 2 );		
+		$new->close();
+
+		exec( "$NC $1 $2" )
+		    or POSIX::_exit( 1 ); # oh well, we tried.
+	    }
+	}
+    }
+}
+
+exit( 0 );