#!/usr/bin/perl -wT
#
# Copyright (c) 2000-2015 University of Utah and the Flux Group.
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
#
use English;
use Getopt::Std;
use XML::Simple;
use File::Temp qw(tempfile :POSIX );

#
# Parse ssh public keys and enter into the DB. The default format is
# openssh, but if the key is not in that format, then use ssh-keygen
# to see if it can be converted from either SSH2 or SECSH format into
# openssh format. This gets called from the webpage to parse keys
# uploaded by users.
#
sub usage()
{
    print "Usage: addpubkeys [-d] [-k | -f] [-n | -u <user>] [<keyfile> | <key>]\n";
    print "       addpubkeys [-d] -X <xmlfile>\n";
    print "       addpubkeys [-d] [-i [-r] | -w] <user>\n";
    print "Options:\n";
    print " -d      Turn on debugging\n";
    print " -k      Indicates that key was passed in on the command line\n";
    print " -f      Indicates that key was passed in as a filename\n";
    print " -n      Verify key format only; do not enter into into DB\n";
    print " -X      Get args from an XML file: verify, user, keyfile.\n";
    print " -w      Generate new authkeys (protocol 1 and 2) file for user\n";
    print " -i      Initialize mode; generate initial key for user\n";
    print " -r      Force a regenerate of initial key for user\n";
    exit(-1);
}
my $optlist   = "dkniwfu:rX:sRNC:S:Ia";
my $iskey     = 0;
my $verify    = 0;
my $initmode  = 0;
my $force     = 0;
my $genmode   = 0;
my $nobody    = 0;
my $noemail   = 0;
my $remove    = 0;
my $nodelete  = 0;
my $internal  = 0;
my $isaptkey  = 0;
my $Comment;
my $xmlfile;

#
# Configure variables
#
my $TB		= "@prefix@";
my $TBOPS       = "@TBOPSEMAIL@";
my $TBAUDIT     = "@TBAUDITEMAIL@";
my $OURDOMAIN   = "@OURDOMAIN@";
my $CONTROL	= "@USERNODE@";
my $KEYGEN	= "/usr/bin/ssh-keygen";
my $ACCOUNTPROXY= "$TB/sbin/accountsetup";
my $SSH		= "$TB/bin/sshtb";
my $SAVEUID	= $UID;
my $USERUID;

# Locals
my $user;
my $this_user;
my $target_user;
my $keyfile;
my $keyline;
my $key;
my $comment;
my $user_name;
my $user_email;
my $user_dbid;
my $user_uid;
my $user_gid;
my $debug = 0;

#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libaudit;
use libdb;
use libtestbed;
use User;

#
# Function prototypes
#
sub ParseKey($);
sub InitUser();
sub GenerateKeyFile();
sub ParseXmlArgs($$$$$$);
sub fatal($);

my $HOMEDIR = USERROOT();

#
# These are the fields that we allow to come in from the XMLfile.
#
my $SLOT_OPTIONAL	= 0x1;	# The field is not required.
my $SLOT_REQUIRED	= 0x2;  # The field is required and must be non-null.
my $SLOT_ADMINONLY	= 0x4;  # Only admins can set this field.
my %xmlfields =
    # XML Field Name        DB slot name         Flags             Default
    ("verify"		=> ["verify",		$SLOT_OPTIONAL,	   0],
     "user"		=> ["user",		$SLOT_OPTIONAL],
     "keyfile"		=> ["keyfile",		$SLOT_REQUIRED]);

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

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

#
# 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");
}

#
# 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!\n");
}

