#!/usr/local/bin/perl5 -w

#
# NOTE
#
# You may want to set STDOUT and STDERR to a log file (or at least redirect
# output when you invoke this script) so that you can add diagnostic
# print statements and/or run commands that may generate output.  It
# may prove useful to use
#
# system('/usr/local/bin/klist');
# system('/usr/local/bin/tokens');
#
# in various functions to validate that you have unexpired Kerberos
# tickets and tokens.
#
# This script has not been heavily tested.
#
# IMPLEMENTATION NOTES
#
# This script is a prototype to provide an idea of what needs to be done
# in order to maintain unexpired tickets and AFS tokens using a Kerberos
# 5 keytab file.  As such, it is not as sophisticated as it should be.
# Some of the missing functionality includes, but is not limited to,
#
# 1. No perl modules are utilized since they may not be on the local disk,
#    or there could be version dependencies.
# 2. No support for passing options or arguments, instead using global
#    variables for controlling behavior.
#

use strict;

(my $PROG = $0) =~ s#^.*/##;

my $DEBUG = 1 if (exists($ENV{RUN_WITH_TICKETS_DEBUG}));

#
# Flag for determining whether we should look for termination of the
# parent process.  The parent process is the initial process executing
# this script and after starting the ticket watcher, exec's the given
# command over top of itself.  If the command does a fork to detach itself,
# then the parent will appear to have terminated.  In this case, we
# can not watch for termination of the parent in order to cease maintaining
# the tickets and AFS tokens.  The script could be extended to look for the
# a file containing the pid of a related process whose termination would
# signal that we no longer need to maintain the tickets and AFS tokens.
#
# Set $WATCH_PARENT to:
#
#  0 - if we should maintain the tickets and ignore the existence of the
#      parent
#  1 - (or non-zero) if we should destroy the tickets and terminate when
#      the parent is gone.
#
my $WATCH_PARENT = 1;

#
# Saved values for AFS system call numbers and op codes
#
my $AFSCALL_SETPAG = 0;
my $AFSCALL_PIOCTL = 0;
my $AFS_DEF_SYSCALL = 0;
my $AFS_SETPAG = 0;
my $AFS_PIOCTL = 0;
my $AFS_SYSCALL = 0;

#
# Parameters for the Kerberos principal for which to obtain a TGT.  This
# principal will also be the AFS user for which AFS service tickets will
# be obtained.  An AFS token based on the AFS service ticket will be
# set in the Kernel.
#
# Set these based upon your specific Kerberos parameters
#

#
# A fully qualified Kerberos 5 principal is:
#
#   <name>/<inst>@<realm>
#
my $KRB_NAME = 'user';
my $KRB_INST = 'daemon';
my $KRB_REALM = 'CS.CMU.EDU';
#
# The number of seconds for the life of the TGT.  Typically, this can be
# up to 24 hours (86400 seconds).  This should be at least 5 minutes
# (300 seconds).
#
my $KRB_LIFE = 86400;
#
# The location of the Kerberos 5 keytab.  This can be a symbolic link to
# a file in /etc/not-backed-up.  It is important the keytab files are
# never backed up, so the actual file must live in /etc/not-backed-up
#
my $KRB_KEYFILE = '/usr/mypkg/etc/daemon.keytab';

#
# It is very important for this program to have a separate AFS PAG to keep
# the AFS tokens we will obtain from interfering with other sessions for
# the same Unix user ID number, or with the PAG, if present, of our caller.
#

