mkusercert.in

#!/usr/bin/perl -wT

#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2004, 2006 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use Getopt::Std;
use Fcntl ':flock';

#
# Load the Testbed support stuff.
#
use lib "@prefix@/lib";
use libaudit;
use libdb;
use libtestbed;
use User;

#
# Create user SSL certificates.
# 
sub usage()
{
    print("Usage: mkusercert [-d] [-o] [-p password] <user>\n");
    exit(-1);
}
my $optlist = "dp:o";
my $debug   = 0;
my $output  = 0;
my $password;

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS	= "@TBOPSEMAIL@";
my $TBLOGS	= "@TBLOGSEMAIL@";
my $OURDOMAIN   = "@OURDOMAIN@";
my $CONTROL	= "@USERNODE@";
my $BOSSNODE	= "@BOSSNODE@";

# Locals
my $USERDIR	= USERROOT();
my $SSLDIR      = "$TB/lib/ssl";
my $TEMPLATE    = "$SSLDIR/usercert.cnf";
my $CACONFIG    = "$SSLDIR/ca.cnf";
my $EMULAB_CERT = "$TB/etc/emulab.pem";
my $EMULAB_KEY  = "$TB/etc/emulab.key";
my $OPENSSL     = "/usr/bin/openssl";
my $WORKDIR     = "$TB/ssl";
my $SAVEUID	= $UID;

#
# We don't want to run this script unless its the real version.
#
if ($EUID != 0) {
    die("*** $0:\n".
	"    Must be setuid! Maybe its a development version?\n");
}

#
# This script is setuid, so please do not run it as root. Hard to track
# what has happened.
#
if ($UID == 0) {
    die("*** $0:\n".
	"    Please do not run this as root! Its already setuid!\n");
}

#
# Untaint the path
#
$ENV{'PATH'} = "$TB/bin:$TB/sbin:/bin:/usr/bin:/usr/bin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};

#
# Turn off line buffering on output
#
$| = 1;

#
# Function prototypes
#
sub fatal($);

#
# Rewrite audit version of ARGV to prevent password in mail logs.
#
my @NEWARGV = @ARGV;
for ($i = 0; $i < scalar(@NEWARGV); $i++) {
    if ($NEWARGV[$i] eq "-p") {
	$NEWARGV[$i + 1] = "**********";
    }
}
AuditSetARGV(@NEWARGV);

#
# Parse command arguments. Once we return from getopts, all that should be
# left are the required arguments.
#
%options = ();
if (! getopts($optlist, \%options)) {
    usage();
}
if (defined($options{"d"})) {
    $debug = 1;
}
if (defined($options{"p"})) {
    $password = $options{"p"};

    #
    # Make sure its all escaped since any printable char is allowed.
    #
    if ($password =~ /^([\040-\176]*)$/) {
	$password = $1;
    }
    else {
	die("Tainted argument: $password\n");
    }
    $password =~ s/\'/\'\\\'\'/g;
    $password = "'$password'";
}
if (@ARGV != 1) {
    usage();
}
my $user = $ARGV[0];

#
# Untaint the arguments.
#
if ($user =~ /^([-\w]+)$/i) {
    $user = $1;
}
else {
    die("Tainted argument: $user\n");
}

# Map target user to object.
my $target_user = User->Lookup($user);
if (! defined($target_user)) {
    fatal("$user does not exist!");
}

# Map invoking user to object.
my $this_user = User->LookupByUnixId($UID);
if (! defined($this_user)) {
    fatal("You ($UID) do not exist!");
}

#
# This script is always audited. Mail is sent automatically upon exit.
#
if (AuditStart(0)) {
    #
    # Parent exits normally
    #
    exit(0);
}

#
# CD to the workdir, and then serialize on the lock file since there is
# some shared goop that the ssl tools muck with (serial number, index, etc.).
# 
chdir("$WORKDIR") or
    fatal("Could not chdir to $WORKDIR: $!");

TBScriptLock("mkusercert") == 0 or
    fatal("Could not get the lock!");

#
# Get the user info (the user being operated on).
#
my $fullname    = $target_user->name();
my $user_email  = $target_user->email();
my $usr_admin   = $target_user->admin();
my $user_number = $target_user->uid_idx();
my $user_uid    = $target_user->uid();
my $user_dbid   = $target_user->dbid();

#
# Get the users earliest project membership to use as the default group
# for the case that the account is being (re)created. We convert that to
# the unix info.
#
my $default_project;
my $default_groupgid;

if ($target_user->FirstApprovedProject(\$default_project) < 0) {
    fatal("Could not locate default project for $target_user");
}

