Diff for /loncom/CrGenerate.pl between versions 1.2 and 1.6

version 1.2, 2004/06/29 11:13:08 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;
   
 #  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 86  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);
   
 sub ReadConfig {}      Debug("Done");
 sub GenerateRequest {}  }
 sub InstallKey {}  #
 sub MailRequest {}  #  Package up a certificate request and email it to the loncapa
 sub Cleanup {}  #  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!");
   }
   
   
   

Removed from v.1.2  
changed lines
  Added in v.1.6


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