#
# 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{"a"})) {
    $isaptkey = 1;
}
if (defined($options{"k"})) {
    $iskey = 1;
}
if (defined($options{"f"})) {
    $iskey = 0;
}
if (defined($options{"n"})) {
    $verify = 1;
}
if (defined($options{"i"})) {
    $initmode = 1;
}
if (defined($options{"N"})) {
    $nodelete = 1;
}
if (defined($options{"I"})) {
    $internal = 1;
}
if (defined($options{"r"})) {
    $force = 1;
}
if (defined($options{"R"})) {
    $remove = 1;
}
if (defined($options{"s"})) {
    $noemail = 1;
}
if (defined($options{"w"})) {
    $genmode = 1;
}
if (defined($options{"u"})) {
    $user = $options{"u"};
}
if (defined($options{"C"})) {
    $Comment = $options{"C"};
}
if (defined($options{"X"})) {
    $xmlfile = $options{"X"};

    my %xmlargs = (); 
    my %errors = ();
    ParseXmlArgs($xmlfile, "user_pubkeys", \%xmlfields, $debug,
		 \%xmlargs, \%errors);
    if (keys(%errors)) {
	foreach my $key (keys(%errors)) {
	    my $val = $errors{$key};
	    print "${key}: $val\n";
	}
	fatal("XML arg error");
    }

    $verify = $xmlargs{"verify"};
    $user = $xmlargs{"user"}
	if (exists($xmlargs{"user"}));
    $ARGV[0] = $xmlargs{"keyfile"};
}

if ($verify && $genmode) {
    usage();
}
if ($initmode || $genmode) {
    usage()
	if (@ARGV != 1);

    $user = $ARGV[0];
}
else {
    usage()
	if (@ARGV != 1);
    usage()
	if (!$verify && !defined($user));
    
    $keyfile = $ARGV[0];
}

#
# Untaint the arguments.
#
if (defined($user)) {
    if ($user =~ /^([-\w]+)$/i) {
	$user = $1;
    }
    else {
	fatal("Tainted username: $user");
    }
    # Map user to object.
    $target_user = User->Lookup($user);
    if (! defined($target_user)) {
	fatal("$user does not exist!")
    }

    $user_name  = $target_user->name();
    $user_email = $target_user->email();
    $user_dbid  = $target_user->dbid();
    $user_uid   = $target_user->uid();
    $USERUID    = $target_user->unix_uid();

    my $firstproject;

    if ($target_user->FirstApprovedProject(\$firstproject) < 0) {
	fatal("Could not determine first approved project");
    }
    if (defined($firstproject)) {
	$user_gid = $firstproject->unix_gid();
    }
    else {
	$user_gid = "guest";
    }
}

#
# If invoked as "nobody" we came from the web interface. We have to have
# a credential in the environment, unless its just a key verification
# operation, which anyone can do. 
# 
if (getpwuid($UID) eq "nobody") {
    $this_user = User->ImpliedUser();
    
    if (($initmode || $genmode || !$verify) && !defined($this_user)) {
	fatal("Bad usage from web interface");
    }
    $nobody = 1;
}
else {
    # From the command line; map invoking user to object.
    $this_user = User->ThisUser();

    if (! defined($this_user)) {
	fatal("You ($UID) do not exist!");
    }
}

#
# Initmode or genmode, do it and exit.
#
if ($initmode || $genmode) {
    if ($initmode) {
	exit(InitUser());
    }
    if ($genmode) {
	exit(GenerateKeyFile());
    }
    exit(1);
}

# Else, key parse mode ...
if ($iskey) {
    if ($keyfile =~ /^([-\w\s\.\@\+\/\=]*)$/) {
	$keyfile = $1;
    }
    else {
	fatal("Tainted key: $keyfile");
    }
    $keyline = $keyfile;
}
else {
    if ($keyfile =~ /^([-\w\.\/]+)$/) {
	$keyfile = $1;
     }
    else {
	fatal("Tainted filename: $keyfile");
    }
    if (! -e $keyfile) {
	fatal("No such file: $keyfile\n");
    }
    $keyline = `head -1 $keyfile`;
}

