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>
![[BACK]](/icons/back.gif){kind=icon}
Return to CrGrant.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom