#!/usr/bin/env perl
# $Id: msrcmux.pl,v 1.8 2012/08/16 22:17:35 ksb Exp $
# Send a platform copy of a msrc directory to a tcpmux client as	(ksb)
# a tar file.  This service does the mmsrc build locally (-l),  then
# sends the whole directory to the client in tar format.  This is not
# encrypted, signed, or sealed.  If you want more of that stuff, use
# this as an outline of what you need to so.

use Getopt::Std;
use Socket;
use IO::Socket;
use IO::Handle qw(autoflush);
use strict;
use File::Temp qw/ mkdtemp /;

my($progname, %opts, $defConfig, $Xconfig, $Zconfig, $bin, $hxmd_dir);
$progname = $0;
$progname =~ s/.*\///;
getopts("VhdMxC:E:L:R:X:Z:", \%opts);
if (exists $opts{'C'} and $opts{'C'} =~ m/(.*)/o) {
	$defConfig = $1;
} else {
	$defConfig = 'auto.cf';		# local site policy, change me
}
my(@config_list) = ();
if (exists $opts{'X'} and $opts{'X'} =~ m/(.*)/o) {
	push @config_list, "-X$1";
}
if (exists $opts{'Z'} and $opts{'Z'} =~ m/(.*)/o) {
	push @config_list, "-Z$1";
}
if (exists $opts{'L'} and $opts{'L'} =~ m/(.*)/o) {
	$ENV{HXMD_LIB} = $1;
} else {
	$ENV{HXMD_LIB} = '.:/usr/local/lib/hxmd:/usr/local/lib/distrib:/usr/local/lib/msrcmux';
}
if (exists $opts{'E'} and $opts{'E'} =~ m/(.*)/o) {
	$bin = $1;
} else {
	$bin = '/usr/local/sbin/mmsrc';
}
my($msrc_root) = '/usr/msrc';
# Pull off the optional msrc root directory, default to above
if (defined($ARGV[0]) and $ARGV[0] =~ m!^(/.*)$!o) {
	$msrc_root = $1;
	shift @ARGV;
}

if ($opts{'V'}) {
	print "$progname: ", '$Id: msrcmux.pl,v 1.8 2012/08/16 22:17:35 ksb Exp $', "\n",
		"$progname: msrc_root=$msrc_root\n";
	print "$progname: environment: ", join(', ', @ARGV), "\n" if (0 != scalar(@ARGV));
	exit 0;
}

if ($opts{'h'}) {
	print "$progname: [-xM] [-C configs] [-E mmsrc] [-L hxmd-libs] [-R reverse] [msrc-root] [env=value]\n",
		"$progname: usage -h\n",
		"$progname: usage -V\n",
		#"d             debug on a terminal, use with -x to debug\n",
		"C configs     config when `.' requested, else \"$defConfig\"\n",
		"E mmsrc       the path to mmsrc, else `$bin'\n",
		"h             show this help message\n",
		"L hxmd-lib    set an explicit \$HXMD_LIB\n",
		"M             radiate less information in client replies\n",
		"R reverse     mk rule file to reverse IP addresses\n",
		"V             show only version information\n",
		"x             send trace information to stderr\n",
		"X ex-config   as in mmsrc\n",
		"Z zero-config as in mmsrc\n",
		"msrc-root     local master repository, else \"$msrc_root\"\n",
		"env=value     add to the process environment\n";
	exit 0;
}

autoflush STDOUT 1;

foreach my $e (@ARGV) {
	next unless ($e =~ m/(\w+)=(.*)/o);
	$ENV{$1} = $2;
}

my($mask) = "-no\r\n";	# -M mask for informational failure messages
my($host) = 'localhost';
my($remoteIP) = '127.0.0.1';
my($peer_name) = undef;
if ($opts{'d'}) {
	# Undocumented -dx: debug with a terminal session --ksb
} elsif (defined($peer_name = getpeername(STDIN))) {
	my($port, $inaddr) = sockaddr_in($peer_name);
	my(@hostent) = gethostbyaddr($inaddr, AF_INET);
	# ($name,$aliases,$addrtype,$length,@addrs)
	if (!defined($host = $hostent[0])) {
		$host = '@';
	}
	$remoteIP = inet_ntoa($inaddr);
} else {
	print $opts{'M'} ? $mask : "-getpeername hates you\r\n";
	exit 0;
}