#
# Check user
#
if (!$verify) {
    # If its the user himself, then we can generate a new authkeys file.
    # Assume nodelete option comes from internal script, so do not worry.
    if (!$target_user->SameUser($this_user) && !$this_user->IsAdmin() &&
	!$nodelete) {
	fatal("You are not allowed to set pubkeys for $target_user\n");
    }
    if (-d "$HOMEDIR/$user_uid/.ssh") {
	# Drop root privs, switch to target user.
	$EUID = $UID = $USERUID;
	$genmode = 1;
    }
    
    #
    # This script is audited when not in verify mode. Since all keys are first
    # checked with verify mode, this should not cause any extra email from bad
    # keys.
    #
    AuditStart(0);
}

#
# Grab the first line of the file. Parse it to see if its in the
# format we like (openssh), either protocol 1 or 2.
#
if (ParseKey($keyline)) {
    exit 0;
}
# If the key was entered on the command line, then nothing more to do.
if ($iskey) {
    exit 1;
}

#
# Run ssh-keygen over it and see if it can convert it. 
#
if (! open(KEYGEN, "ssh-keygen -i -f $keyfile 2>/dev/null |")) {
    fatal("*** $0:\n".
	  "    Could not start ssh-keygen\n");
}
$keyline = <KEYGEN>;
if (close(KEYGEN) && ParseKey($keyline)) {
    exit 0;
}
exit 1;

sub ParseKey($) {
    my ($keyline) = @_;

    # Remove trailing newlines which screws the patterns below.
    # First convert dos newlines since many people upload from windoze.
    $keyline =~ s/\r/\n/g;
    $keyline =~ s/\n//g;

    # Enforce a reasonable length on the key.
    if (length($keyline) > 4096) {
	print "Key is too long!\n";
	print "Key: $keyline\n";
	return 0;
    }
    
    if ($keyline =~ /^(\d*\s\d*\s[0-9a-zA-Z]*) ([-\w\@\.:\ ]*)\s*$/) {
        # Protocol 1
	$type    = "ssh-rsa1";
	$key     = $1;
	$comment = $2;
    }
    elsif ($keyline =~ /^(\d*\s\d*\s[0-9a-zA-Z]*)\s*$/) {
        # Protocol 1 but no comment field.
	$type    = "ssh-rsa1";
	$key     = $1;
    }
    elsif ($keyline =~
	   /^(ssh-rsa|ssh-dss) ([-\w\.\@\+\/\=]*) ([-\w\@\.:\ ]*)$/) {
        # Protocol 2
	$type    = $1;
	$key     = "$1 $2";
	$comment = $3;
    }
    elsif ($keyline =~ /^(ssh-rsa|ssh-dss) ([-\w\.\@\+\/\=:]*)$/) {
        # Protocol 2 but no comment field
	$type    = $1;
	$key     = "$1 $2";
    }

    if (!defined($key)) {
	print STDERR "Key cannot be parsed!\n";
	return 0;
    }

    # Do not enter into DB if in verify mode.
    if ($verify) {
	print "Key was good: $type\n";
	return 1;
    }

    #
    # Make up a comment field for the DB. 
    #
    if (!defined($comment)) {
	$comment = (defined($Comment) ? $Comment : "$type-${user_email}");
    }
    $key = "$key $comment";
    my $safe_key = DBQuoteSpecial($key);
    my $safe_comment = DBQuoteSpecial($comment);

    if ($remove) {
	DBQueryFatal("delete from user_pubkeys ".
		     "where uid_idx='$user_dbid' and comment=$safe_comment");
    }
    # Only one APT key allowed
    if ($isaptkey) {
	DBQueryFatal("delete from user_pubkeys ".
		     "where uid_idx='$user_dbid' and isaptkey=1");
    }
    DBQueryFatal("replace into user_pubkeys set ".
		 " uid='$user_uid', uid_idx='$user_dbid', ".
		 " internal='$internal', nodelete='$nodelete', ".
		 " isaptkey='$isaptkey',idx=NULL, stamp=now(), ".
		 " pubkey=$safe_key, comment=$safe_comment");

    #
    # Mark user record as modified so nodes are updated.
    #
    TBNodeUpdateAccountsByUID($user_uid);

    my $chunked = "";

    while (length($key)) {
	$chunked .= substr($key, 0, 65, "");
	if (length($key)) {
	    $chunked .= "\n";
	}
    }
    print "SSH Public Key for '$user' added:\n";
    print "$chunked\n";
    
    # Generate new auth keys file. 
    if ($genmode) {
	GenerateKeyFile();
    }

    if (! $noemail) {
	SENDMAIL("$user_name <$user_email>",
		 "SSH Public Key for '$user_uid' Added",
		 "SSH Public Key for '$user_uid' added:\n".
		 "\n".
		 "$chunked\n",
		 "$TBOPS");
    }
    return 1;
}

