#!/usr/bin/env perl
# $Id: recvmux.pl,v 1.20 2008/10/30 22:47:44 anderson Exp $
# Service to record incoming files with the host they came from (pv)
# Run from the tcpmux service on this host.

use lib '/usr/local/lib/sac/perl'.join('.', unpack('c*', $^V)),
	'/usr/local/lib/sac';

# We read an mk marked line (really) like:
#  <!-- $Refresh: /home/sac1/sample/bin/diag 'adm4'  $$-->
# to tell us a better name than the source IP to cache the file under.
# We match that with the extra specail R.E. below, or -R.
my($mark) = qr@[-<!/*#\s]*[$][\w]+:\s*[^'"]*['"]([-\w\d.]+)['"]\s*[$][$]@iosx ;

use strict;
use Data::Dumper;
use Getopt::Std;
use Socket;
require 'sysexits.ph';

my($progname, $sockaddr, $addr, @untrusted, $host);
$progname = $0;
$progname =~ s,.*/,,;
my(%opts) = ();
getopts('D:hVMm:R:s:N:', \%opts);
$host = $opts{'N'};
$mark = $opts{'R'} if $opts{'R'};
@untrusted = @ARGV;	# site policy for Bad Girls, add CIDR/notes from ARGV

if ($opts{'h'}) {
	print "$progname: usage [-M] [-D spool] [-m mode] [-N name] [-s subject] untrusted\n",
		"$progname: usage [-h|-V]\n",
		"D spool   directory to store incoming files\n",
		"h         output the standard help message (this one)\n",
		"M         stdin is not a socket\n",
		"m mode    force the mode on the file to this octal mode\n",
		"N name    force the name of the client host\n",
		"R regexp  client file is \$1 from this regular expression match\n",
		"s subject scan out-of-band string for the clients default name\n",
		"V         output our version information\n",
		"untrusted these CIDRs are never allowed any receive access\n";
	exit EX_OK();
}
if ($opts{'V'}) {
	print "$progname: ", '$Id: recvmux.pl,v 1.20 2008/10/30 22:47:44 anderson Exp $', "\n";
	print "$progname: regexp: $mark\n";
	exit EX_OK();
}

# use this with grep to see if an IP is in a CIDR list			(ksb)
sub IpMatch($ $)
{
	my($fixed, $cidr) = @_;
	my($a, $n, $m);
	if ($cidr =~ m!([0-9.]*)/([0-9]*)!m) {
		($n, $m) = (inet_aton($1), $2);
	} else {
		($n, $m) = (inet_aton($cidr), 32);
	}
	$a = inet_aton($fixed);
	$m = 32 if ($m > 32);
	$m = 0 if ($m < 1);
	$m = 32 - $m;
	return ($a >> $m) == ($n >> $m) ? $cidr : undef;
}

if (defined($opts{'s'}) && $opts{'s'} =~ m/$mark/ && '' ne $1) {
	$host ||= $1;
}

$| = 1;
if (! $opts{'M'}) {
	my($badnet);
	if (! ($sockaddr = getpeername(STDIN))) {
		print "-getpeername hates you\r\n";
		exit EX_NOHOST();
	}
	$addr = inet_ntoa((unpack_sockaddr_in($sockaddr))[1]);
	$host ||= $addr;
	($badnet, undef) = grep( { IpMatch($addr, $_) }  @untrusted);
	if (defined($badnet)) {
		print "-$addr not trusted from $badnet\r\n";
		exit EX_NOPERM();
	}
}
my($home, $data);
$home = (getpwuid($<))[7];

if ($opts{'D'}) {
	if ($opts{'D'} =~ m!^/!o) {
		$home = $opts{'D'};
	} else {
		$home .= "/$opts{'D'}";
	}
}
if (! chdir($home) || ! -w '.') {
	print "-can't write to $home\r\n";
	exit EX_NOPERM();
}

# Interact with our new friend
# we expect the first line of data, optionally marked-up hold her filename
print "+Mark\r\n" unless $opts{'M'};
my $first = <STDIN>;
my $visible = $first;
$visible =~ s/[\r\n]*$//o;
if ($visible =~ m/$mark/ && '' ne $1) {
	$host = $1 unless $opts{'N'};
}
$host =~ s/^\.+//o;		# don't write in any dot files, like ".rhosts"
$host =~ s,[^-.\d\w:],_,og;	# our path must be a hostname, IPv4, or IPv6
$host =~ tr/_/_/s;		# compress multiple underscores
$host =~ s/^_(.)/$1/;		# remove leading _ unless it is the last char

if (! open(DATA, ">$host")) {
	print "-open: $host: $!\r\n";
	exit EX_CANTCREAT();
}
print "+Go\r\n" unless $opts{'M'};
print DATA $first;

alarm(180);
while (<STDIN>) {
	print DATA $_;
	alarm(60);
}
close(DATA);
chmod(oct($opts{'m'}), $host) if ($opts{'m'});

exit EX_OK();