#! /usr/bin/perl -w
#
# Copyright 2003 Sun Microsystems, Inc.  All rights reserved.
# Use is subject to license terms.

#ident "@(#)SUNW,vca.pl	1.14	03/03/26 SMI"

# This is an rcm script for the cryptographic functions of a Venus card. 

# Note that many different steps are involved and these are not
# atomic.  So, for example, if queryremove or preremove says that is
# is okay to remove a card, it is possible for the state of the system
# to change before the card is actually removed. 

# There are various errors that can occur.  When this script
# discovers an error, it prints a reason and exits with 1.  Even
# though this is what the rcmscript(4) manpage says to do, the rcm
# daemon takes this as indication that it is okay to remove to
# resource.  It was decided to leave it this way, on the rationale
# that if the system is so broken that things like rcm scripts and
# vcadiag are having trouble, we care much more about facilitating
# administration than about keeping applications running.

use strict;

my ($cmd, %dispatch, %res2keystore, %keystore2res, %keystorerefcount, $rv, $force);
my $scriptname = $0;
$scriptname =~ s|^.*/||;  # shorten to just base name of script path.

%dispatch = (
	     "scriptinfo" => \&do_scriptinfo,
	     "register" => \&do_register,
	     "resourceinfo" => \&do_resourceinfo,
	     "queryremove" => \&do_preremove, # same as preremove
	     "preremove" => \&do_preremove,
#	     "postremove" =>      Nothing defined
#	     "undoremove" =>      Nothing defined
);


# validate RCM_ENV_FORCE, if provided; set $force
if (!defined $ENV{"RCM_ENV_FORCE"}) {
  $force = 0;
} elsif ($ENV{"RCM_ENV_FORCE"} eq "FALSE") {
  $force = 0;
} elsif ($ENV{"RCM_ENV_FORCE"} eq "TRUE") {
  $force = 1;
} else {
  print "rcm_failure_reason=RCM_ENV_FORCE environment variable has invalid value";
    print "rcm_log_err=RCM_ENV_FORCE environment variable has invalid value";
  exit(1);
}

$cmd = shift(@ARGV);

if (!defined $cmd) {
  print "rcm_failure_reason=no command supplied\n";
  print "rcm_log_err=no command supplied\n";
  exit(1);
}


if (!defined ($dispatch{$cmd})) {
# command not supported
  exit(2);
}

# Do it.
&{$dispatch{$cmd}};

# All dispatched functions call exit, so control should not get here.
print "rcm_failure_reason=dispatched function did not exit\n";
print "rcm_log_err=dispatched function did not exit\n";
exit(1);


# End of main.  Only subs below here.


# not presently used
sub enforce_root () {
  if ($> != 0) { # effective UID not root
    print "rcm_failure_reason=not running as root\n";
    print "rcm_log_err=not running as root\n";
    exit(1);
  }
}


# Sets the %res2keystore, %keystore2res, and %keystorerefcount hashes.
sub set_resources () {
    $rv = open RES, "/opt/SUNWconn/cryptov2/sbin/vcadiag -Q |";
    if (! $rv) {
      print "rcm_failure_reason=open vcadiag failed: $!\n";
      print "rcm_log_err=open of vcadiag -Q failed: $!\n";
      exit(1);
    }

    my $vcadiagline;
    while (defined ($vcadiagline = <RES>)) {
      my ($res, $restype, $keystorename, $keystoreSN, $keystorerefcnt) = 
	split(":", $vcadiagline);
      next unless defined $res && $res =~ m/^vca[0-9]+$ /x;
      next unless defined $restype && $restype eq "om"; # om => object mgmt.
      # put in data structures
      if (defined $keystorename) {
	# The following branch prevents an error in the case that 
	# vcadiag -Q did not return a keystore serial number.
	# This should never happen.
	if (!defined $keystoreSN) {
	  $keystoreSN = "";
	}
	if (!defined $keystorerefcnt) {
	  # If vcadiag -Q does not return the refcount, use 2.
	  # The 2 will make the device be reported as in use.
	  # This should never actually happen, but protects us
	  # from a perl undefined variable error if it does.
	  $keystorerefcnt = 2;
	}
	my $keystorenameextended="$keystorename:$keystoreSN";
	if (!defined $keystore2res{$keystorenameextended}) {
	  $keystore2res{$keystorenameextended} = {};
	}
	$res2keystore{"/dev/$res"} = $keystorenameextended;
	$keystore2res{$keystorenameextended}->{"/dev/$res"} = 1;
	# subtract one to compensate for the vcadiag -Q process itself
	$keystorerefcount{$keystorenameextended} = $keystorerefcnt - 1;
      }
    }

    close RES;
    if ($?) {
      my $status = $? >> 8;
      printf "rcm_log_info=vcadiag (invoked from $scriptname) returned $status\n";
    }
}


