version 1.4, 2004/06/30 11:14:35
|
version 1.6, 2004/07/02 09:43:40
|
Line 48
|
Line 48
|
# Import section: |
# Import section: |
|
|
use strict; |
use strict; |
|
use lib '/home/httpd/lib/perl'; |
use MIME::Entity; |
use MIME::Entity; |
use Mail::Mailer; |
|
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use File::Copy; |
use File::Copy; |
|
|
Line 87 sub Debug {
|
Line 87 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 |
# Read the LonCAPA web config files to get the values of the |
# configuration global variables we need: |
# configuration global variables we need: |
# Implicit inputs: |
# Implicit inputs: |
Line 206 sub GenerateRequest {
|
Line 280 sub GenerateRequest {
|
my $decodecmd = $SSLCommand." rsa -in hostkey.pem" |
my $decodecmd = $SSLCommand." rsa -in hostkey.pem" |
." -out hostkey.dec" |
." -out hostkey.dec" |
." -passin pass:$Passphrase"; |
." -passin pass:$Passphrase"; |
my $status = system($decodecmd); |
$status = system($decodecmd); |
if($status) { |
if($status) { |
die "Host key decode failed"; |
die "Host key decode failed"; |
} |
} |
|
|
chmod(0600, "hostkey.dec"); # Protect the decoded hostkey. |
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"); |
Debug("Done"); |
} |
} |
# |
# |
Line 257 sub InstallKey {
|
Line 343 sub InstallKey {
|
|
|
Debug("Done"); |
Debug("Done"); |
} |
} |
sub MailRequest {} |
# |
sub Cleanup {} |
# 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"); |
|
} |
|
|
|
# |
|
# Cleans up the detritus that's been created by this |
|
# script (see Implicit inputs below). |
|
# Implicit inputs: |
|
# request.pem - Name of certificate request file in PEM format |
|
# which will be deleted. |
|
# request.txt - Name of textual equivalent of request file |
|
# which will also be deleted. |
|
# hostkey.pem - Encrypted host key which will be deleted. |
|
# hostkey.dec - Decoded host key, which will be deleted. |
|
# |
|
sub Cleanup { |
|
Debug("Cleaning up generated, temporary files"); |
|
unlink("request.pem", "request.txt", "hostkey.pem", "hostkey.dec"); |
|
Debug("done!"); |
|
} |
|
|
|
|
|
|