File:  [LON-CAPA] / loncom / CrGrant.pl
Revision 1.2: download - view: text, annotated - select for diffs
Mon Jul 5 11:37:39 2004 UTC (19 years, 9 months ago) by foxr
Branches: MAIN
CVS tags: HEAD
Implemenet the actual certificate generation and parsing of the
certificate file to get the email address to receive the granted
certificates.

#!/usr/bin/perl
# The LearningOnline Network
# CrGrant.pl  - Grant a loncapa SSL certificate.
#
# $Id: CrGrant.pl,v 1.2 2004/07/05 11:37:39 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 operates on a certificate request that has been
# extracted from the attachment sent to the loncapa certificate 
# administrator and:
#
#  1. Creates an ssl certificate corresponding to the request.
#  2. Constructs an installation script that will install
#     the certificate along with the certificate authority's
#     certificate in a loncapa system.
#  3. Constructs an email which contains a cover letter 
#     describing what to do with the attachment, and an
#     attachment that consists of the installation script
#     created in step 2.
#  4. Emails the message to the email address in the certificate
#     request.
#
#  There are some assumptions we need to make in order to
#  get this all to work:
#    - The certificate authority is installed on a 
#      loncapa system with configuration files that specify
#      the same certificate directory and certificate filenames
#      as the target system (otherwise we can't generate the
#      installation script).
#    - The loncapa certificate authority configuration file is
#      $SSLDir/loncapaca.cnf and that it specifies that:
#      o The certificate authority files are in $SSLDir/loncapaca
#      o The certificate authority certificate is in:
#         $SSLDir/loncapaca/cacert.pem
#      o Only one instance of this script will be run at a time in
#        this directory.
#      o The person that runs this script knows the passphrase
#        for the loncapa certificate authority's private key
#        which remains encrypted for security reasons.
#
#

# Import section:

use strict;
use lib '/home/httpd/lib/perl';
use MIME::Entity;
use LONCAPA::Configuration;



# Global variable declarations

my $ssl_command   = "/usr/bin/openssl "; # Command to run openssl.
my $ssl_dir       = "/usr/share/ssl";    # Where ssl config files etc. live
my $ca_cert_file  = $ssl_dir."/loncapa/cacert.pem"; # CA's certificate file.
my $ca_config_file= $ssl_dir."/loncapaca.cnf";      # CA's config file. 

 

# Debug/log support

my $DEBUG=1;

sub Debug {
    my $msg = shift;
    if($DEBUG) {
	print STDERR "$msg\n";
    }
}
#  Support subs:

#
#   Print out program usage.
#
# Side effects:
#    Output goes to stderr.
#
sub Usage {
    print STDERR << "USAGE";

Usage:
   CrGrant.pl requestfile.pem

Where:
   requestfile.pem is a PEM formatted certificate extracted from an email 
                   to the LonCAPA certificate manager.
USAGE

}
#  Create a certificate from the request file.  The certificate
#  is used, in conjunction with the openssl command with the 
#  certificate authority configuration to produce a certificate
#  file.
#
#  The certificate is parsed to determine the email address
#  of the requestor, which is returned to the caller.
#
#Parameters:
#     request_file   - Name of the file containing the certificate request.
#Returns:
#     If the request file exists and is able to produce a certificate
#     the email address of the requester is returned to the caller.
#     If not, undef is returned.
#
sub CreateCertificate {
    my ($request_file) = @_;

    Debug("CreateCertificate");

    if(!(-e $request_file)) {
	Debug("Certificate file $request_file does not exist");
	return undef;
    }
    Debug("Certificate file $request_file exists");

    # Create the certificate:  The status of the openssl command
    # is used to determine if the certificate succeeded:

    my $create_command = $ssl_command." ca -config ".$ca_config_file
	                             ." -in ".$request_file
				     ." -out hostCertificate.pem";
    my $status = system($create_command);
    if($status) {
	Debug("openssl ca failed");
	print STDERR "Certificate generation failed... probably bad";
	print STDERR " request file!\n";
	return undef;
    }
    Debug("openssl ca succeeded");

    #  Now we have a shining new signed certificate in ./hostCertificate.pem
    #  we parse it to get the email address to which the certificate should
    #  be emailed.
    #   The certificate's return email address will be in the Subject line:
    #

    Debug("Parsing certificate file for Subject:");
    open CERTIFICATE, "<hostCertificate.pem";
    my $line;
    my $subject_found = 0;
    while ($line = <CERTIFICATE>) {
	Debug("Line = $line");
	if($line =~ /Subject:/) {
	    Debug("Found Subject: in $line");
	    $subject_found =1;
	    last;
	}
    }
    close CERTIFICATE;

    if(!$subject_found) {
	Debug("Did not find Subject line in cert");
	print STDERR "Output certificate parse failed: no Subject:\n";
	return undef;
    }
    #  The subject line contains an Email= string amidst the other stuff.
    #  First break in to comma separated stuff, then locate the piece that
    #  contains /Email=

    my @subject_fields = split(/,/, $line);
    my $email_found = 0;
    my $element;
    my $email_element;
    Debug("Parsing subject line for Email=");
    foreach $element (@subject_fields) {
	$email_element = $element;
	Debug("Parsing $element");
	if($element =~ /\/Email=/) {
	    Debug("Found /Email=");
	    $email_found = 1;
	    last;
	}
    }
    if(!$email_found) {
	Debug("Failed to fine Email=");
	print STDERR "Unable to find line with /Email= in cert. Subject\n";
	return undef;
    }

    #  The piece we found must first be split at the /
    #  to isolate the Email= part and then that part at the = to isolate
    #  the address:

    Debug("Splitting $email_element at /");
    my ($junk, $email) = split(/\//, $email_element);
    Debug("Email part is $email");
    my ($junk, $address) = split(/=/, $email);
    Debug("CreateCertificate Returning $address to caller");

    return $address;

}
sub CreateInstallScript {}

sub CreateEmail {
    return "Dummy message";	# Stub.
}

sub SendEmail {
    my ($EmailAddress, $Message) = @_;
}
sub Cleanup {}


#  Program entry point
#   The usage is:
#     CrGrant.pl    {request_file}
#

my $argc = @ARGV;		# Count number of command parameters.
if($argc != 1) {
    Usage;
    exit -1;
}
my $CertificateRequest = $ARGV[0];

my $email_address = CreateCertificate($CertificateRequest);

if(!defined $email_address) {
    print STDERR "Bad or missing certificate file!!";
    Usage;
    exit -1;
}

CreateInstallScript;
my $Message = CreateEmail;
SendEmail($email_address, $Message);
Cleanup;

# POD documentation.

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>