#!/usr/bin/env perl
# $Id: ttyowner.pl,v 1.11 2012/10/19 20:15:04 ksb Exp $
# $Source: /usr/msrc/usr/local/libexec/jacket/RCS/ttyowner.pl,v $
#
# Use ttyname to get the owner of the current session (order: in, err, out),
# if it doesn't match $TTYOWNER fail the escalation (77).
# Used to fail when this process has already been escalated.
# For exmaple if you become "oracle" you can't use rules that let
# a real login of oracle (on a tty) do some things (like backups).
#
# May be a helmet or a jacket, as a matter of fact.			(ksb)
use strict;
use Getopt::Std;
use POSIX qw(ttyname);
# 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,.*/,,;
my($Reveal) = 'TTYOWNER_REVEAL';
my($WarnEnv) = 'TTYOWNER_WARN';
my($Warning) = 'Incorrect session owner.';

$ENV{'PATH'} = "/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:j:m:R:C:", \%opts);

if ($opts{'V'}) {
	print "$progname: ", '$Id: ttyowner.pl,v 1.11 2012/10/19 20:15:04 ksb Exp $', "\n",
		"$progname: config: TTYOWNER, $Reveal, $WarnEnv\n";
	exit 0;
}

if ($opts{'h'}) {
	print	"$usage\n",
		"$progname: usage -h\n",
		"$progname: usage -V\n",
		"P pid       process that we jacket",
		"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 "$progname: assure client user's tty is owned by uid\n",
	"TTYOWNER         the required login (uid) for the controlling tty\n",
	"TTYOWNER_REVEAL  the standard reveal feature\n",
	"$WarnEnv    failure message (default: $Warning)\n";
	exit 0;
}
if (exists $ENV{$WarnEnv} && $ENV{$WarnEnv} =~ m/.*/) {
	$Warning = $ENV{$WarnEnv};
	print "-$WarnEnv\n";	# remove from the access process
}

my($tty) = POSIX::ttyname(0) || POSIX::ttyname(2) || POSIX::ttyname(1);
if (!$tty) {
	print STDERR "$progname: not a tty, cannot confirm session owner\n";
	print "67\n" if $opts{'P'};
	exit 67;
}

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/^([^:]*):([^:]*)$/o) {
	print STDERR "$progname: euid:egid $ARGV[2] missing colon\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;
}


# Look up the tty's uid for the check.
my($tty_uid);
(undef,undef,undef,undef,$tty_uid,undef,undef,undef,
	undef,undef,undef,undef,undef) = stat($tty);
if (!$tty_uid) {
	print STDERR "$progname: stat: $tty: $!\n";
	print "65\n" if $opts{'P'};
	exit 65;
}

# Look up the required owner|uid from the environment parameter
my($tty_owner) = undef;
if (!exists $ENV{'TTYOWNER'}) {
	$tty_owner = $<;
} elsif ($ENV{'TTYOWNER'} =~ m/^(\d+)$/o) {
	$tty_owner = $1;
} elsif ($ENV{'TTYOWNER'} =~ m/^([^ :]+)$/o) {
	my($temp) = $1;
	(undef, undef, $tty_owner, undef, undef, undef, undef, undef) = getpwnam($temp);
	if (!defined($tty_owner)) {
		print STDERR "$progname: getpwuid: $temp: $!\n";
		print "66\n" if $opts{'P'};
		exit 66;
	}
} else {
	print STDERR "$progname: TTYOWNER is not a valid specification\n";
	print "65\n" if $opts{'P'};
	exit 65;
}
print "-TTYOWNER\n";	# remove our parameter from the access process.

# Check for the access we need.
if ($tty_owner != $tty_uid) {
	print "# $progname $tty_owner != $tty_uid for $tty\n";
	print STDERR "$Warning\n" if ('' ne $Warning);;
	print "77\n" if $opts{'P'};
	exit 77;
}

print "# ttyowner for $tty passes, uid=$tty_owner\n";
if (! $opts{'P'}) {
	exit 0;
}

if (exists $ENV{$Reveal}) {
	print "-$Reveal\n~$ENV{$Reveal}\n";
}

my($kid, $status);
open STDOUT, ">/dev/null";
$kid = waitpid $opts{'P'}, 0;
$status = $? < 256 ? $? : ($? >> 8);

# Exit with her exit code.
exit $status;