Annotation of loncom/CrGrant.pl, revision 1.2

1.1       foxr        1: #!/usr/bin/perl
                      2: # The LearningOnline Network
                      3: # CrGrant.pl  - Grant a loncapa SSL certificate.
                      4: #
1.2     ! foxr        5: # $Id: CrGrant.pl,v 1.1 2004/07/02 10:51:18 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: # This script operates on a certificate request that has been
                     32: # extracted from the attachment sent to the loncapa certificate 
                     33: # administrator and:
                     34: #
                     35: #  1. Creates an ssl certificate corresponding to the request.
                     36: #  2. Constructs an installation script that will install
                     37: #     the certificate along with the certificate authority's
                     38: #     certificate in a loncapa system.
                     39: #  3. Constructs an email which contains a cover letter 
                     40: #     describing what to do with the attachment, and an
                     41: #     attachment that consists of the installation script
                     42: #     created in step 2.
                     43: #  4. Emails the message to the email address in the certificate
                     44: #     request.
                     45: #
                     46: #  There are some assumptions we need to make in order to
                     47: #  get this all to work:
                     48: #    - The certificate authority is installed on a 
                     49: #      loncapa system with configuration files that specify
                     50: #      the same certificate directory and certificate filenames
                     51: #      as the target system (otherwise we can't generate the
                     52: #      installation script).
                     53: #    - The loncapa certificate authority configuration file is
                     54: #      $SSLDir/loncapaca.cnf and that it specifies that:
                     55: #      o The certificate authority files are in $SSLDir/loncapaca
                     56: #      o The certificate authority certificate is in:
                     57: #         $SSLDir/loncapaca/cacert.pem
1.2     ! foxr       58: #      o Only one instance of this script will be run at a time in
        !            59: #        this directory.
1.1       foxr       60: #      o The person that runs this script knows the passphrase
                     61: #        for the loncapa certificate authority's private key
                     62: #        which remains encrypted for security reasons.
                     63: #
                     64: #
                     65: 
                     66: # Import section:
                     67: 
                     68: use strict;
                     69: use lib '/home/httpd/lib/perl';
                     70: use MIME::Entity;
                     71: use LONCAPA::Configuration;
                     72: 
                     73: 
                     74: 
                     75: # Global variable declarations
                     76: 
1.2     ! foxr       77: my $ssl_command   = "/usr/bin/openssl "; # Command to run openssl.
        !            78: my $ssl_dir       = "/usr/share/ssl";    # Where ssl config files etc. live
        !            79: my $ca_cert_file  = $ssl_dir."/loncapa/cacert.pem"; # CA's certificate file.
        !            80: my $ca_config_file= $ssl_dir."/loncapaca.cnf";      # CA's config file. 
1.1       foxr       81: 
1.2     ! foxr       82:  
1.1       foxr       83: 
                     84: # Debug/log support
                     85: 
                     86: my $DEBUG=1;
                     87: 
                     88: sub Debug {
                     89:     my $msg = shift;
                     90:     if($DEBUG) {
                     91: 	print STDERR "$msg\n";
                     92:     }
                     93: }
                     94: #  Support subs:
                     95: 
1.2     ! foxr       96: #
        !            97: #   Print out program usage.
        !            98: #
        !            99: # Side effects:
        !           100: #    Output goes to stderr.
        !           101: #
        !           102: sub Usage {
        !           103:     print STDERR << "USAGE";
        !           104: 
        !           105: Usage:
        !           106:    CrGrant.pl requestfile.pem
1.1       foxr      107: 
1.2     ! foxr      108: Where:
        !           109:    requestfile.pem is a PEM formatted certificate extracted from an email 
        !           110:                    to the LonCAPA certificate manager.
        !           111: USAGE
        !           112: 
        !           113: }
        !           114: #  Create a certificate from the request file.  The certificate
        !           115: #  is used, in conjunction with the openssl command with the 
        !           116: #  certificate authority configuration to produce a certificate
        !           117: #  file.
        !           118: #
        !           119: #  The certificate is parsed to determine the email address
        !           120: #  of the requestor, which is returned to the caller.
        !           121: #
        !           122: #Parameters:
        !           123: #     request_file   - Name of the file containing the certificate request.
        !           124: #Returns:
        !           125: #     If the request file exists and is able to produce a certificate
        !           126: #     the email address of the requester is returned to the caller.
        !           127: #     If not, undef is returned.
        !           128: #
