version 1.2, 2004/06/29 11:13:08
|
version 1.5, 2004/07/01 10:58:29
|
Line 49
|
Line 49
|
|
|
use strict; |
use strict; |
use MIME::Entity; |
use MIME::Entity; |
use Mail::Mailer; |
|
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
|
use File::Copy; |
|
|
# Global variable declarations: |
# Global variable declarations:4 |
|
|
my $SSLCommand; # Full path to openssl command. |
my $SSLCommand; # Full path to openssl command. |
my $CertificateDirectory; # LONCAPA Certificate directory. |
my $CertificateDirectory; # LONCAPA Certificate directory. |
my $KeyFilename; # Key filename (within CertificateDirectory). |
my $KeyFilename; # Key filename (within CertificateDirectory). |
my $Passphrase="loncapawhatever"; # Initial passphrase for keyfile |
|
my $RequestEmail; # Email address of loncapa cert admin. |
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: |
# Debug/log support: |
# |
# |
Line 77 sub Debug {
|
Line 85 sub Debug {
|
} |
} |
} |
} |
|
|
|
# |
|
# 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; |
|
|
|
|
|
|
sub ReadConfig {} |
Debug("Done"); |
sub GenerateRequest {} |
} |
sub InstallKey {} |
|
sub MailRequest {} |
|
sub Cleanup {} |
sub Cleanup {} |
|
|
|
|