#!/usr/bin/perl
# The LearningOnline Network
# CrGenerate - Generate a loncapa certificate request.
#
# $Id: CrGenerate.pl,v 1.5 2004/07/01 10:58:29 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or 
# (at your option) any later version.
#
# LON-CAPA 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 General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#


# http://www.lon-capa.org/
#
#
#  This script:
#  1. Generates a private host key and certificate request/
#  2. Decodes the private host key
#  3. Installs the private host key with appropriate permissions
#     in the  appropriate directory (sorry to be vague about this, but
#     the installation directory is determined by external configuration
#     info).
# 4. Constructs an email to the loncapa cluster administrator
#    consisting of a generic heading and the certificate request as a MIME
#    attachment.
# 5. Sends the email and
# 6. Cleans up after itself by removing any temp files generated.
#
#


# Import section:

use strict;
use MIME::Entity;
use LONCAPA::Configuration;
use File::Copy;

#  Global variable declarations:4

my $SSLCommand;			  # Full path to openssl command.
my $CertificateDirectory;	  # LONCAPA Certificate directory.
my $KeyFilename;	          # Key filename (within CertificateDirectory).
my $RequestEmail;		  # Email address of loncapa cert admin.
my $WebUID;			# UID of web user.
my $WebGID;			# GID of web user.

my $Passphrase="loncapawhatever";      # Initial passphrase for keyfile
my $RequestFile="loncapaRequest.pem";  # Name of Certificate request file.
my $EncodedKey="hostkey.pem";	       # Name of encoded key file.

my $WebUser="www";		# Username running the web server.
my $WebGroup="www";		# Group name running the web server.

#   Debug/log support:
#
my $DEBUG = 1;			# 1 for on, 0 for off.

# Send debugging to stderr.
# Parameters:
#     msg   - Message to send to stderr.
# Implicit Inputs:
#    $DEBUG - message is only written if this is true.
#
sub Debug {
    my $msg  = shift;
    if($DEBUG) {
	print STDERR "$msg\n";
    }
}