if (defined($default_project)) {
    $default_groupgid = $default_project->unix_gid();
}
else {
    print "No group membership for $target_user; using the guest group!\n";

    (undef,undef,$default_groupgid,undef) = getgrnam("guest");
}

#
# Create a template conf file. We tack on the DN record based on the
# user particulars.
#
system("cp -f $TEMPLATE usercert.cnf") == 0
    or fatal("Could not copy $TEMPLATE to current dir");

open(TEMP, ">>usercert.cnf")
    or fatal("Could not open $TEMPLATE for append: $!");

print TEMP "OU\t\t= sslxmlrpc\n";
print TEMP "CN\t\t= $user_uid\n";
print TEMP "emailAddress\t= $user_uid" . "\@" . "$OURDOMAIN\n";
close(TEMP)
    or fatal("Could not close usercert.cnf: $!");

#
# Create a client side private key and certificate request.
#
system("$OPENSSL req -new -config usercert.cnf ".
       (defined($password) ? " -passout pass:${password} " : " -nodes ") .
       " -keyout usercert_key.pem -out usercert_req.pem") == 0
    or fatal("Could not create certificate request");

#
# Remove the index file. We keep track of things ourselves. We also have to
# figure out what the next serial number will be and write that into the
# file. We could let "ca' keep track, but with devel trees, we might end
# up with duplicate serial numbers.
#
open(IND, ">index.txt")
    or fatal("Could not clear index.txt");
close(IND);

my $curidx = TBGetUniqueIndex("user_sslcerts");

open(SER, ">serial")
    or fatal("Could not create new serial file");
printf SER "%08x\n", $curidx;
close(SER);

#
# Sign the client cert request, creating a client certificate.
#
$UID = 0;
system("$OPENSSL ca -batch -policy policy_sslxmlrpc -config $CACONFIG ".
       " -name CA_usercerts ".
       " -out usercert_cert.pem -cert $EMULAB_CERT -keyfile $EMULAB_KEY ".
       " -infiles usercert_req.pem") == 0
    or fatal("Could not sign certificate request");
$UID = $SAVEUID;

#
# For now, there can be just one cert of each kind (encrypted, and
# unencrypted). Might change that at some point. 
#
DBQueryFatal("delete from user_sslcerts ".
	     "where uid_idx='$user_dbid' and ".
	     "       encrypted=" . (defined($password) ? 1 : 0));

#
# Create a new entry in the table.
#
DBQueryFatal("insert into user_sslcerts ".
	     "(uid, uid_idx, idx, created, encrypted) values ".
	     "('$user_uid', '$user_dbid', $curidx, now(), ".
	               (defined($password) ? 1 : 0) . ")");

#
# Grab the cert path and strip off the header goo, then insert into
# the DB.
#
my $certstring = "";

open(CERT, "$OPENSSL x509 -in usercert_cert.pem |")
    or fatal("Could not start x509 on usercert_cert.pem");

while (<CERT>) {
    next
	if ($_ =~ /^--.*--$/);
    $certstring .= $_;
}
close(CERT);

#
# Now suck in the priv key.
# 
my $pkeystring = "";
open(PKEY, "usercert_key.pem")
    or fatal("Could open usercert_key.pem");

while (<PKEY>) {
    next
	if ($_ =~ /^--.*--$/);
    $pkeystring .= $_;
}
close(PKEY);

$pkeystring = DBQuoteSpecial($pkeystring);
$certstring = DBQuoteSpecial($certstring);
DBQueryFatal("update user_sslcerts set cert=$certstring,privkey=$pkeystring ".
	     "where uid_idx='$user_dbid' and idx=$curidx");

#
# Combine the key and the certificate into one file which is installed
# on each remote node and used by tmcc. Installed on boss too so
# we can test tmcc there.
#
system("cat usercert_key.pem usercert_cert.pem > usercert.pem") == 0
    or fatal("Could not combine cert and key into one file");

#
# Copy the certificate to the users .ssl directory.
#
my $ssldir = "$USERDIR/$user_uid/.ssl";
if (! -d $ssldir) {
    mkdir($ssldir, 0700) or
	fatal("Could not mkdir $ssldir: $!");

    chown($user_number, $default_groupgid, $ssldir)
	or fatal("Could not chown $ssldir: $!");
}

my $target;

if (defined($password)) {
    $target = "$ssldir/encrypted.pem";
}
else {
    $target = "$ssldir/emulab.pem";
}

system("cp -f usercert.pem $target") == 0
    or fatal("Could not copy usercert.pem to $target");

chown($user_number, $default_groupgid, "$target")
    or fatal("Could not chown $target: $!");

TBScriptUnlock();
exit(0);

sub fatal($) {
    my($mesg) = $_[0];

    TBScriptUnlock();
    die("*** $0:\n".
	"    $mesg\n");
}