#! /usr/bin/perl -w
# $Header: /global/src/usr.bin/src/RCS/cl-pam_ssh_exec.pl,v 1.16 2022/09/26 20:13:22 pb22 Exp $
# install in (e.g.) /usr/bin/cl-pam_ssh_exec
# run by /etc/pam.d/sshd to clear the user count when a user manages to login
#   session optional pam_exec.so seteuid log=/var/log/cl-pam_ssh /usr/bin/cl-pam_ssh_exec

use strict;

# system("env");
# The file which needs to be processed   $file="/proc/net/ipt_recent/SSH";
my $recent="/proc/net/xt_recent/SSH";
my $user = $ENV{'PAM_USER'} || "NeMo-$<-$>";
my $host = $ENV{'PAM_RHOST'};
my $serv = $ENV{'PAM_SERVICE'} || "NoServ";
my $gauth= "sshd";	# really this will be sshd4 as that's the one using gauth
my $type = $ENV{'PAM_TYPE'} || "UnKnown_session";;
my $tty  = $ENV{'PAM_TTY'} || "NoTty";;
my $sess = $ENV{'XDG_SESSION_ID'};
&fail("no PAM_RHOST") unless $host;
my $KRENEWPID="/tmp/.pid.krenew_$user";	# see also cl-krenew - it may need to know this as well. sudoers needs to pass on XDG_SESSION_ID for 'sudo cl-tgt'

my $tgtsrv = "svr-tgt-2.cl.cam.ac.uk";

# reduce tge noise by default ...
exit(0) if $host =~ /^(svr-tgt-.|cron-serv4)\.cl\.cam\.ac\.uk$/;

# No need to do anything if it's internal - assume not using google authenticator
&log("skip local name ($host)") if $host =~ /cl\.cam\.ac\.uk$/;
&log("skip local address ($host)") if $host =~ /^2001:630:212:2/ || $host eq "localhost" || $host =~ /^127\.0\./ || ($host =~ /^128\.232\.(\d+)/ && $1 < 128);

# If ending an ssh session, close things down.
if ($type eq "close_session" && $serv eq $gauth && -e "/var/spool/ga/$user/.google_authenticator") {
	# Delete the TGT and the link to it (if dangling)
	my $usern = `/usr/bin/id -u $user`;
	chomp $usern;
	my $base = "/tmp/krb5cc_$usern";
	my $file = "${base}_kt0-XDG$sess";
	system("rm -f $file") if -e $file;
	system("rm -f $base") if (-e $base || -l $base) && ! -r $base; # '-e' may fail for dangling link # &note("delete dangling $base");

	# kill krenew if it exist
	my $pidfile = "$KRENEWPID.XDG$sess";
	my $pid = &readn($pidfile);
	# stat($pidfile)[X] == $usern .... **** Check that the user 
	&note("$type gauth ($file) $usern:$pid");
	$< = $> = $usern;
	kill 1, $pid if $pid;
	exit
}

# Nothing else is done on close.
&log($type) if $type ne "open_session";

# If using google authenticator, fetch a TGT -- do this BEFORE the fork, so that the TGT is in place
if ($serv eq $gauth && -e "/var/spool/ga/$user/.google_authenticator") {

	# Request a new TGT
	&note("remote google_authenticator $user");
	# Get a TGT which requires refreshing every 3 mins -- use "krenew -K 2"
	system("timeout -k 1 5 ssh -2 -4 -n -a -x -oPreferredAuthentications=publickey -i /etc/ssh/identity-onserver-root -l root $tgtsrv tgt SUB=pamfetch USER=$user ID=XDG$sess TGT_L=3m TGT_R=2h"); # could add '-v' to show more in /var/log/cl-pam_ssh

	# If there is TGT in the 'std' place, create a link
	my $usern = `/usr/bin/id -u $user`;
	chomp $usern;
	my $file = "krb5cc_${usern}_kt0-XDG$sess";
	my $ffile = "/tmp/$file";
	system("ln -sf $file /tmp/krb5cc_${usern}") if ! -r "/tmp/krb5cc_${usern}"; # could add -v

	# Start a krenew running so that the ticket survives
	if (-e $ffile && !fork) {
		$ENV{'KRB5CCNAME'} = "FILE:/$ffile";
		$< = $> = $usern;
		exec("krenew -vaK1 -p$KRENEWPID.XDG$sess"); # should delete -v when there are real users - or maybe -b?
	}
}

fork && exit(0); # Don't delay things -- fork and exit

# Unless it isn't correctly DNS registsred, we have the host name, rather than the IP address :-(
my $address = "";
if ($host =~ /^\d+\.\d+\.\d+\.\d+$/) { $address = $host; }
elsif ($host =~ /^.*:.*:.*:.*:.*$/) { $address = $host; }
else {	# We have the name, so unlist all addresses of that name - overkill.
	use Net::DNS;
	my $res   = Net::DNS::Resolver->new;
	foreach my $ip ("A", "AAAA") {
		if (my $query = $res->query($host, $ip) ) {
			foreach my $rr (grep { $_->type eq $ip } $query->answer) {
        			$address .= $rr->address . ' ';
			}
		}
	}
	&fail("PAM_RHOST $host does not resolve to any addresses") unless $address;
	$address =~ s/ $//;
	&log("skip local '$address' ($host)") if $address =~ /^128\.232\.(\d+)/ && $1 < 128;
}

# Try to write to clear the use.
foreach my $ip (split(/ /, $address)) {
	open(FILE, ">$recent") || &fail("open of $recent for '$ip' gave $!");
	print FILE "-$ip\n" || &fail("write '-$ip' to $recent gave $!");
	close(FILE) || &fail("close of $recent for '-$ip' gave $!");
}

# Log the use and exit
&log("cleared '$address' ($host) in $recent");

sub note { print @_,    " for $user $serv $sess $type $tty", ($#ARGV > 0) ? " (@ARGV)" : "", "\n"; }
sub log  { print @_,    " for $user $serv $sess $type $tty", ($#ARGV > 0) ? " (@ARGV)" : "", "\n"; exit(0); }
sub fail { die "$0: $_[0] for $user $serv $sess $type $tty", ($#ARGV > 0) ? " (@ARGV)" : "", "\n"; exit(0); }

sub readn {
	my $n = `cat $_[0]`;
	chomp $n;
	return $n;
}