#
#  Decodes the email address from a textual certificate request
#  file:
# Parameters:
#    $RequestFile   - Name of the file containing the textual
#                     version of the certificate request.
# Returns:
#   Email address contained in the request.
# Failure:
#   If unable to open or unable to fine an email address in the file,
#   dies with a message.
#
sub DecodeEmailFromRequest {
    Debug("DecodeEmailFromRequest");

    my $RequestFile = shift;
    Debug("Request file is called $RequestFile");

    # We need to look for the line that has a "/Email=" in it.

    Debug("opening $RequestFile");
    open REQUEST, "< $RequestFile" or
	die "Unable to open $RequestFile to parse return email address";

    Debug("Parsing request file");
    my $line;
    my $found = 0;
    while($line = <REQUEST>) {
	chomp($line);		# Never a bad idea.
	if($line =~ /\/Email=/) {
	    $found = 1;
	    last;
	}
    }
    if(!$found) {
	die "There does not appear to be an email address in $RequestFile";
    }

    close REQUEST;

    Debug("Found /Email in $line");
    
    # $line contains a bunch of comma separated key=value pairs.
    # The problem is that after these is a /Email=<what-we-want>
    # first we'll split the line up at the commas.
    # Then we'll look for the entity with the /Email in it.
    # That line will get split at the / and then the Email=<what-we-want>
    # gets split at the =.  I'm sure there's some clever regular expression
    # substitution that will get it all in a single line, but I think 
    # this approach is gonna be much easier to understand than punctuation
    # sneezed all over the page:
   
    my @commalist = split(/,/, $line);
    my $item;
    my $emailequals = "";
    foreach $item  (@commalist) {
	if($item =~ /\/Email=/) { # gotcha...
	    $emailequals = $item;
	    last;
	}
    }

    Debug("Pulled out $emailequals from $line");
    my ($trash, $addressequals) = split(/\//, $emailequals);
    Debug("Futher pulled out $addressequals");

    my ($junk, $address) = split(/=/, $addressequals);
    Debug("Parsed final email addresss as $address");
    


    return $address;
}

#
#   Read the LonCAPA web config files to get the values of the 
#   configuration global variables we need:
# Implicit inputs:
#   loncapa.conf   - configuration file to read (user specific).
# Implicit outputs (see global variables section):
#   SSLCommand,
#   CertificateDirectory
#   KeyfileName
#   RequestEmail
# Side-Effects:
#   Exit with error if cannot complete.
#
sub ReadConfig {

    Debug("Reading configuration");
    my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
    
    # Name of the SSL Program

    if($perlvarref->{SSLProgram}) {
	$SSLCommand = $perlvarref->{SSLProgram};
	Debug("SSL Command: $SSLCommand");
    }
    else {
	die "Unable to read the SSLCommand configuration option\n";
    }

    # Where the certificates, and host key are installed:

    if($perlvarref->{lonCertificateDirectory}) {
	$CertificateDirectory = $perlvarref->{lonCertificateDirectory};
	Debug("Local certificate Directory: $CertificateDirectory");
    }
    else {
	die "Unable to read SSLDirectory configuration option\n";
    }
    # The name of the host key file (to be installed in SSLDirectory).
    #
    if($perlvarref->{lonnetPrivateKey}) {
	$KeyFilename  = $perlvarref->{lonnetPrivateKey};
	Debug("Private key will be installed as $KeyFilename");
    } 
    else {
	die "Unable to read lonnetPrivateKey conrig paraemter\n";
    }
    #  The email address to which the certificate request is sent:

    if($perlvarref->{SSLEmail}) {
	$RequestEmail = $perlvarref->{SSLEmail};
	Debug("Certificate request will be sent to $RequestEmail");
    }
    else {
	die "Could not read SSLEmail coniguration key";
    }
    #  The UID/GID of the web user: It's possible the web user's
    #  GID is not its primary, so we'll translate that form the
    #  group file separately.

    my ($login, $pass, $uid, $gid) = getpwnam($WebUser);
    if($uid) {
	$WebUID = $uid;
	Debug("Web user: $WebUser -> UID: $WebUID");
    }
    else {
	die "Could not translate web user: $WebUser to a uid.";
    }
    my $gid = getgrnam($WebGroup);
    if($gid) {
	$WebGID = $gid;
	Debug("Web group: $WebGroup -> GID $WebGID");
    }
    else {
	die "Unable to translate web group $WebGroup to a gid.";
    }
}
#
#   Generate a certificate request.
#   The openssl command is issued to create a local host key and
#   a certificate request.  The key is initially encoded.
#   We will eventually decode this, however, since the key
#   passphrase is open source we'll protect even the initial 
#   encoded key file too.  We'll need to decode the keyfile since
#   otherwise, openssl will need a passphrase everytime an ssl connection
#   is created (ouch).
# Implicit Inputs:
#    Passphrase   - Initial passphrase for the encoded key.
#    RequestFile  - Filename of the certificate request.
#    EncodedKey   - Filename of the encoded key file.
#
# Side-Effects:
#
sub GenerateRequest {
    Debug("Generating the request and key");

    print "We are now going to generate the certificate request\n";
    print "You will be prompted by openssl for several pieces of \n";
    print "information.  Most of this information is for documentation\n";
    print "purposes only, so it's not critical if you make a mistake.\n";
    print "However:  The generated certificate will be sent to the \n";
    print "Email address you provide, and you should leave the optional\n";
    print "Challenge password blank.\n";

    my $requestcmd = $SSLCommand." req -newkey rsa:1024 "
                                ." -keyout hostkey.pem "
                                ." -keyform PEM "
                                ." -out request.pem "
                                ." -outform PEM "
                                ." -passout pass:$Passphrase";
    my $status = system($requestcmd);
    if($status) {
	die "Certificate request generation failed: $status";
    }

    chmod(0600, "hostkey.pem");	# Protect key since passphrase is opensrc.

    Debug("Decoding the key");
    my $decodecmd = $SSLCommand." rsa -in  hostkey.pem"
                               ."     -out hostkey.dec"
                               ."     -passin pass:$Passphrase";
    $status = system($decodecmd);
    if($status) {
	die "Host key decode failed";
    }

    chmod(0600, "hostkey.dec");	# Protect the decoded hostkey.

    #  Create the textual version of the request too:

    Debug("Creating textual version of the request for users.");
    my $textcmd = $SSLCommand." req -in request.pem -text "
	                     ." -out request.txt";
    $status = system($textcmd);
    if($status) {
	die "Textualization of the certificate request failed";
    }
	                     

    Debug("Done");
}
#
#  Installs the decoded host key (hostkey.dec) in the 
#  certificate directory with the correct permissions.
#
# Implicit Inputs:
#    hostkey.dec           - the name of the host key file.
#    $CertificateDirectory - where the key file gets installed
#    $KeyFilename          - Final name of the key file.
#    $WebUser              - User who should own the key file.
#    $WebGroup             - Group who should own the key file.
#    0400                  - Permissions to give to the installed key
#                            file.
#    0700                  - Permissions given to the certificate
#                            directory if created.
# Side-Effects:
#    If necessary, $CertificateDirectory is created.
#    $CertificateDirectory/$KeyFilename is ovewritten with the
#          contents of hostkey.dec in the cwd.
#
sub InstallKey {
    Debug("InstallKey");

    Debug("Need to create certificate directory?");
    if(!(-d $CertificateDirectory)) {
	
	Debug("Creating");
	mkdir($CertificateDirectory, 0700);
	chown($WebUID, $WebGID, $CertificateDirectory);
    }
    else {
	Debug("Exists");
    }

    Debug("Installing the key file:");
    my $FullKeyPath = $CertificateDirectory."/".$KeyFilename;
    copy("hostkey.dec", $FullKeyPath);

    Debug("Setting ownership and permissions");
    chmod(0400, $FullKeyPath);
    chown($WebUID, $WebGID, $FullKeyPath);

    Debug("Done");
}
#
#  Package up a certificate request and email it to the loncapa
#  admin.  The email sent:
#   - Has the subject: "LonCAPA certificate request for hostname
#   - Has, as the body, the text version of the certificate.
#     This can be inspected by the human issuing the certificate
#     to decide if they want to really grant it... it will
#     have the return email and all the documentation fields.
#   - Has a text attachment that consists of the .pem version of the
#     request.  This is extracted by the human granting the 
#     certificate and used as input to the CrGrant.pl script.
#
#
# Implicit inputs:
#    request.pem    - The certificate request file.
#    request.txt    - Textual version of the request file.
#    $RequestEmail  - Email address to which the key is sent.
#  
sub MailRequest {
    Debug("Mailing request");

    # First we need to pull out the return address from the textual
    # form of the certificate request:

    my $FromEmail = DecodeEmailFromRequest("request.txt");
    if(!$FromEmail) {
	die "From email address cannot be decoded from certificate request";
    }
    Debug("Certificate will be sent back to $FromEmail");

    # Create the email message headers and all:
    #
    Debug("Creating top...level...");
    my $top = MIME::Entity->build(Type     => "multipart/mixed",
				  From     => $FromEmail,
				  To       => $RequestEmail,
				  Subject  => "LonCAPA certificate request");
    if(!$top) {
	die "Unable to create top level mime document";
    }
    Debug("Attaching Text formatted certificate request");
    $top->attach(Path     => "request.txt");


    Debug("Attaching PEM formatted certificate request...");
    $top->attach(Type       => "text/plain",
		 Path      => "request.pem");

    #  Now send the email via sendmail this should work as long as
    #  sendmail or postfix are configured properly.  Most other mailers
    #  define the sendmail command too for compatibility with what
    #  we're trying to do.  I decided to use sendmail directly because
    #  otherwise I'm not sure the mail headers I created in $top
    #  will get properly passed as headers to other mailer thingies.
    #

    Debug("Mailing..");

    open MAILPIPE, "| /usr/lib/sendmail -t -oi -oem" or 
	die "Failed to open pipe to sendmail: $!";
    $top->print(\*MAILPIPE);
    close MAILPIPE;



    Debug("Done");
} 
sub Cleanup {}



#  Entry point:

Debug("Starting program");
ReadConfig;			# Read loncapa apache config file.
GenerateRequest;		# Generate certificate request.
InstallKey;			# Install the user's key.
MailRequest;			# Mail certificate request to loncapa 
Cleanup;			# Cleanup temp files created.

Debug("Done");