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