#!/usr/bin/env perl
# $Id: Jacket.pl,v 1.11 2012/02/14 21:25:30 ksb Exp $
# $Source: /usr/msrc/usr/local/libexec/jacket/RCS/Jacket.pl,v $
#
# %% the generic jacket template -- replace with you mission %%

use strict;
use Getopt::Std;
# 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,.*/,,;

# Untaint our environment
$ENV{'PATH'} = "/bin:/usr/bin:/usr/local/bin:/usr/openwin/bin:/usr/X11/bin:/usr/X11R6/bin:/usr/local/sbin";
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

# Document the parameters you expect in the rule-provided environment
# $MYSELF_<thing1>	use and consumed or not
# $MYSELF_REVEAL	you need one of these for recursive calls?
my($Reveal) = '%%MYSELF%%_REVEAL';
# $MYSELF_WARN		common error message override


$usage = "$progname: usage -P pid [helmet-opts] -- mnemonic program euid:egid cred_type:cred";
getopts("VhHP:u:g:f:j:m:R:C:", \%opts);

if ($opts{'V'}) {
	print "$progname: ", '$Id: Jacket.pl,v 1.11 2012/02/14 21:25:30 ksb Exp $', "\n";
	# %% -V might output the variables you expect, to be nice %%
	exit 0;
}

if ($opts{'h'}) {
        print   "$usage\n",
                "$progname: usage -h\n",
                "$progname: usage -V\n",
		"P pid       process that we jacket\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 uids\n",
		"cred_type   the credential type that granted access (groups, users, or netgroups)\n",
		"cred        the matching group, login, or netgroup\n";
	exit 0;
}
if ($opts{'H'}) {
	print "%% explain environment parameters %%\n";
	exit 0;
}
# %% might we be a helmet as well ? %%
#if (! $opts{'P'}) {
#	print STDERR "$progname: may only used as a jacket\n";
#	exit 64;
#}

# Untaint our params, common code to most jackets. --ksb
shift @ARGV if (scalar(@ARGV) && $ARGV[0] =~ m/^--$/o);
if (scalar(@ARGV) != 4) {
	print STDERR "$progname: exactly 4 positional parameters required\n";
	print "64\n" if $opts{'P'};
	exit 64;
}
if ($ARGV[0] !~ m|^([-/\@\w.]+)$|o) {
	print STDERR "$progname: mnemonic is zero width, or spelled badly\n";
	print "64\n" if $opts{'P'};
	exit 64;
}
my($MNEMONIC) = $1;
if ($ARGV[1] !~ m|^([-/\@\w.]+)$|o) {
	print STDERR "$progname: program specification looks bogus\n";
	print "64\n" if $opts{'P'};
	exit 64;
}
my($PROGRAM) = $1;
if ($ARGV[2] !~ m/^(\d+):(\d+)$/o) {
	print STDERR "$progname: euid:egid format error (wants digits:digits)\n";
	print "65\n" if $opts{'P'};
	exit 65;
}
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 76;
}

# %% prep after options and params %%
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 67;
}

# 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 if you do that anyway, 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 67;
};


# Modify the escalated process with "~prefix", "-ENV", "$ENV=value", or
# "$ENV=value" here, remove the reveal code if you must.
if (exists $ENV{$Reveal} and $ENV{$Reveal} =~ m/(.*)/o) {
	print "-$Reveal\n~$1\n";
}

print "# %% useful comment(s) to the op process debugger %%\n";
my($kid, $status);
$status = 0;
if ($opts{'P'}) {
	open STDOUT, ">/dev/null";
	$kid = waitpid $opts{'P'}, 0;
	$status = $? < 256 ? $? : ($? >> 8);
	# %% is a signal special to you here? %%
}

# %% cleanup code here, for jackets mostly %%

# Exit with (a function of) her exit code
exit $status;