#
# Set a new AFS PAG.  Code cribbed from Jeff Hutzelman.
# While ugly, this works better than using "pagsh".
#
sub setpag {
  my $e = '';
  my ($l);

  open(AFSH, '/usr/local/include/afs/afs_args.h') or
    open(AFSH, '/usr/local/include/afs/afs.h') or
      $e = 'unable to find afs/afs.h';

  while(!$e && defined($l = <AFSH>)) {
    chomp($l);
    if ($l =~ /^\#define\s*AFSCALL_SETPAG\s*([-+\d]+)/) { $AFSCALL_SETPAG  = eval $1 }
    if ($l =~ /^\#define\s*AFSCALL_PIOCTL\s*([-+\d]+)/) { $AFSCALL_PIOCTL  = eval $1 }
    if ($l =~ /^\#define\s*AFS_SYSCALL\s*([-+\d]+)/)    { $AFS_DEF_SYSCALL = eval $1 }
    last if ($AFSCALL_SETPAG && $AFS_DEF_SYSCALL);
  }
  close(AFSH);

  open(PARAMH, '/usr/local/include/afs/param.h') or
    open(PARAMH, '/afs/cs.cmu.edu/misc/afs/@sys/3.4a/include/afs/param.h') or
      $e = 'unable to find afs/param.h' if (!$e);

  while (!$e && defined($l = <PARAMH>)) {
    if ($l =~ /^\#define\s*AFS_SETPAG\s*([-+\d]+)/)  { $AFS_SETPAG  = eval $1 }
    if ($l =~ /^\#define\s*AFS_PIOCTL\s*([-+\d]+)/)  { $AFS_PIOCTL  = eval $1 }
    if ($l =~ /^\#define\s*AFS_SYSCALL\s*([-+\d]+)/) { $AFS_SYSCALL = eval $1 }
    last if ($AFS_SYSCALL);
  }
  close(PARAMH);

  if ($DEBUG) {
    print STDERR "PID=$$ : AFS_SETPAG      = $AFS_SETPAG\n";
    print STDERR "PID=$$ : AFS_SYSCALL     = $AFS_SYSCALL\n";
    print STDERR "PID=$$ : AFSCALL_SETPAG  = $AFSCALL_SETPAG\n";
    print STDERR "PID=$$ : AFS_DEF_SYSCALL = $AFS_DEF_SYSCALL\n";
  }

  $AFS_SYSCALL = $AFS_DEF_SYSCALL if (!$AFS_SYSCALL);
  if (!$e) {
    my $r = 0;

    if ($AFS_SETPAG) {
      $r = syscall($AFS_SETPAG+0);
    } else {
      $r = syscall($AFS_SYSCALL+0, $AFSCALL_SETPAG+0);
    }
    $e = "setpag() failed: $!" if ($r);
  }

  print STDERR "PID=$$ : setpag -> '$e'\n" if ($DEBUG);

  $e;
}

#
# Generate a Kerberos 4 and Kerberos 5 ticket file name specific for
# this process that needs to be authenticated.  This is to avoid
# clobbering any existing tickets that we may have and are not relevant
# for the process we are running.
#
# A new PAG must have been created by whatever invoked this script.
#
sub set_ticket_name {
  my $name = "/tkt/${PROG}.$$";

  $ENV{KRBTKFILE} = "$name";
  $ENV{KRB5CCNAME} = "FILE:${name}.krb5";
}

#
# See if we have a valid service ticket for the specified service in our
# Kerberos 5 ticket cache.  If no realm is specified, we do not make
# sure that the service ticket is for our local realm.
#
sub have_service_ticket {
  my ($svc) = @_;
  my ($spat, $l, $pid, $in_v5, $valid_svc);
  my $e = '';

  print STDERR "PID=$$ : have_service_ticket '$svc' called\n" if ($DEBUG);

  if ($svc !~ m/\@/) {
    $spat = qr(\s+$svc\@);
  } else {
    $spat = qr(\s+$svc);
  }
  $pid = open(FH, "-|");
  $e = "fork failed: $!" if (!defined($pid));
  return(0) if ($e);

  if ($pid == 0) {
    my @cmd = qw(/usr/local/bin/klist);
    #
    # Child
    #
    { exec { $cmd[0] } @cmd; }
    exit(1);
  }

  #
  # Parent
  #
  $in_v5 = $valid_svc = 0;
  while (defined($l = <FH>) && !$valid_svc) {
    chomp($l);
    if ($l =~ m/^Credentials cache:/) {
      $in_v5 = 1;
    } elsif ($l =~ m/^v4-ticket file:/) {
      $in_v5 = 0;
    }
    if ($in_v5) {
      if ($l =~ /$spat/ && $l !~ m/Expired/) {
	$valid_svc = 1;
      }
    }
  }
  close(FH);

  print STDERR "PID=$$ : have_service_ticket '$svc' -> $valid_svc\n"
    if ($DEBUG);

  $valid_svc;
}

#
# Obtain a TGT and an AFS service ticket.  We also run 'aklog' to get
# a Kerberos 4 AFS service ticket, although this may not be necessary.
# In addition to obtain the AFS service ticket, an AFS authentication
# token will be set in the kernel.
#
sub get_tickets {
  my $princ = 
    ($KRB_INST
     ? "${KRB_NAME}/${KRB_INST}\@${KRB_REALM}"
     : "${KRB_NAME}\@${KRB_REALM}");
  my ($xstat);

  system('/usr/local/bin/k5auth', '--524init', '-t', $KRB_KEYFILE,
	 '-l', $KRB_LIFE, $princ);
  $xstat = $?;
  print STDERR "PID=$$ : get_tickets k5auth status: $xstat\n" if ($DEBUG);

  system('/usr/local/bin/aklog');
  $xstat = $?;
  print STDERR "PID=$$ : get_tickets aklog status: $xstat\n" if ($DEBUG);

  return(&check_ticket);
}

#
# See if our Kerberos ticket has a valid Kerberos 5 TGT.
#
sub check_ticket {
  my ($stat, $r);

  if ($DEBUG) {
    #
    # This will go to to STDOUT
    #
    system('/usr/local/bin/klist');
    system('/usr/local/bin/tokens');
  }

  #
  # Is ticket valid?
  #
  system('/usr/local/bin/klist', '-t');
  $stat = $?;
  print STDERR "PID=$$ : check_ticket: klist status: $stat\n" if ($DEBUG);

  #
  # If the ticket is valid, do we have an AFS service ticket?
  #
  if ($stat == 0) {
    $r = have_service_ticket("afs");
  } else {
    $r = 0;
  }

  print STDERR "PID=$$ : check_ticket: have_service_ticket -> '$r'\n"
    if ($DEBUG);

  $r;
}

sub destroy_tickets {
  print STDERR "PID=$$ : Destroying tickets\n" if ($DEBUG);

  system('/usr/local/bin/kdestroy');
  system('/usr/local/bin/unlog');
}

#
# Continuous running "thread" (process) for watching and refreshing tickets
#
# 1. See if our parent process, for whom we are maintaining the tickets,
#    is gone.  Exit if our parent is gone.
#
# 2. Once more than half of the tickets TGT lifetime has expired, or the
#    TGT is expired, try getting new tickets.  Do this once a minute
#    until it succeeds.  This is too ensure that we don't wait too long
#    before refreshing our tickets.
#
sub ticket_watcher {
  my ($ppid) = @_;
  my ($start, $diff, $half_life, $sleep_time);

  $start = time;
  $half_life = $KRB_LIFE / 2;
  $half_life = 150 if ($half_life < 150);

  while (1) {
    if ($ppid && kill(0, $ppid) == 0) {
      #
      # Parent is gone (or we have no permission to kill it)
      #
      print STDERR "PID=$$ : ticket_watcher: PARENT GONE\n" if ($DEBUG);
      &destroy_tickets;
      exit(0);
    }

    $diff = time - $start;
    $sleep_time = $half_life;
    if ($diff >= $half_life || !&check_ticket) {
      if (&get_tickets) {
	$start = time;
      } else {
	$sleep_time = 60;
      }
    }
    sleep($sleep_time);
  }
}

#
# Start the ticket watching "thread" (process).  If we are to watch for
# termination of the parent, then set the parent process ID to our pid.
#
sub start_ticket_watcher {
  my ($ppid, $pid);

  $ppid = 0;
  $ppid = $$ if ($WATCH_PARENT);

  if (!defined($pid = fork)) {
    return 0;
  }

  if ($pid) {
    #
    # Parent returns
    #
    return 1;
  }

  &ticket_watcher($ppid);
}


#
# Run a command obtaining and maintaining AFS authentication
#
# All of the arguments are the command and arguments to be executed.
#
MAIN: {
  my @cmd_and_args;
  my $cmd;
  my $i;
  my $max = 5;
  my $e = '';

  @cmd_and_args = @ARGV;
  $cmd = $cmd_and_args[0];

  #
  # It is important to get a PAG before getting Kerberos tickets
  #
  if (($e = &setpag) ne '') {
    die("can not set PAG: $e\n");
  }

  #
  # Set a ticket file name to avoid interfering with any ticket file
  # currently in use.
  #
  &set_ticket_name;

  #
  # Obtain our tickets
  #
  while ($i++ < $max) {
    last if (&get_tickets);
    sleep(15);
  }

  #
  # Start the ticket watching process
  #
  if (!&start_ticket_watcher) {
    &destroy_tickets;
    die("unable to start ticket watcher\n");
  }

  #
  # Exec the command and arguments (avoiding perl using a shell).
  # It is important that the command not terminate by using the trick
  # of forking a child and the parent exitting.
  #
  if ($DEBUG) {
    print STDERR
      ("PID=$$ : About to exec: ", join(' ', @cmd_and_args), "\n");
  }
  exec $cmd @cmd_and_args;
}