#!/usr/bin/env perl
# $Id: proxy-agent.pl,v 1.15 2012/10/19 19:58:21 ksb Exp $
# $Source: /usr/msrc/usr/local/libexec/jacket/RCS/proxy-agent.pl,v $
#
# We are a service modules, NOT an authorization module.
#
# Since ssh-agent doesn't like to let other uid/gid's open a connection to
# an agent anymore (they don't believe unix file permission work, I guess) we
# need a proxy that opens the agent as the original login - our real uid {aka.
# $<} and gid {aka. $(} when connected to on a proxy unix domain socket.
# So we diddle SSH_AUTH_SOCK to point to one owned by euid:egid that we
# listen on, when we get a connection we forward it to the original
# auth sock with our real/effective dropped.  Wow, this is silly, ssh-agent
# should just have an option not to feed the crazy.
#
# So the param euid:egid is who should own the new proxy socket
# (owner/group/mode or 600). They can chmod is g+rw, as needed.
# Drop euid to the owner and group of the original socket we are asked to
# proxy.  We think ssh-agent is using getpeereid(3), so it is looking at
# the effective uid/gid not the reals.  Swap back to unlink the proxy socket.
# ZZZ chroot fix --ksb
use strict;
use Getopt::Std;
use IO::Select;
use IO::Socket;
use File::Temp qw/ mkdtemp mktemp /;
use POSIX qw(:sys_wait_h setsid);
require 'sysexits.ph';
require 'sys/signal.ph';
# Auto-flush standard out, we need the child to see it ASAP
select STDERR; $| = 1;
select STDOUT; $| = 1;

my($progname, $usage, %opts);
($progname = $0) =~ s,.*/,,;

$ENV{'PATH'} = "/usr/local/libexec/jacket:/bin:/usr/bin:/usr/local/bin";

$usage = "$progname: usage -P pid [helmet-opts] -- mnemonic program euid:egid cred_type:cred";
getopts("VhHP:u:g:f:R:C:", \%opts);
my($DefTemplate) = '/tmp/sPad-XXXXXX/agent-XXXXXX';

if ($opts{'V'}) {
	print "$progname: ", '$Id: proxy-agent.pl,v 1.15 2012/10/19 19:58:21 ksb Exp $', "\n",
		"$progname: socket template: $DefTemplate\n";
	exit EX_OK();
}

if ($opts{'H'}) {
	print	"$progname: proxy ssh-agent requests to client user\'s agents\n",
		"SPROXY_FROM\tthe socket we will forward (to), else the value of SSH_AUTH_SOCK\n",
		"SPROXY_ENV\tthe name of the environment variable to set\n",
		"SPROXY_TO\tthe absolute path mktemp template for the new proxy socket\n\t\tdefault $DefTemplate\n",
		"SPROXY_REVEAL\tcommon reveal logic\n";
	exit EX_OK();
}
if ($opts{'h'}) {
	print   "$usage\n",
		"$progname: usage -h\n",
		"$progname: usage -V\n",
		"P pid	     process that we must jacket, never a helmet\n",
		"h	     print only this help message\n",
		"V	     show only version info\n",
		"helmet-opts arguments to any op helmet program\n",
		"mnemonic    the requested op mnemonic\n",
		"program     client application\n",
		"euid:egid   target login and group ids\n",
		"cred_type   the credential type that granted access (groups, users, or netgroups)\n",
		"cred	     the matching group, login, or netgroup\n";
	exit EX_OK();
}
if (not $opts{'P'}) {
	print STDERR "$progname: may only used as a jacket\n";
	exit EX_USAGE();
}

# Find the socket to forward, first de-taint the variable name spec.
my($envname) = undef;
if (not exists($ENV{'SPROXY_ENV'})) {
	$envname = 'SSH_AUTH_SOCK';
} elsif ($ENV{'SPROXY_ENV'} =~ m/^([^=]+)$/)  {
	$envname = $1;
	print "-SPROXY_ENV\n";
} else {
	print STDERR "$progname: $ENV{'SPROXY_ENV'}: not a valid environment variable name\n";
	print "78\n" if $opts{'P'};	# EX_CONFIG not every system supports
	exit 78;
}

my($agent_socket) = undef;
if (exists($ENV{$envname}) and $ENV{$envname} =~ m/^(.*)$/o) {
	print "-$envname\n";
	$agent_socket = $1;
} elsif (exists($ENV{'SPROXY_FROM'}) and $ENV{'SPROXY_FROM'} =~ m!(/.*)!o) {
	$agent_socket = $1;
} else {
	print STDERR "$progname: $ENV{'SPROXY_FROM'}: target socket must be an absolute path\n";
	print "78\n" if $opts{'P'};	# EX_CONFIG
	exit 78;
}

