#!/usr/bin/env perl
# $Id: timebox.pl,v 1.12 2012/10/19 20:21:43 ksb Exp $
# $Source: /usr/msrc/usr/local/libexec/jacket/RCS/timebox.pl,v $
#
# Accept a time specification in the environment, only allow access within
# the given range.
# Reads (and deletes) $TIMEBOX which has the form
#	[!]* join(',' , strftime <[=] strftime [<[=] strftime]* )
#
# For example "Any time from midnight up-to-but-not-including 4am" is
#	0000.00<=%H%M.%S<0400.00
#
# We strftime(3) the current clock into each one of the expression buffers,
# then compate the range to allow (or not) the access.  This allows
# months (%m), days (%d), day of month (%e), day of year (%j),
# weeks of year %V/%W or lots of other twisted rules.  We also convert
# English day of week and month names into decimal numbers.

use strict;
use Getopt::Std;
use POSIX qw(strftime);
# 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'} = '/bin:/usr/bin:/usr/local/bin';
$ENV{SHELL} = '/bin/sh' if exists $ENV{SHELL};
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

# $TIMEBOX_REVEAL	std use for recursive calls
# $TIMEBOX_INSIDE	[!]* strftime <[=] strftime [<[=] strftime]
# $TIMEBOX_FORBID	[!]* strftime != strftime
# $TIMEBOX_WARN		optional error message for failure
my($Reveal) = 'TIMEBOX_REVEAL';


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

if ($opts{'V'}) {
	print "$progname: ", '$Id: timebox.pl,v 1.12 2012/10/19 20:21:43 ksb Exp $', "\n";
	print "$progname: TIMEBOX_REVEAL, TIMEBOX_INSIDE, TIMEBOX_FORBID, TIMEBOX_WARN\n";
	exit 0;
}

if ($opts{'h'}) {
        print   "$usage\n",
                "$progname: usage -h\n",
                "$progname: usage -H\n",
                "$progname: usage -V\n",
		"P pid       process that is to be timed\n",
                "h           print only this help message\n",
                "H           print configuration details\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: allow (deny) escalation based on time-of-day\n",
		"TIMEBOX_FORBID   comma separated list of excluded times: [!]*strftime[!=]=strftime\n",
		"TIMEBOX_INSIDE   comma separated list of time relations: [!]strftime(<=?strftime)+;\n",
		"TIMEBOX_REVEAL   remove prefix from environment entries\n",
		"TIMEBOX_WARNING  escalation denied message for the customer ($warning)\n";
	exit 0;
}

# 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;			# 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 64;			# 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 64;			# USAGE
}
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;			# 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 76;			# PROTOCOL
}

my($forbid, $inside) = (undef, undef, undef);
# message to tell the client they cannot have access now
if (exists $ENV{'TIMEBOX_WARN'}) {
	$warning = $ENV{'TIMEBOX_WARN'};
	print "-TIMEBOX_WARN\n";
	delete $ENV{'TIMEBOX_WARN'};
}
if (exists $ENV{'TIMEBOX_FORBID'}) {
	$forbid = $ENV{'TIMEBOX_FORBID'};
	print "-TIMEBOX_FORBID\n";
	delete $ENV{'TIMEBOX_FORBID'};
}
if (exists $ENV{'TIMEBOX_INSIDE'}) {
	$inside = $ENV{'TIMEBOX_INSIDE'};
	print "-TIMEBOX_INSIDE\n";
	delete $ENV{'TIMEBOX_INSIDE'};
}
# Modify the escalated process with "~prefix", "-ENV", "$ENV=value", or
# "$ENV=value" here, remove the reveal code if you must.
if (exists $ENV{$Reveal}) {
	print "-$Reveal\n~$ENV{$Reveal}\n";
	delete $ENV{$Reveal};
}