sub do_scriptinfo () {
  print "rcm_script_version=1\n";
  print "rcm_script_func_info=rcm script for DR of vca devices\n";
  # Hardcoded 10 seconds timeout.  Change as appropriate.
  print "rcm_cmd_timeout=10\n";
  exit(0);
}


# returns a list of processes that have /dev/kcl2 open
sub kcl2_users() {
  # fuser appears to write something like 
  # /dev/kcl2:      614o
  # However, all but the pid (614) are sent to stderr, while the pid is
  # sent to stdout.  (Yes!)  So we just redirect stderr to /dev/null.
  # The cond below depends on backticks using sh or ksh.
  return sort {$a <=> $b} split " ", `/usr/sbin/fuser /dev/kcl2 2>/dev/null`;
}


# Exit with 0 if okay to remove, 3 if not okay, 1 for error cases.
sub do_preremove () {

  my $resource = shift(@ARGV);
  if (!defined $resource) {
    print "rcm_failure_reason=no resource supplied\n";
    exit(1);
  }

  # yes if $force is true.
  if ($force) {
    exit (0);
  }

  set_resources();
  
  # Find keystore.
  my $ks = $res2keystore{$resource};

  # If no keystore, say yes.  This backwards-seeming logic is correct.
  # If there is no keystore, then no user can be depending on the
  # keystore, and it safe to remove the resource.
  if (!defined $ks) {
    exit(0);
  }

  # Yes if more than one device is supporting this keysteore.
  if ((scalar keys %{$keystore2res{$ks}}) >= 2) {
    exit (0);
  }

  # Yes if usercount is zero or undefined
  if (! $keystorerefcount{$ks}) {
    exit (0);
  }

  # There are users; say No.

  print "rcm_failure_reason=keystore $ks refcount is $keystorerefcount{$ks}\n";
  
  # At one time this script attempted to list the offending processes.
  # But it appears that only the first process to open /dev/kcl2 
  # actually has an entry in /proc/<pid>/fd with the same inode as /dev/kcl2. 
  # In addition we do not know what device processes are actually using.
  # So we write "might be" to suggest the uncertainty to the user.

  my @userlist = kcl2_users(); 
  my $pid;
  foreach $pid (@userlist) {
    print "rcm_failure_reason=might be pid $pid\n";
  }

  exit (3);
}


# list resources.  The resources are taken from /dev.
sub do_register () {
  my @reslist = sort grep {m|^/dev/vca[0-9]+$ |x} glob "/dev/vca*";
  my $r;
  foreach $r (@reslist) {
    print "rcm_resource_name=$r\n";
  }
  exit(0);
}


# Simple description of resource.  Based on sample file in
# rcmscript(4) manpage, no check made that the resource actually
# exists.
sub do_resourceinfo () {
  my $res = shift(@ARGV);
  if ($res =~ m|^/dev/vca[0-9]+$ |x) {
      print "rcm_resource_usage_info=cryptographic accelerator $res\n";
      exit(0);
    } else {
      print "rcm_failure_reason=invalid resource\n";
      exit(1);
  }
}