# Keep track the the directories we built so we can untmp them, we put them
# in the correct order (deepest first) to make the cleanup below work.
my(@cleanup) = ();
sub UnTmpDirs {
	#print STDERR "untmp: ", join(', ', @cleanup), "\n";
	foreach (@cleanup) {
		rmdir $_;
	}
}

# Untaint our params, common code to most jackets. --ksb
if (defined($ARGV[0]) && $ARGV[0] =~ m/^--$/o) {
	shift @ARGV;
}
if (scalar(@ARGV) != 4) {
	print STDERR "$progname: exactly 4 positional parameters required\n";
	print "64\n" if $opts{'P'};
	exit EX_USAGE();
}
if ($ARGV[0] !~ m|^([-/\@\w.]+)$|o) {
	print STDERR "$progname: mnemonic is zero width, or spelled badly\n";
	print "64\n" if $opts{'P'};
	exit EX_USAGE();
}
my($MNEMONIC) = $1;
if ($ARGV[1] !~ m|^([-/\@\w.]+)$|o) {
	print STDERR "$progname: program specification looks bogus\n";
	print "64\n" if $opts{'P'};
	exit EX_USAGE();
}
my($PROGRAM) = $1;
if ($ARGV[2] !~ m/^([^:]*):([^:]*)$/o) {
	print STDERR "$progname: euid:egid $ARGV[2] missing colon\n";
	print "65\n" if $opts{'P'};
	exit EX_DATAERR();
}
my($EUID, $EGID) = ($1, $2);
if ($ARGV[3] !~ m/^([^:]*):([^:]*)$/o) {
	print STDERR "$progname: cred_type:cred $ARGV[3] missing colon\n";
	print "76\n" if $opts{'P'};
	exit EX_PROTOCOL();
}

my($her_agent) = $DefTemplate;
if (exists $ENV{'SPROXY_TO'} && $ENV{'SPROXY_TO'} =~ m!(/.+)!o) {
	$her_agent = $1;
	print "-SPROXY_TO\n";
}
# We will not build the top level directory with mkdtemp. Sanity works.
$her_agent =~ s!//+!/!g;	# compress out redundant slashes
my($tail, $r);
my(@comps) = split(m!/!, $her_agent);
while ('' eq ($tail = pop(@comps))) {
	;
}