# Just what you'd think.  Monday => 1, January => 1, etc.
# We follow the strftime convention that Sunday is day 7, not 0 (as in cron)
sub ToNumber($)
{
	my($res) = @_;
	# like strftime's %d
	$res =~ s/January/01/g;
	$res =~ s/February/02/g;
	$res =~ s/March/03/g;
	$res =~ s/April/04/g;
	$res =~ s/May/05/g;
	$res =~ s/June/06/g;
	$res =~ s/July/07/g;
	$res =~ s/August/08/g;
	$res =~ s/September/09/g;
	$res =~ s/October/10/g;
	$res =~ s/November/11/g;
	$res =~ s/December/12/g;
	$res =~ s/Jan/01/g;
	$res =~ s/Feb/02/g;
	$res =~ s/Mar/03/g;
	$res =~ s/Apr/04/g;
	# dupliacte $res =~ s/May/05/g;
	$res =~ s/Jun/06/g;
	$res =~ s/Jul/07/g;
	$res =~ s/Aug/08/g;
	$res =~ s/Sep/09/g;
	$res =~ s/Oct/10/g;
	$res =~ s/Nov/11/g;
	$res =~ s/Dec/12/g;

	# strftime's %u
	$res =~ s/Monday/1/g;
	$res =~ s/Tuesday/2/g;
	$res =~ s/Wednesday/3/g;
	$res =~ s/Thursday/4/g;
	$res =~ s/Friday/5/g;
	$res =~ s/Saturday/6/g;
	$res =~ s/Sunday/7/g;
	$res =~ s/Mon/1/g;
	$res =~ s/Tue/2/g;
	$res =~ s/Wed/3/g;
	$res =~ s/Thu/4/g;
	$res =~ s/Fri/5/g;
	$res =~ s/Sat/6/g;
	$res =~ s/Sun/7/g;

	return $res;
}

# Process the given time comparison operations
#	inside ::= term [, term] *			# or these
#	term ::= [!]* strftime [<[=] strftime] *	# and these
# We must remove leading zeros to prevent octal conversions.
my(@s) = localtime;
my(@l, @r, $access_ok);
$access_ok = 1;
my($cur, $limit);
for $cur (split(m/\s*,\s*/, $inside)) {
	my($why, $neg, $op, $term, $small, $now);
	my($and, $pass, $i, $res, @t);
	$why = $cur;
	$neg = $and = 1;
	while ($cur =~ s/^\s*!\s*//) {
		$neg = !$neg;
	}
	@l = ();
	@r = ();
	while ($cur =~ m/([><=]*)\s*([^=<]+)(.*)/) {
		# print "$1' '$2' '$3\n";
		($op, $term, $cur) = ($1, $2, $3);
		$res = ToNumber(strftime($term, @s));
		@t = split(m/[-\n\t%|:]+/o, $res);
		if (0 == scalar(@l)) {
			@l = @t;
			if ('' ne $op) {
				print "# leading operator ignored\n";
			}
			next;
		}
		@r = @t;
		$pass = 1;
		foreach $i (@r) {
			$res = pop(@l);
			# keep perl from converting octal to decimal --ksb
			$res =~ s/^0*([0-9])/$1/;
			$i =~ s/^0*([1-9])/$1/;
			$pass = eval "($res $op $i) ? 1 : 0";
			print "# INSIDE: ($res $op $i) => $pass\n";
			$and = $and && $pass;
		}
		@l = @t;
	}
	if ($neg != $and) {
		$access_ok = 0;
		print "# timebox: INSIDE failed for $why\n";
		print STDERR "$warning\n"
			unless ('' eq $warning);
		print "77\n" if $opts{'P'};
		exit 77;		# EPERM
	}
}

# A forbid excludes a specific strftime, like "Sat or Sun" as
#	TIMEBOX_FORBID="%u!=6,%u!=7"
# Note that we convert the names back into numbers, or you can use
#	TIMEBOX_FORBID="%a!=Sat,%a!=Sun"
for $cur (split(m/\s*,\s*/, $forbid)) {
	my($neg, $term, $small, $now);
	my($and, $l, $op, $r, $ln, $rn, $pass);
	$cur =~ s/[<][>]/!=/g;
	$neg = $and = 1;
	while ($cur =~ s/^\s*!\s*//) {
		$neg = !$neg;
	}
	unless ($cur =~ m/(..*)\s*([!=]=)\s*(..*)/) {
		print STDERR "timebox: configuration error in FORBID: $cur\n";
		print "65\n" if $opts{'P'};
		exit 65;		# DATAERR
	}
	($l, $op, $r) = ($1, $2, $3);
	@l = split(m/[-\n\t%|:]+/, strftime($l, @s));
	@r = split(m/[-\n\t%|:]+/, strftime($r, @s));
	for $l (@l) {
		$r = pop(@r);
		$ln = ToNumber($l);
		$rn = ToNumber($r);
		$pass = eval "($ln $op $rn) ? 1 : 0";
		$and = $and && $pass;
	}
	if ($neg != $and) {
		$access_ok = 0;
		print "# timebox: FORBID failed for $cur (as $ln $op $rn)\n";
		print STDERR "$warning\n"
			unless ('' eq $warning);
		print "77\n" if $opts{'P'};
		exit 77;		# EPERM
	}
}

# print "# timebox says go\n";
my($kid, $status);
$status = 0;
if ($opts{'P'}) {
	open STDOUT, ">/dev/null";
	$kid = waitpid $opts{'P'}, 0;
	$status = $? < 256 ? $? : ($? >> 8);
	# Are a signals special to timebox? Nope.
}

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