[LON-CAPA-cvs] cvs: loncom / CrGenerate.pl
foxr
lon-capa-cvs@mail.lon-capa.org
Thu, 01 Jul 2004 10:58:30 -0000
foxr Thu Jul 1 06:58:30 2004 EDT
Modified files:
/loncom CrGenerate.pl
Log:
Added code to package up the certificate and mail it to a certificate manager.
Remaining work:
- Add Cleanup
- Add Pod documentation.
- Change debug value to 0 to make this less verbose.
Index: loncom/CrGenerate.pl
diff -u loncom/CrGenerate.pl:1.4 loncom/CrGenerate.pl:1.5
--- loncom/CrGenerate.pl:1.4 Wed Jun 30 07:14:35 2004
+++ loncom/CrGenerate.pl Thu Jul 1 06:58:29 2004
@@ -2,7 +2,7 @@
# The LearningOnline Network
# CrGenerate - Generate a loncapa certificate request.
#
-# $Id: CrGenerate.pl,v 1.4 2004/06/30 11:14:35 foxr Exp $
+# $Id: CrGenerate.pl,v 1.5 2004/07/01 10:58:29 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -49,7 +49,6 @@
use strict;
use MIME::Entity;
-use Mail::Mailer;
use LONCAPA::Configuration;
use File::Copy;
@@ -87,6 +86,80 @@
}
#
+# 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:
@@ -206,12 +279,24 @@
my $decodecmd = $SSLCommand." rsa -in hostkey.pem"
." -out hostkey.dec"
." -passin pass:$Passphrase";
- my $status = system($decodecmd);
+ $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");
}
#
@@ -257,7 +342,73 @@
Debug("Done");
}
-sub MailRequest {}
+#
+# 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 {}