Return to CrGenerate.pl CVS log

Up to [LON-CAPA] / loncom

Code the cleanup function.
Add use lib '/home/httpd/lib/perl'
I have a chicken and egg problem that I can't figure out where this is with
without already knowing where this is... If there's a better way to ensure
that I get these libs.  Plese let me know.

    1: #!/usr/bin/perl
    2: # The LearningOnline Network
    3: # CrGenerate - Generate a loncapa certificate request.
    4: #
    5: # $Id: CrGenerate.pl,v 1.6 2004/07/02 09:43:40 foxr Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or 
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: 
   28: 
   29: # http://www.lon-capa.org/
   30: #
   31: #
   32: #  This script:
   33: #  1. Generates a private host key and certificate request/
   34: #  2. Decodes the private host key
   35: #  3. Installs the private host key with appropriate permissions
   36: #     in the  appropriate directory (sorry to be vague about this, but
   37: #     the installation directory is determined by external configuration
   38: #     info).
   39: # 4. Constructs an email to the loncapa cluster administrator
   40: #    consisting of a generic heading and the certificate request as a MIME
   41: #    attachment.
   42: # 5. Sends the email and
   43: # 6. Cleans up after itself by removing any temp files generated.
   44: #
   45: #
   46: 
   47: 
   48: # Import section:
   49: 
   50: use strict;
   51: use lib '/home/httpd/lib/perl';
   52: use MIME::Entity;
   53: use LONCAPA::Configuration;
   54: use File::Copy;
   55: 
   56: #  Global variable declarations:4
   57: 
   58: my $SSLCommand;			  # Full path to openssl command.
   59: my $CertificateDirectory;	  # LONCAPA Certificate directory.
   60: my $KeyFilename;	          # Key filename (within CertificateDirectory).
   61: my $RequestEmail;		  # Email address of loncapa cert admin.
   62: my $WebUID;			# UID of web user.
   63: my $WebGID;			# GID of web user.
   64: 
   65: my $Passphrase="loncapawhatever";      # Initial passphrase for keyfile
   66: my $RequestFile="loncapaRequest.pem";  # Name of Certificate request file.
   67: my $EncodedKey="hostkey.pem";	       # Name of encoded key file.
   68: 
   69: my $WebUser="www";		# Username running the web server.
   70: my $WebGroup="www";		# Group name running the web server.
   71: 
   72: #   Debug/log support:
   73: #
   74: my $DEBUG = 1;			# 1 for on, 0 for off.
   75: 
   76: # Send debugging to stderr.
   77: # Parameters:
   78: #     msg   - Message to send to stderr.
   79: # Implicit Inputs:
   80: #    $DEBUG - message is only written if this is true.
   81: #
   82: sub Debug {
   83:     my $msg  = shift;
   84:     if($DEBUG) {
   85: 	print STDERR "$msg\n";
   86:     }
   87: }
   88: 
   89: #
   90: #  Decodes the email address from a textual certificate request
   91: #  file:
   92: # Parameters:
   93: #    $RequestFile   - Name of the file containing the textual
   94: #                     version of the certificate request.
   95: # Returns:
   96: #   Email address contained in the request.
   97: # Failure:
   98: #   If unable to open or unable to fine an email address in the file,
   99: #   dies with a message.
  100: #
  101: sub DecodeEmailFromRequest {
  102:     Debug("DecodeEmailFromRequest");
  103: 
  104:     my $RequestFile = shift;
  105:     Debug("Request file is called $RequestFile");
  106: 
  107:     # We need to look for the line that has a "/Email=" in it.
  108: 
  109:     Debug("opening $RequestFile");
  110:     open REQUEST, "< $RequestFile" or
  111: 	die "Unable to open $RequestFile to parse return email address";
  112: 
  113:     Debug("Parsing request file");
  114:     my $line;
  115:     my $found = 0;
  116:     while($line = <REQUEST>) {
  117: 	chomp($line);		# Never a bad idea.
  118: 	if($line =~ /\/Email=/) {
  119: 	    $found = 1;
  120: 	    last;
  121: 	}
  122:     }
  123:     if(!$found) {
  124: 	die "There does not appear to be an email address in $RequestFile";
  125:     }
  126: 
  127:     close REQUEST;
  128: 
  129:     Debug("Found /Email in $line");
  130:     
  131:     # $line contains a bunch of comma separated key=value pairs.
  132:     # The problem is that after these is a /Email=<what-we-want>
  133:     # first we'll split the line up at the commas.
  134:     # Then we'll look for the entity with the /Email in it.
  135:     # That line will get split at the / and then the Email=<what-we-want>
  136:     # gets split at the =.  I'm sure there's some clever regular expression
  137:     # substitution that will get it all in a single line, but I think 
  138:     # this approach is gonna be much easier to understand than punctuation
  139:     # sneezed all over the page:
  140:    
  141:     my @commalist = split(/,/, $line);
  142:     my $item;
  143:     my $emailequals = "";
  144:     foreach $item  (@commalist) {
  145: 	if($item =~ /\/Email=/) { # gotcha...
  146: 	    $emailequals = $item;
  147: 	    last;
  148: 	}
  149:     }
  150: 
  151:     Debug("Pulled out $emailequals from $line");
  152:     my ($trash, $addressequals) = split(/\//, $emailequals);
  153:     Debug("Futher pulled out $addressequals");
  154: 
  155:     my ($junk, $address) = split(/=/, $addressequals);
  156:     Debug("Parsed final email addresss as $address");
  157:     
  158: 
  159: 
  160:     return $address;
  161: }
  162: 
  163: #
  164: #   Read the LonCAPA web config files to get the values of the 
  165: #   configuration global variables we need:
  166: # Implicit inputs:
  167: #   loncapa.conf   - configuration file to read (user specific).
  168: # Implicit outputs (see global variables section):
  169: #   SSLCommand,
  170: #   CertificateDirectory
  171: #   KeyfileName
  172: #   RequestEmail
  173: # Side-Effects:
  174: #   Exit with error if cannot complete.
  175: #
  176: sub ReadConfig {
  177: 
  178:     Debug("Reading configuration");
  179:     my $perlvarref = LONCAPA::Configuration::read_conf('loncapa.conf');
  180:     
  181:     # Name of the SSL Program
  182: 
  183:     if($perlvarref->{SSLProgram}) {
  184: 	$SSLCommand = $perlvarref->{SSLProgram};
  185: 	Debug("SSL Command: $SSLCommand");
  186:     }
  187:     else {
  188: 	die "Unable to read the SSLCommand configuration option\n";
  189:     }
  190: 
  191:     # Where the certificates, and host key are installed:
  192: 
  193:     if($perlvarref->{lonCertificateDirectory}) {
  194: 	$CertificateDirectory = $perlvarref->{lonCertificateDirectory};
  195: 	Debug("Local certificate Directory: $CertificateDirectory");
  196:     }
  197:     else {
  198: 	die "Unable to read SSLDirectory configuration option\n";
  199:     }
  200:     # The name of the host key file (to be installed in SSLDirectory).
  201:     #
  202:     if($perlvarref->{lonnetPrivateKey}) {
  203: 	$KeyFilename  = $perlvarref->{lonnetPrivateKey};
  204: 	Debug("Private key will be installed as $KeyFilename");
  205:     } 
  206:     else {
  207: 	die "Unable to read lonnetPrivateKey conrig paraemter\n";
  208:     }
  209:     #  The email address to which the certificate request is sent:
  210: 
  211:     if($perlvarref->{SSLEmail}) {
  212: 	$RequestEmail = $perlvarref->{SSLEmail};
  213: 	Debug("Certificate request will be sent to $RequestEmail");
  214:     }
  215:     else {
  216: 	die "Could not read SSLEmail coniguration key";
  217:     }
  218:     #  The UID/GID of the web user: It's possible the web user's
  219:     #  GID is not its primary, so we'll translate that form the
  220:     #  group file separately.
  221: 
  222:     my ($login, $pass, $uid, $gid) = getpwnam($WebUser);
  223:     if($uid) {
  224: 	$WebUID = $uid;
  225: 	Debug("Web user: $WebUser -> UID: $WebUID");
  226:     }
  227:     else {
  228: 	die "Could not translate web user: $WebUser to a uid.";
  229:     }
  230:     my $gid = getgrnam($WebGroup);
  231:     if($gid) {
  232: 	$WebGID = $gid;
  233: 	Debug("Web group: $WebGroup -> GID $WebGID");
  234:     }
  235:     else {
  236: 	die "Unable to translate web group $WebGroup to a gid.";
  237:     }
  238: }
  239: #
  240: #   Generate a certificate request.
  241: #   The openssl command is issued to create a local host key and
  242: #   a certificate request.  The key is initially encoded.
  243: #   We will eventually decode this, however, since the key
  244: #   passphrase is open source we'll protect even the initial 
  245: #   encoded key file too.  We'll need to decode the keyfile since
  246: #   otherwise, openssl will need a passphrase everytime an ssl connection
  247: #   is created (ouch).
  248: # Implicit Inputs:
  249: #    Passphrase   - Initial passphrase for the encoded key.
  250: #    RequestFile  - Filename of the certificate request.
  251: #    EncodedKey   - Filename of the encoded key file.
  252: #
  253: # Side-Effects:
  254: #
  255: sub GenerateRequest {
  256:     Debug("Generating the request and key");
  257: 
  258:     print "We are now going to generate the certificate request\n";
  259:     print "You will be prompted by openssl for several pieces of \n";
  260:     print "information.  Most of this information is for documentation\n";
  261:     print "purposes only, so it's not critical if you make a mistake.\n";
  262:     print "However:  The generated certificate will be sent to the \n";
  263:     print "Email address you provide, and you should leave the optional\n";
  264:     print "Challenge password blank.\n";
  265: 
  266:     my $requestcmd = $SSLCommand." req -newkey rsa:1024 "
  267:                                 ." -keyout hostkey.pem "
  268:                                 ." -keyform PEM "
  269:                                 ." -out request.pem "
  270:                                 ." -outform PEM "
  271:                                 ." -passout pass:$Passphrase";
  272:     my $status = system($requestcmd);
  273:     if($status) {
  274: 	die "Certificate request generation failed: $status";
  275:     }
  276: 
  277:     chmod(0600, "hostkey.pem");	# Protect key since passphrase is opensrc.
  278: 
  279:     Debug("Decoding the key");
  280:     my $decodecmd = $SSLCommand." rsa -in  hostkey.pem"
  281:                                ."     -out hostkey.dec"
  282:                                ."     -passin pass:$Passphrase";
  283:     $status = system($decodecmd);
  284:     if($status) {
  285: 	die "Host key decode failed";
  286:     }
  287: 
  288:     chmod(0600, "hostkey.dec");	# Protect the decoded hostkey.
  289: 
  290:     #  Create the textual version of the request too:
  291: 
  292:     Debug("Creating textual version of the request for users.");
  293:     my $textcmd = $SSLCommand." req -in request.pem -text "
  294: 	                     ." -out request.txt";
  295:     $status = system($textcmd);
  296:     if($status) {
  297: 	die "Textualization of the certificate request failed";
  298:     }
  299: 	                     
  300: 
  301:     Debug("Done");
  302: }
  303: #
  304: #  Installs the decoded host key (hostkey.dec) in the 
  305: #  certificate directory with the correct permissions.
  306: #
  307: # Implicit Inputs:
  308: #    hostkey.dec           - the name of the host key file.
  309: #    $CertificateDirectory - where the key file gets installed
  310: #    $KeyFilename          - Final name of the key file.
  311: #    $WebUser              - User who should own the key file.
  312: #    $WebGroup             - Group who should own the key file.
  313: #    0400                  - Permissions to give to the installed key
  314: #                            file.
  315: #    0700                  - Permissions given to the certificate
  316: #                            directory if created.
  317: # Side-Effects:
  318: #    If necessary, $CertificateDirectory is created.
  319: #    $CertificateDirectory/$KeyFilename is ovewritten with the
  320: #          contents of hostkey.dec in the cwd.
  321: #
  322: sub InstallKey {
  323:     Debug("InstallKey");
  324: 
  325:     Debug("Need to create certificate directory?");
  326:     if(!(-d $CertificateDirectory)) {
  327: 	
  328: 	Debug("Creating");
  329: 	mkdir($CertificateDirectory, 0700);
  330: 	chown($WebUID, $WebGID, $CertificateDirectory);
  331:     }
  332:     else {
  333: 	Debug("Exists");
  334:     }
  335: 
  336:     Debug("Installing the key file:");
  337:     my $FullKeyPath = $CertificateDirectory."/".$KeyFilename;
  338:     copy("hostkey.dec", $FullKeyPath);
  339: 
  340:     Debug("Setting ownership and permissions");
  341:     chmod(0400, $FullKeyPath);
  342:     chown($WebUID, $WebGID, $FullKeyPath);
  343: 
  344:     Debug("Done");
  345: }
  346: #
  347: #  Package up a certificate request and email it to the loncapa
  348: #  admin.  The email sent:
  349: #   - Has the subject: "LonCAPA certificate request for hostname
  350: #   - Has, as the body, the text version of the certificate.
  351: #     This can be inspected by the human issuing the certificate
  352: #     to decide if they want to really grant it... it will
  353: #     have the return email and all the documentation fields.
  354: #   - Has a text attachment that consists of the .pem version of the
  355: #     request.  This is extracted by the human granting the 
  356: #     certificate and used as input to the CrGrant.pl script.
  357: #
  358: #
  359: # Implicit inputs:
  360: #    request.pem    - The certificate request file.
  361: #    request.txt    - Textual version of the request file.
  362: #    $RequestEmail  - Email address to which the key is sent.
  363: #  
  364: sub MailRequest {
  365:     Debug("Mailing request");
  366: 
  367:     # First we need to pull out the return address from the textual
  368:     # form of the certificate request:
  369: 
  370:     my $FromEmail = DecodeEmailFromRequest("request.txt");
  371:     if(!$FromEmail) {
  372: 	die "From email address cannot be decoded from certificate request";
  373:     }
  374:     Debug("Certificate will be sent back to $FromEmail");
  375: 
  376:     # Create the email message headers and all:
  377:     #
  378:     Debug("Creating top...level...");
  379:     my $top = MIME::Entity->build(Type     => "multipart/mixed",
  380: 				  From     => $FromEmail,
  381: 				  To       => $RequestEmail,
  382: 				  Subject  => "LonCAPA certificate request");
  383:     if(!$top) {
  384: 	die "Unable to create top level mime document";
  385:     }
  386:     Debug("Attaching Text formatted certificate request");
  387:     $top->attach(Path     => "request.txt");
  388: 
  389: 
  390:     Debug("Attaching PEM formatted certificate request...");
  391:     $top->attach(Type       => "text/plain",
  392: 		 Path      => "request.pem");
  393: 
  394:     #  Now send the email via sendmail this should work as long as
  395:     #  sendmail or postfix are configured properly.  Most other mailers
  396:     #  define the sendmail command too for compatibility with what
  397:     #  we're trying to do.  I decided to use sendmail directly because
  398:     #  otherwise I'm not sure the mail headers I created in $top
  399:     #  will get properly passed as headers to other mailer thingies.
  400:     #
  401: 
  402:     Debug("Mailing..");
  403: 
  404:     open MAILPIPE, "| /usr/lib/sendmail -t -oi -oem" or 
  405: 	die "Failed to open pipe to sendmail: $!";
  406:     $top->print(\*MAILPIPE);
  407:     close MAILPIPE;
  408: 
  409: 
  410: 
  411:     Debug("Done");
  412: } 
  413: 
  414: #
  415: #   Cleans up the detritus that's been created by this 
  416: #   script (see Implicit inputs below).
  417: # Implicit inputs:
  418: #    request.pem       - Name of certificate request file in PEM format
  419: #                        which will be deleted.
  420: #    request.txt       - Name of textual equivalent of request file
  421: #                        which will also be deleted.
  422: #    hostkey.pem       - Encrypted host key which will be deleted.
  423: #    hostkey.dec       - Decoded host key, which will be deleted.
  424: #
  425: sub Cleanup {
  426:     Debug("Cleaning up generated, temporary files");
  427:     unlink("request.pem", "request.txt", "hostkey.pem", "hostkey.dec");
  428:     Debug("done!");
  429: }
  430: 
  431: 
  432: 
  433: #  Entry point:
  434: 
  435: Debug("Starting program");
  436: ReadConfig;			# Read loncapa apache config file.
  437: GenerateRequest;		# Generate certificate request.
  438: InstallKey;			# Install the user's key.
  439: MailRequest;			# Mail certificate request to loncapa 
  440: Cleanup;			# Cleanup temp files created.
  441: 
  442: Debug("Done");