# read the requests from client
sub Line(@)
{
	my($error) = shift;
	my($in, $c);
	$in = '';
	while (0 != read(STDIN, $c, 1)) {
		if ("\n" eq $c) {
			$in =~ s/\r$//o;
			print STDERR "$in\n" if $opts{'x'};
			return $in;
		}
		$in .= $c;
	}
	print "-end of input $error\r\n";
	exit 0;
}

# Read the directory and the configuration file, we only pull for
# the reverse of the connect client's source IP.
print $opts{'M'} ? "+Go\r\n" : "+directory\r\n";
my($msrc_dir) = Line("msrc dir");
if ($msrc_dir =~ m|^[.][.]/|o || $msrc_dir =~ m|/[.][.]|o) {
	print $opts{'M'} ? $mask : "-service rejects dot-dot in directory path\r\n";
	exit 0;
}
if ($msrc_dir !~ m/^([^\n\r]*)$/o) {
	print $opts{'M'} ? $mask : "-service rejects newlines in directory path\r\n";
	exit 0;
}
$msrc_dir = "$msrc_root/$1";

if (! chdir($msrc_dir)) {
	print $opts{'M'} ? $mask : "-chdir $msrc_dir: $!\r\n";
	exit 0;
}
print $opts{'M'} ? "+ok\r\n" : "+configuration\r\n";

my($config) = Line("config file");
if ($config =~ m|^[.][.]/|o || $config =~ m|/[.][.]/|o) {
	print $opts{'M'} ? $mask : "-service rejects dot-dot in configuration filename\r\n";
	exit 0;
}
# A literal dot (.) lets the server default the configuration file
if ($config =~ m/^\.$/o) {
	$config = $defConfig;
} elsif ($config =~ m/^([^"`\$\\]*)$/o) {
	$config = "$1";
} else {
	print $opts{'M'} ? "-fail\r\n" : "-name rejected (meta characters)\r\n";
	exit 0;
}
if ($config =~ m|^/|o and ! -f "$config") {
	print $opts{'M'} ? $mask : "-config: $config: does not exist\r\n";
	exit 0;
}
push @config_list, "-C$config";

# Spiff up the environment for -T/-R, just in case.  If we set a path
# where the first component is not absolute we replace it.
if ($ENV{PATH} =~ m|^(/.*)(:?)$|o) {
	$ENV{PATH} = "$1:/usr/local/sbin:/usr/local/bin$2";
} else {
	$ENV{PATH} = "/usr/bin:/usr/local/sbin:/usr/local/bin:/bin";
}
$ENV{SHELL} = '/bin/sh';
delete $ENV{ENV};
umask 0077;		# Same as the inetd default, actually.

# The -R file must map a hostname (marker) + IP (submarker) to the correct
# name in the given configuration file ($CONFIG).  If the reverse filename
# is '.' map it to the configuration file.  This is a minor issue if the
# client might have access to build a configuration file with an embedded
# marked line "# $hostname(IP): arbitrary-command"		--ksb
my($reverse) = $opts{'R'};
if (defined($reverse)) {
	my($mapped);
	$reverse = $config if ('.' eq $reverse);
	$mapped = `mk -sl0 "-m$host" "-d$remoteIP" "-DCONFIG=$config" "$reverse"`;
	chomp($mapped);
	if (0 != $? || '' eq $mapped || $mapped =~ m/\s/o) {
		print $opts{'M'} ? $mask : "-config: $config: $host($remoteIP): no such host ($?)\r\n";
		exit 0;
	}
	$host = $mapped;
}

my($tmpdir) = mkdtemp('/tmp/mMxTXXXXXX');
if (!defined($tmpdir)) {
	print "-$progname: no temporary space\r\n";
	exit 73;	# CANTCREAT
}

# ready to rock, show any errors from mmsrc to the client
open(STDERR, ">&1");
my(@cmd) = ($bin, "-yINTO=$tmpdir", "-lDHOST=$host", @config_list, "--",
	"tar", "cf", "-", ".");
print $opts{'M'} ? "+mmsrc\r\n" : '+'.join(' ', @cmd, "\r\n");
if (-1 == system @cmd) {
	print $opts{'M'} ? $mask : "-$cmd[0]: $!\r\n";
}

# cleanup the cache we made
exec "/bin/rm", "-rf", "$tmpdir";
exit 72;	# /bin/rm is a missing os file?