--- loncom/CrGenerate.pl	2004/06/30 11:14:35	1.4
+++ loncom/CrGenerate.pl	2004/07/01 10:58:29	1.5
@@ -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 @@ 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:
@@ -206,12 +279,24 @@ sub GenerateRequest {
     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 @@ sub InstallKey {
 
     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 {}