#!/usr/bin/perl -w
#
# tcpio - shell level TCP stream access
#	- Cameron Simpson <cs@zip.com.au> 04feb1994
#

require 'flush.pl';
use Getopt::Std;
use cs::Net::TCP;

($::cmd=$0) =~ s:.*/::;
$usage="Usage: $::cmd [-io] [-u user[:group]] [-p localport | -P localport] [-l logbase] host port
	-u user[:group]
		Setuid to the specified user and group.
		In connect mode, do so after connection.
		In accept mode, do so after binding the listening port.
		If group is omitted, use the group with the name of the user.
	-i	Copy in; copy from the connection to stdout.
	-o	Copy out; copy stdin to the connection.
	-p	Bind local end of connection to specified port.
	-P	Bind local end of connection to specified port,
		or the next free one above that.
       $::cmd -a [-io1] [-u user[:group]] [-l logbase] port command [args]
	-a	Accept connections on the given port.
	-1	Accept only the first connection.
	The port may include an \"address:\" prefix to bind to a specific
	local interface.
";

my $badopts=0;

my $localport=0;
my $firstfree=0;
my $logto;
my $accmode=0;
my $onceonly=0;
my $killreader=0;
my $ugid;

my %opt;
getopts('a1iop:P:l:ku:',\%opt) || ($badopts=1);
$accmode=$opt{'a'};
$onceonly=$opt{'1'};
$copyin =($opt{'i'} || !$opt{'o'});
$copyout=($opt{'o'} || !$opt{'i'});
$logto=$opt{'l'} if defined $opt{'l'};
$killreader=1 if defined $opt{'k'};
if ($opt{'p'})		{ $localport=$opt{'p'}; $firstfree=0; }
elsif ($opt{'P'})	{ $localport=$opt{'P'}; $firstfree=1; }
$ugid=$opt{'u'} if defined $opt{'u'};

if ($opt{'p'} && $opt{'P'})	
{ warn "$::cmd: can't use both -p and -P\n";
  $badopts=1;
}

if ($onceonly && !$accmode)
{ warn "$::cmd: can't use -1 without -a\n";
  $badopts=1;
}

if (!$accmode && !defined($host=shift))
{ warn "$::cmd: missing host name\n";
  $badopts=1;
}

if (!defined($port=shift))
{ warn "$::cmd: missing port name\n";
  $badopts=1;
}

my($user,$group);
if (defined $ugid)
{
  if ($ugid =~ /:/)
  { $user=$`; $group=$'; }
  else
  { $user=$ugid; $group=$ugid; }

  if ($user =~ /^\d+$/) { $user=$user+0; }
  else			{ my @pw = getpwnam($user);
			  if (@pw)
			  { $user=$pw[2];
			  }
			  else
			  { warn "$::cmd: can't look up user \"$user\"\n";
			    $badopts=1;
			  }
			}

  if ($group =~ /^\d+$/){ $group=$group+0; }
  else			{ my @gr = getgrnam($group);
			  if (@gr)
			  { $group=$gr[2];
			  }
			  else
			  { warn "$::cmd: can't look up group \"$group\"\n";
			    $badopts=1;
			  }
			}
}

if ($accmode)
{
  if (!@ARGV)
  { warn "$::cmd: missing command\n";
    $badopts=1;
  }
  else
  { @command=@ARGV;
  }
}
else
{ if (@ARGV)
  { warn "$::cmd: extra arguments: @ARGV\n";
    $badopts=1;
  }
}

die $usage if $badopts;

if (defined $logto)
{ open(LOGOUT,">> $logto.out") || die "$::cmd: can't write to $logto.out: $!\n";
  open(LOGIN ,">> $logto.in" ) || die "$::cmd: can't write to $logto.in: $!\n";
}

if ($accmode)
# supply service
{ my $this = new cs::Net::TCP $port;
  die "$::cmd: can't bind to port $port: $!" if ! defined $this;
  if (defined($group) && POSIX::setgid($group) != 0)
  { die "$::cmd: setgid($group): $!";
  }
  if (defined($user) && POSIX::setuid($user) != 0)
  { die "$::cmd: setuid($user): $!";
  }
  $this->Serve(($onceonly ? $cs::Net::TCP::F_ONCE
			  : $cs::Net::TCP::F_FORK|$cs::Net::TCP::F_FORK2),
	       SERVICE);
  # NOTREACHED
  exit 1;
}

# connect to service
$CONN=new cs::Net::TCP ($host,$port,$localport);
die "$::cmd: can't connect to $host:$port: $!\n" if !defined($CONN);

if (defined($group) && !defined(POSIX::setgid($group)))
{ die "$::cmd: setgid($group): $!";
}
if (defined($user) && !defined(POSIX::setuid($user)))
{ die "$::cmd: setuid($user): $!";
}

my $mainpid=$$;
if ($copyin && $copyout)
{ die "$::cmd: can't fork: $!\n" unless defined($pid=fork);
  if ($pid)	{ $copyin=0;  }	# parent, no copyin
  else		{ $copyout=0; } # child, no copyout
}

if ($copyout)
# parent, read stdin
{
  close(STDOUT);
  COPYOUT:
  my $nread;
  while (($nread = sysread(STDIN,$_,8192)) > 0)
  {
    printflush(LOGIN,$_) if defined $logto;
    $CONN->Put($_);
    $CONN->Flush();
  }
  shutdown($CONN->Sink()->{IO},1);
  shutdown(STDIN,0);
  close(LOGIN) if defined $logto;
}
else
# child, copy to stdout
{
  close(STDIN);
  while (defined ($_=$CONN->Read()) && length)
  {
    printflush(LOGOUT,$_) if defined $logto;
    printflush(STDOUT,$_);
  }
  shutdown(STDOUT,1);
  ##::need(cs::Hier);warn "CONN=".cs::Hier::h2a($CONN,1);
  shutdown($CONN->Source()->{IO},0);
  if ($killreader) { kill(15, $mainpid); }
  close(LOGOUT) if defined $logto;
}

exit 0;

#####################################################################

sub SERVICE	# (CONN,peer)
{ my($CONN,$peer)=@_;
  my($OUT)=select;

  close($OUT) || warn "$::cmd: can't close($OUT): $!\n";

  if ($copyin)
  { my $infh = $CONN->SourceHandle();
    open(STDIN,"<&$infh")
	  || die "$::cmd: can't attach stdin to $infh\n";
  }

  if ($copyout)
  { my $outfh = $CONN->SourceHandle();
    open(STDOUT,">&$outfh")
	  || die "$::cmd: can't attach stdout to $outfh\n";
  }

  ## warn "exec(@command)\n";
  exec(@command);
  die "$::cmd: exec(@command): $!\n";
}