# We will not build the top level directory with mkdtemp, nor will we
# build the chroot either.  Sanity really works.
if (scalar(@comps) < 1) {
	die "$progname: will not build a socket in /\n";
}
if (exists $opts{'R'} && $opts{'R'} =~ m!^(/.+?)/*$!o) {
	$opts{'R'} = $1;
	$her_agent = "$1/".shift @comps;
} else {
	delete $opts{'R'};
	$her_agent = shift @comps;
}
foreach $_ (@comps) {
	$her_agent .= "/$_";
	if ($her_agent !~ m/XX+$/o) {
		if (-d $her_agent) {
			next;
		}
		if (! mkdir($her_agent, 0700)) {
			my($keep) = $!;
			UnTmpDirs();
			die "$progname: mkdir: $her_agent: $keep\n";
		}
		chown $EUID, $EGID, $her_agent;
		unshift(@cleanup, $her_agent);
		next;
	}
	if (!($r = mkdtemp($her_agent))) {
		my($keep) = $!;
		UnTmpDirs();
		die "$progname: mkdtemp: $her_agent: $keep\n";
	}
	$her_agent = $r;
	chown $EUID, $EGID, $her_agent;
	unshift(@cleanup, $her_agent);
}
$her_agent .= "/$tail";
if ($her_agent =~ m!(.*)/([^/]*[X]+)$!o) {
	$r = mktemp($her_agent) or die "$progname: mktemp: $her_agent: $!\n";
	$her_agent = $r;
}

my($our_name, $our_uid, $our_gid, $our_home);
($our_name, undef, $our_uid, $our_gid, undef, undef, undef, $our_home) = getpwuid($<);
if (!$our_home) {
	print STDERR "$progname: getpwuid: $<: $!\n";
	print "67\n" if $opts{'P'};
	exit EX_NOUSER();
}

# We could pass $LOGNAME in the env from op to get the right name in the case
# where more than 1 login has the same uid.  But you are in  trouble when
# you do that in any case, so I'm not going to help you.  --ksb
my($her_uid, $her_gid, $her_name, $her_home);
($her_name, undef, $her_uid, $her_gid, undef, undef, undef, $her_home) = getpwuid($EUID);
defined $her_home or do {
	print STDERR "$progname: getpwuid: $EUID: $!\n";
	print "67\n" if $opts{'P'};
	exit EX_NOUSER();
};
if (exists $ENV{'SPROXY_REVEAL'} && $ENV{'SPROXY_REVEAL'} =~ m/^([^=]+)$/o) {
	print "-SPROXY_REVEAL\n~$1\n";
}

my($kid, $status, $proxy, $host);
my($listen, $client, $remote);
$status = undef;

$listen = IO::Socket::UNIX->new(
	Local => $her_agent,
	Listen => 128		# typical max for 2012, was 20 in 1988
);
if (not $listen) {
	print STDERR "$progname: listen: $her_agent: $!\n";
	exit EX_OSERR();
}
chmod 0600, $her_agent;
chown $EUID, $EGID, $her_agent;

my($sel, @ready, $fh, $buf, $go, $proxpid);
# We just forked the pump, wait for the esclated process to finish, when it
# exits we shoot the pump process to finish clean.  --ksb
if (0 != ($proxpid = fork())) {
	if (-1 == $proxpid) {
		unlink($her_agent);
		UnTmpDirs();
		print "69\n" if $opts{'P'};	# EX_UNAVAILABLE
		exit EX_UNAVAILABLE();
	}
	print "# proxy for $agent_socket is $her_agent, pump pid $proxpid\n";
	print "\$$envname=$her_agent\n";
	close(STDOUT);
	while (0 < ($kid = waitpid(-1, WUNTRACED))) {
		$status = $?;
		if (WIFSTOPPED($status)) {
			#ZZZ kill(SIGSTOP(), $$);
			# we are suspended ^Z/or kill, we came back (fg/bg)
			kill(SIGCONT(), $kid);
			next;
		}
		next if ($opts{'P'} != $kid);
		last;
	}
	kill(SIGTERM(), $proxpid);
	$status = $status < 256 ? $status : $status >> 8 ;
	exit $status;
}
# We do not want to hold the op External input stream open, and we
# do not want to be part of the escalated tasks process group.
open STDOUT, '>/dev/null' unless open STDOUT, '>/dev/tty';
POSIX::setsid();

# Code to pump the data in a child process, each connection is our child
# and we are a child of the original jacket process.  When we stop we do
# _not_ kill the existing pump processes, just stop making new ones.
# There may be a bg job still running.	(ksb)
sub catch_term {
	my $signame = shift;

	$listen->close();
	unlink($her_agent);
	UnTmpDirs();
	exit EX_OK();
}
$SIG{TERM} = \&catch_term;
$SIG{INT} = \&catch_term;
$SIG{HUP} = \&catch_term;

# Accept connections from the other uid, and proxy them to the socket.
# (The code to group connection into fewer processes was too error-prone.)
while ($client = $listen->accept()) {
	while (waitpid(-1, WNOHANG) > 0) {
		# reap any idle forwards (what about stopped kids? LLL)
	}
	# Spin-off the work to a child process, if we can make one.
	while (-1 == ($go = fork())) {
		print STDERR "%s: fork: $! (retry)\n";
		sleep 2;
	}
	if (0 != $go) {
		$client->close();
		next;
	}
	$listen->close();
	$client->autoflush(1);

	# Drop to our real uid.gid, which is the whole point, and connect.
	($<, $>) = ($<, $<);
	($(, $)) = ($(, $();
	$remote = IO::Socket::UNIX->new(
		Peer => $agent_socket
	);
	if (! $remote) {
		print STDERR "$progname: connect: $agent_socket: $!\n";
		exit EX_OSERR();
	}

	$sel = new IO::Select;
	$sel->add($client);
	$sel->add($remote);
	$go = 2;
	while ($go) {
		@ready = $sel->can_read();
		foreach $fh (@ready) {
			if ($fh == $client) {
				sysread($client, $buf, 64*1024, 0);
				if (length($buf) == 0) {
					--$go;
					$remote->shutdown(1);
					$sel->remove($client);
					next;
				}
				send($remote, $buf, 0);
			} elsif ($fh == $remote) {
				sysread($remote, $buf, 64*1024, 0);
				if (length($buf) == 0) {
					--$go;
					$client->shutdown(1);
					$sel->remove($remote);
					next;
				}
				send($client, $buf, 0);
			}
		}
	}
	$client->close();
	$remote->close();
	exit EX_OK();	# child code is ignored anyway
}
# Listen failed, so we are no use to anyone.  Close up shop.
$listen->close();
catch_term();
exit EX_OSERR();	# our exit code is ignored, how sad.