Annotation of loncom/CrGenerate.pl, revision 1.5

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

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