#
# Init function for new users. Generate the first key for the user (which
# is loaded into the DB), and then generate the keyfiles. Note that the
# user might have preloaded personal keys.
#
sub InitUser()
{
    #
    # Want to delete existing keys from DB, but not the sslcert key.
    #
    DBQueryFatal("delete from user_pubkeys ".
		 "where uid_idx='$user_dbid' and ".
		 "      (internal=1 or comment like '%\@${OURDOMAIN}' or ".
		 "       comment like '%\@boss.${OURDOMAIN}') and ".
		 "      isaptkey=0 and comment not like 'sslcert:%'");

    # Redirect pub key to file, redirect STDERR to STDIN for display.
    my $outfile = tmpnam();
    my $command = "$ACCOUNTPROXY createsshkey $user_uid $user_gid ";
    	
    $UID = 0;
    open ERR, "$SSH -host $CONTROL '$command rsa1' 2>&1 > $outfile |";
    $UID = $SAVEUID;

    my $errs = "";
    while (<ERR>) {
	$errs .= $_;
    }
    close(ERR);
    print STDERR $errs;
    if ($?) {
	unlink($outfile);
	fatal("Could not create rsa1 key");
    }
    my $pubkey      = `cat $outfile`;
    chomp($pubkey);
    my $safe_pubkey = DBQuoteSpecial($pubkey);
    my $comment     = "rsa\@${OURDOMAIN}";
    
    if (! DBQueryWarn("replace into user_pubkeys set ".
		      " uid='$user_uid', uid_idx='$user_dbid', ".
		      " internal='1', nodelete='1', idx=NULL, stamp=now(), ".
		      " pubkey=$safe_pubkey, comment='$comment'")) {
	unlink($outfile);
	fatal("Could not add rsa1 key to database");
    }
	
    $UID = 0;
    open ERR, "$SSH -host $CONTROL '$command rsa' 2>&1 > $outfile |";
    $UID = $SAVEUID;

    $errs = "";
    while (<ERR>) {
	$errs .= $_;
    }
    close(ERR);
    print STDERR $errs;
    if ($?) {
	unlink($outfile);
	fatal("Could not create rsa key");
    }

    $pubkey      = `cat $outfile`;
    chomp($pubkey);
    $safe_pubkey = DBQuoteSpecial($pubkey);
    $comment     = "rsa1\@${OURDOMAIN}";
    
    if (! DBQueryWarn("replace into user_pubkeys set ".
		      " uid='$user_uid', uid_idx='$user_dbid', ".
		      " internal='1', nodelete='1', idx=NULL, stamp=now(), ".
		      " pubkey=$safe_pubkey, comment='$comment'")) {
	unlink($outfile);
	fatal("Could not add rsa key to database");
    }
    unlink($outfile);
    return GenerateKeyFile();
}