1.1       foxr      129: sub CreateCertificate {
1.2     ! foxr      130:     my ($request_file) = @_;
        !           131: 
        !           132:     Debug("CreateCertificate");
        !           133: 
        !           134:     if(!(-e $request_file)) {
        !           135: 	Debug("Certificate file $request_file does not exist");
        !           136: 	return undef;
        !           137:     }
        !           138:     Debug("Certificate file $request_file exists");
        !           139: 
        !           140:     # Create the certificate:  The status of the openssl command
        !           141:     # is used to determine if the certificate succeeded:
        !           142: 
        !           143:     my $create_command = $ssl_command." ca -config ".$ca_config_file
        !           144: 	                             ." -in ".$request_file
        !           145: 				     ." -out hostCertificate.pem";
        !           146:     my $status = system($create_command);
        !           147:     if($status) {
        !           148: 	Debug("openssl ca failed");
        !           149: 	print STDERR "Certificate generation failed... probably bad";
        !           150: 	print STDERR " request file!\n";
        !           151: 	return undef;
        !           152:     }
        !           153:     Debug("openssl ca succeeded");
        !           154: 
        !           155:     #  Now we have a shining new signed certificate in ./hostCertificate.pem
        !           156:     #  we parse it to get the email address to which the certificate should
        !           157:     #  be emailed.
        !           158:     #   The certificate's return email address will be in the Subject line:
        !           159:     #
        !           160: 
        !           161:     Debug("Parsing certificate file for Subject:");
        !           162:     open CERTIFICATE, "<hostCertificate.pem";
        !           163:     my $line;
        !           164:     my $subject_found = 0;
        !           165:     while ($line = <CERTIFICATE>) {
        !           166: 	Debug("Line = $line");
        !           167: 	if($line =~ /Subject:/) {
        !           168: 	    Debug("Found Subject: in $line");
        !           169: 	    $subject_found =1;
        !           170: 	    last;
        !           171: 	}
        !           172:     }
        !           173:     close CERTIFICATE;
        !           174: 
        !           175:     if(!$subject_found) {
        !           176: 	Debug("Did not find Subject line in cert");
        !           177: 	print STDERR "Output certificate parse failed: no Subject:\n";
        !           178: 	return undef;
        !           179:     }
        !           180:     #  The subject line contains an Email= string amidst the other stuff.
        !           181:     #  First break in to comma separated stuff, then locate the piece that
        !           182:     #  contains /Email=
        !           183: 
        !           184:     my @subject_fields = split(/,/, $line);
        !           185:     my $email_found = 0;
        !           186:     my $element;
        !           187:     my $email_element;
        !           188:     Debug("Parsing subject line for Email=");
        !           189:     foreach $element (@subject_fields) {
        !           190: 	$email_element = $element;
        !           191: 	Debug("Parsing $element");
        !           192: 	if($element =~ /\/Email=/) {
        !           193: 	    Debug("Found /Email=");
        !           194: 	    $email_found = 1;
        !           195: 	    last;
        !           196: 	}
        !           197:     }
        !           198:     if(!$email_found) {
        !           199: 	Debug("Failed to fine Email=");
        !           200: 	print STDERR "Unable to find line with /Email= in cert. Subject\n";
        !           201: 	return undef;
        !           202:     }
        !           203: 
        !           204:     #  The piece we found must first be split at the /
        !           205:     #  to isolate the Email= part and then that part at the = to isolate
        !           206:     #  the address:
        !           207: 
        !           208:     Debug("Splitting $email_element at /");
        !           209:     my ($junk, $email) = split(/\//, $email_element);
        !           210:     Debug("Email part is $email");
        !           211:     my ($junk, $address) = split(/=/, $email);
        !           212:     Debug("CreateCertificate Returning $address to caller");
        !           213: 
        !           214:     return $address;
1.1       foxr      215: 
                    216: }
                    217: sub CreateInstallScript {}
                    218: 
                    219: sub CreateEmail {
                    220:     return "Dummy message";	# Stub.
                    221: }
                    222: 
                    223: sub SendEmail {
                    224:     my ($EmailAddress, $Message) = @_;
                    225: }
                    226: sub Cleanup {}
                    227: 
                    228: 
                    229: #  Program entry point
                    230: #   The usage is:
                    231: #     CrGrant.pl    {request_file}
                    232: #
                    233: 
                    234: my $argc = @ARGV;		# Count number of command parameters.
                    235: if($argc != 1) {
                    236:     Usage;
                    237:     exit -1;
                    238: }
                    239: my $CertificateRequest = $ARGV[0];
                    240: 
1.2     ! foxr      241: my $email_address = CreateCertificate($CertificateRequest);
        !           242: 
        !           243: if(!defined $email_address) {
        !           244:     print STDERR "Bad or missing certificate file!!";
        !           245:     Usage;
        !           246:     exit -1;
        !           247: }
        !           248: 
1.1       foxr      249: CreateInstallScript;
                    250: my $Message = CreateEmail;
1.2     ! foxr      251: SendEmail($email_address, $Message);
1.1       foxr      252: Cleanup;
                    253: 
                    254: # POD documentation.

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