#
# Generate ssh authorized_keys files. Either protocol 1 or 2.
# Returns 0 on success, -1 on failure.
#
sub GenerateKeyFile()
{
    my @pkeys   = ();
    my $outfile = tmpnam();
    my $sshdir  = "$HOMEDIR/$user_uid/.ssh";

    my $query_result =
	DBQueryFatal("select pubkey from user_pubkeys ".
		     "where uid_idx='$user_dbid'");

    while (my ($key) = $query_result->fetchrow_array()) {
	push(@pkeys, $key);
    }
    
    print "Generating authorized_keys ...\n";
    if (!open(AUTHKEYS, "> $outfile")) {
	warn("*** WARNING: Could not open $outfile: $!\n");
	return -1;
    }
    print AUTHKEYS "#\n";
    print AUTHKEYS "# DO NOT EDIT! This file auto generated by ".
	"Emulab account software.\n";
    print AUTHKEYS "#\n";
    print AUTHKEYS "# Please use the web interface to edit your ".
	"public key list.\n";
    print AUTHKEYS "#\n";
    
    foreach my $key (@pkeys) {
	print AUTHKEYS "$key\n";
    }
    close(AUTHKEYS);

    $UID = 0;
    system("$SSH -host $CONTROL ".
	   "'$ACCOUNTPROXY dropfile $user_uid $user_gid 0600 $sshdir ".
	   "authorized_keys' < $outfile");
    $UID = $SAVEUID;

    if ($?) {
	unlink($outfile);
	fatal("Could not copy authorized_keys file to $CONTROL");
    }
    return 0;
}

sub ParseXmlArgs($$$$$$) {
    my ($xmlfile, $table_name, $fields_ref, $debug,
	$args_ref, $errs_ref) = @_;
    #
    # Input args:
    #  $xmlfile	   - XML file path.
    #  $table_name - table_regex table_name for low-level checking patterns.
    #  $fields_ref - xmlfields specification (hash reference.)
    #  $debug
    #
    # Output args:
    #  $args_ref   - Parsed argument values (hash reference.)
    #  $errs_ref   - Error messages on failure (hash reference.)

    $debug = 0;

    #
    # Must wrap the parser in eval since it exits on error.
    #
    my $xmlparse = eval { XMLin($xmlfile,
				VarAttr => 'name',
				ContentKey => '-content',
				SuppressEmpty => undef); };
    if ($@) {
	$errs_ref->{"XML Parse Error"} = "Return code $@";
	return;
    }

    #
    # Make sure all the required arguments were provided.
    #
    my $key;
    foreach $key (keys(%{ $fields_ref })) {
	my (undef, $required, undef) = @{$fields_ref->{$key}};

	$errs_ref->{$key} = "Required value not provided"
	    if ($required & $SLOT_REQUIRED  &&
		! exists($xmlparse->{'attribute'}->{"$key"}));
    }
    return
	if (keys(%{ $errs_ref }));

    foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
	my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
	if (!defined($value)) {	# Empty string comes from XML as an undef value.
	    $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
	}

	if ($debug) {
	    print STDERR "User attribute: '$key' -> '$value'\n";
	}

	$errs_ref->{$key} = "Unknown attribute"
	    if (!exists($fields_ref->{$key}));

	my ($dbslot, $required, $default) = @{$fields_ref->{$key}};

	if ($required & $SLOT_REQUIRED) {
	    # A slot that must be provided, so do not allow a null value.
	    if (!defined($value)) {
		$errs_ref->{$key} = "Must provide a non-null value";
		next;
	    }
	}
	if ($required & $SLOT_OPTIONAL) {
	    # Optional slot. If value is null skip it. Might not be the correct
	    # thing to do all the time?
	    if (!defined($value)) {
		next
		    if (!defined($default));
		$value = $default;
	    }
	}
	if ($required & $SLOT_ADMINONLY) {
	    # Admin implies optional, but thats probably not correct approach.
	    $errs_ref->{$key} = "Administrators only"
		if (! $this_user->IsAdmin());
	}

	# Now check that the value is legal.
	if (! TBcheck_dbslot($value, $table_name, $dbslot, 
			     TBDB_CHECKDBSLOT_ERROR)) {
	    $errs_ref->{$key} = TBFieldErrorString();
	    next;
	}

	$args_ref->{$key} = $value;
    }
}

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

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