Annotation of loncom/CrCA.pl, revision 1.4
1.1 raeburn 1: #!/usr/bin/perl
1.2 raeburn 2: # The LearningOnline Network with CAPA
3: # Script to create a Certificate Authority (CA) for a LON-CAPA cluster.
4: #
1.4 ! raeburn 5: # $Id: CrCA.pl,v 1.3 2019/07/08 23:00:16 raeburn Exp $
1.2 raeburn 6: #
7: # Copyright Michigan State University Board of Trustees
8: #
9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27:
1.1 raeburn 28: use strict;
29:
30: #
31: # Expected structure
32: #
33: # /lonca
34: # opensslca.cnf
35: # cacert.pem
36: # index.txt
37: # /certs
38: # /crl
39: # /private
40: # /requests
41: #
42:
43: print(<<END);
44:
45: ****** SSL Certificate Authority *****
46:
47: If you are running your own cluster of LON-CAPA nodes you will need to
48: create a Certificate Authority (CA) for your cluster. You will then use
49: the CA to sign LON-CAPA SSL certificate signing requests generated by
50: the nodes in your cluster.
51:
52: LON-CAPA SSL Certificates can be used in two different contexts:
53: (a) if you configure LON-CAPA to use a secure channel for exchange of
54: the shared encryption key when establishing an "internal" LON-CAPA
55: connection between nodes in your cluster, and (b) if you configure
56: LON-CAPA to use client SSL certificate validation when one node replicates
57: content from library node(s) in your cluster.
58:
59: Although a LON-CAPA cluster may contain multiple domains and/or multiple
60: library nodes, there will only be one LON-CAPA certificate authority (CA)
61: for the cluster. The CA certificate signing infrastructure need not be
62: housed on a LON-CAPA node; it can instead be installed on a separate
63: Linux instance. The instance housing the CA infrastructure needs to
64: have the following Linux packages installed:
65:
66: openssl
67: perl
68:
69: and the following perl modules from CPAN installed:
70:
71: Term::ReadKey
72: Sys::Hostname::FQDN
73: Locale::Country
74: Crypt::OpenSSL::X509
1.4 ! raeburn 75: Crypt::X509::CRL
! 76: MIME::Base64
1.1 raeburn 77: DateTime::Format::x509
78: File::Slurp
79:
80: You need to decide on a directory you wish to use to hold the
81: CA infrastructure. If necessary you should create a new directory.
82: Then move this script (CrCA.pl) to that directory, and run it with
83: the command: perl CrCA.pl
84:
85: The script will create any required subdirectories (and files)
86: within that directory, if they do not already exist.
87:
88: You will need to provide a password to be used for the openssl CA key
89: which will be stored in the /private subdirectory, and will be used
90: when signing certificate signing requests to create LON-CAPA certificates
91: for use in the cluster.
92:
93: END
94:
1.3 raeburn 95: print ('Continue? [Y/n]');
96: my $go_on = &get_user_selection(1);
97: if (!$go_on) {
98: exit;
99: }
100:
1.4 ! raeburn 101: eval { require Sys::Hostname::FQDN; };
! 102: if ($@) {
! 103: print "Could not find required perl module: Sys::Hostname::FQDN. Exiting.\n";
! 104: exit;
! 105: }
! 106: eval { require Term::ReadKey; };
! 107: if ($@) {
! 108: print "Could not find required perl module: Term::ReadKey. Exiting\n";
! 109: exit;
! 110: }
! 111: eval { require Locale::Country; };
! 112: if ($@) {
! 113: print "Could not find required perl module: Locale::Country. Exiting\n";
! 114: exit;
! 115: }
! 116: eval { require Crypt::OpenSSL::X509; };
! 117: if ($@) {
! 118: print "Could not find required perl module: Crypt::OpenSSL::X509. Exiting\n";
! 119: exit;
! 120: }
! 121: eval { require Crypt::X509::CRL; };
! 122: if ($@) {
! 123: print "Could not find required perl module: Crypt::X509::CRL. Exiting\n";
! 124: exit;
! 125: }
! 126: eval { require DateTime::Format::x509; };
! 127: if ($@) {
! 128: print "Could not find required perl module: DateTime::Format::x509. Exiting\n";
! 129: exit;
! 130: }
! 131: eval { require File::Slurp; };
! 132: if ($@) {
! 133: print "Could not find required perl module: File::Slurp. Exiting\n";
! 134: exit;
! 135: }
! 136: eval { require MIME::Base64; };
! 137: if ($@) {
! 138: print "Could not find required perl core module: MIME::Base64\n";
! 139: exit;
! 140: }
! 141: eval { require Cwd; };
! 142: if ($@) {
! 143: print "Could not find required perl core module: Cwd\n";
! 144: exit;
! 145: }
1.1 raeburn 146:
147: my ($dir,$hostname,%data);
148:
149: # Check if required subdirectories exist in current directory.
150: $dir = Cwd::getcwd();
151:
152: if (-e "$dir/lonca") {
153: if ((!-d "$dir/lonca") && (-f "$dir/lonca")) {
154: print "A lonca directory is required, but there is an existing file of that name.\n".
155: "Please either delete the lonca file, or change to a different directory, and ".
156: "create the CA infrastructure there.\n";
157: exit;
158: }
159: } else {
160: mkdir("$dir/lonca",0700);
161: system('chown root:root '."$dir/lonca");
162: }
163: if (-d "$dir/lonca") {
164: foreach my $subdir ('certs','crl','private','requests') {
165: if (!-d "$dir/lonca/$subdir") {
166: if (-f "$dir/lonca/$subdir") {
167: print "A $subdir sub-directory is required, but there is an existing file of that name.\n".
168: "Please either delete or move the $subdir file, then run this script again.\n";
169: exit;
170: } else {
171: mkdir("$dir/lonca/$subdir",0700);
172: system('chown root:root '."$dir/lonca/$subdir");
173: }
174: }
175: }
176: } else {
177: print "A lonca directory is required, but no directory exists\n";
178: exit;
179: }
180: if (-e "$dir/lonca/opensslca.conf") {
181: # retrieve existing config file and verify that if contains the required fields.
182: %data = &parse_config("$dir/lonca/opensslca.conf");
183: my %update = &confirm_config(%data);
184: my %changes;
185: foreach my $field ('clustername','organization','email','country','state','city','days','crldays') {
186: if ($data{$field} ne $update{$field}) {
187: $changes{$field} = $update{$field};
188: }
189: }
190: if (keys(%changes)) {
191: &save_config_changes("$dir/lonca/opensslca.conf",\%changes);
192: }
193: } else {
194: print(<<END);
195: ****** Certificate Authority Configuration File *****
196:
197: A configuration file: $dir/lonca/opensslca.conf will be created.
198:
199: The following information will be included:
1.3 raeburn 200: Country, State/Province, City, Cluster Name, Organizational Name, E-mail address, Default certificate lifetime (days), CRL re-creation interval (days)
1.1 raeburn 201:
202: END
203: $hostname = Sys::Hostname::FQDN::fqdn();
204: if ($hostname eq '') {
205: $hostname =&get_hostname();
206: } else {
207: print "Hostname detected: $hostname. Is that correct? [Y/n]";
208: if (!&get_user_selection(1)) {
209: $hostname =&get_hostname();
210: }
211: }
212:
213: my %fieldname = (
214: city => 'City',
215: state => 'State or Province',
216: clustername => 'Cluster name',
217: organization => 'Organization name',
218: );
1.3 raeburn 219: my ($clustername,$organization,$country,$state,$city,$email,$clusterhostname,$days,$crldays);
1.1 raeburn 220: $clusterhostname = $hostname;
221: $country = &get_country($hostname);
222: print "Enter state or province name\n";
223: $state = &get_info($fieldname{'state'});
224: print "Enter city name\n";
225: $city = &get_info($fieldname{'city'});
226: $email = &get_camail();
227: print 'Enter a name for this LON-CAPA cluster, e.g., "Lon-CAPA learning network"'."\n".
228: 'This name will be included as the Common Name for the CA certificate.'."\n";
229: $clustername = &get_info($fieldname{'clustername'});
230: print 'Enter the organization name for this LON-CAPA cluster, e.g., "Lon CAPA certification authority"'."\n".
1.3 raeburn 231: 'This name will be included as the Organization for the CA certificate.'."\n";
1.1 raeburn 232: $organization = &get_info($fieldname{'organization'});
233: print "Enter the default lifetime (in days) for each certificate created/signed by the CA for individual nodes, e.g., 3650\n";
234: $days = &get_days();
235: print "Enter the re-creation interval (in days) for the CA's certificate revocation list (CRL), e.g., 180\n";
236: $crldays = &get_days();
237:
238: if (open(my $fh,'>',"$dir/lonca/opensslca.conf")) {
239: print $fh <<"END";
240: [ ca ]
241: default_ca = loncapa
242:
243: [ loncapa ]
244: dir = $dir/lonca
245: certificate = $dir/lonca/cacert.pem
246: database = $dir/lonca/index.txt
247: new_certs_dir = $dir/lonca/certs
248: private_key = $dir/lonca/private/cakey.pem
249: serial = $dir/lonca/serial
250:
251: default_crl_days = $crldays
252: default_days = $days
253: default_md = sha256
254:
255: policy = loncapa_policy
256: x509_extensions = certificate_extensions
257:
258: [ loncapa_policy ]
259:
260: commonName = supplied
261: stateOrProvinceName = supplied
262: countryName = supplied
263: emailAddress = supplied
264: organizationName = supplied
265: organizationalUnitName = optional
266:
267: [ certificate_extensions ]
268:
269: basicConstraints = CA:false
1.3 raeburn 270: crlDistributionPoints = URI:http://$clusterhostname/adm/dns/loncapaCRL
1.1 raeburn 271:
272: [ req ]
273:
274: default_bits = 2048
275: distinguished_name = loncapa_ca
276:
277: x509_extensions = loncapa_ca_extensions
278:
279: [ loncapa_ca ]
280:
281: commonName = $clustername
282: localityName = $city
283: stateOrProvinceName = $state
284: countryName = $country
285: emailAddress = $email
286: organizationName = $organization
287:
288: [ loncapa_ca_extensions ]
289: basicConstraints = CA:true
290:
291: [ crl_ext ]
292:
293: authorityKeyIdentifier=keyid:always,issuer:always
294:
295:
296: END
297:
298: } else {
299: print 'Error: failed to wtite to '."$dir/lonca/opensslca.conf. Exiting.\n";
300: exit;
301: }
302: %data = &parse_config("$dir/lonca/opensslca.conf");
303: my %update = &confirm_config(%data);
304: my %changes;
305: foreach my $field ('clustername','organization','email','country','state','city','days','crldays') {
306: if ($data{$field} ne $update{$field}) {
307: $changes{$field} = $update{$field};
308: }
309: }
310: if (keys(%changes)) {
311: &save_config_changes("$dir/lonca/opensslca.conf",\%changes);
312: }
313: }
314:
315: my $sslkeypass;
316: if (-e "$dir/lonca/private/cakey.pem") {
317: my ($keyok,$try);
318: print "CA key aleady exists\n";
319: $try = 1;
320: while (!$keyok && $try) {
321: $sslkeypass = &get_password('Enter the password for the CA key');
322: if ($sslkeypass ne '') {
323: open(PIPE,"openssl rsa -noout -in lonca/private/cakey.pem -passin pass:$sslkeypass -check |");
324: my $check = <PIPE>;
325: close(PIPE);
326: chomp($check);
327: if ($check eq 'RSA key ok') {
328: $keyok = 1;
329: last;
330: } else {
331: print "CA key check failed. Try again? [Y/n]";
332: if (!&get_user_selection(1)) {
333: $try = 0;
334: }
335: }
336: }
337: }
338: unless ($keyok) {
339: print "CA key check failed. Create a new key? [Y/n]";
340: if (&get_user_selection(1)) {
341: $sslkeypass = &get_new_sslkeypass();
342: # generate SSL key
343: unless (&make_key("$dir/lonca/private",$sslkeypass)) {
344: print "Failed to create CA key\n";
345: exit;
346: }
347: } else {
348: exit;
349: }
350: }
351: } else {
352: $sslkeypass = &get_new_sslkeypass();
353: # generate SSL key
354: unless (&make_key("$dir/lonca/private",$sslkeypass)) {
355: print "Failed to create CA key\n";
356: exit;
357: }
358: }
1.3 raeburn 359: my $makecacert;
1.1 raeburn 360: if (-e "$dir/lonca/cacert.pem") {
361: print "A CA certificate exists\n";
362: open(PIPE,"openssl pkey -in $dir/lonca/private/cakey.pem -passin pass:$sslkeypass -pubout -outform der | sha256sum |");
363: my $hashfromkey = <PIPE>;
364: close(PIPE);
365: chomp($hashfromkey);
366: open(PIPE,"openssl x509 -in $dir/lonca/cacert.pem -pubkey | openssl pkey -pubin -pubout -outform der | sha256sum |");
367: my $hashfromcert = <PIPE>;
368: close(PIPE);
369: chomp($hashfromcert);
1.3 raeburn 370: my $defsel = 0;
1.1 raeburn 371: if ($hashfromkey eq $hashfromcert) {
372: my ($now,$starttime,$endtime,$status,%cert);
373: my $x509 = Crypt::OpenSSL::X509->new_from_file("$dir/lonca/cacert.pem");
374: my @items = split(/,\s+/,$x509->subject());
375: foreach my $item (@items) {
376: my ($name,$value) = split(/=/,$item);
377: if ($name eq 'CN') {
378: $cert{'cn'} = $value;
379: }
380: }
381: $cert{'start'} = $x509->notBefore();
382: $cert{'end'} = $x509->notAfter();
383: $cert{'alg'} = $x509->sig_alg_name();
384: $cert{'size'} = $x509->bit_length();
385: $cert{'email'} = $x509->email();
386: my $dt = DateTime::Format::x509->parse_datetime($cert{'start'});
387: if (ref($dt)) {
388: $starttime = $dt->epoch;
389: }
390: $dt = DateTime::Format::x509->parse_datetime($cert{'end'});
391: if (ref($dt)) {
392: $endtime = $dt->epoch;
393: }
394: $now = time;
395: if (($starttime ne '') && ($endtime ne '')) {
396: if ($endtime <= $now) {
397: $status = 'previous';
398: print "Current CA certificate expired $cert{'end'}\n";
1.3 raeburn 399: print 'Create a new certificate? [Y/n]';
400: $defsel = 1;
1.1 raeburn 401: } elsif ($starttime > $now) {
402: $status = 'future';
1.3 raeburn 403: print "Current CA certificate will be valid after $cert{'start'}\n";
404: print 'Create a new certificate? [y/N]';
1.1 raeburn 405: } else {
406: $status eq 'active';
407: print "Current CA certificate valid until $cert{'end'}".' '.
408: "Signature Algorithm: $cert{'alg'}; Public Key size: $cert{'size'}\n";
1.3 raeburn 409: print 'Create a new certificate? [y/N]';
1.1 raeburn 410: }
411: } else {
412: print "Could not determine validity of current CA certificate\n";
1.3 raeburn 413: print 'Create a new certificate? [Y/n]';
414: $defsel = 1;
1.1 raeburn 415: }
1.3 raeburn 416: } else {
417: print "Current CA certificate does not match key.\n";
418: print 'Create a new certificate? [Y/n]';
419: $defsel = 1;
420: }
421: if (&get_user_selection($defsel)) {
422: $makecacert = 1;
1.1 raeburn 423: }
424: } else {
1.3 raeburn 425: $makecacert = 1;
426: }
427: if ($makecacert) {
428: print "Enter the lifetime (in days) for the CA root certificate distributed to all nodes, e.g., 3650\n";
429: my $cadays = &get_days();
430: unless (&make_ca_cert("$dir/lonca/private","$dir/lonca",$sslkeypass,$cadays)) {
1.4 ! raeburn 431: print "Failed to create CA certificate\n";
1.1 raeburn 432: exit;
433: }
434: }
435:
436: if (!-e "$dir/lonca/index.txt") {
437: File::Slurp::write_file("$dir/lonca/index.txt");
438: }
439: if (-e "$dir/lonca/index.txt") {
440: my $mode = 0600;
441: chmod $mode, "$dir/lonca/index.txt";
442: } else {
443: print "lonca/index.txt file is missing\n";
444: exit;
445: }
446:
1.4 ! raeburn 447: my $defcrlsel = 1;
! 448: if (!-e "$dir/lonca/crl/loncapaCAcrl.pem") {
! 449: print "No Revocation Certificate List found.\n";
! 450: print 'Create Certificate Revocation List [Y/n]';
! 451: } else {
! 452: if (open(PIPE,"openssl crl -in $dir/lonca/crl/loncapaCAcrl.pem -inform pem -CAfile $dir/lonca/cacert.pem -noout 2>&1 |")) {
! 453: my $crlstatus = <PIPE>;
! 454: close(PIPE);
! 455: chomp($crlstatus);
! 456: my $failmsg = "Could not determine 'valid from' and 'valid to' dates for Certificate Revocation List.\n";
! 457: if ($crlstatus =~ /OK/) {
! 458: print "Current Certficate Revocation List is consistent with current CA certificate.\n";
! 459: if (open(my $fh,'<',"$dir/lonca/crl/loncapaCAcrl.pem")) {
! 460: my $pem_crl = '';
! 461: while (my $line=<$fh>) {
! 462: chomp($line);
! 463: next if ($line eq '-----BEGIN X509 CRL-----');
! 464: next if ($line eq '-----END X509 CRL-----');
! 465: $pem_crl .= $line;
! 466: }
! 467: close($fh);
! 468: my $der_crl = MIME::Base64::decode_base64($pem_crl);
! 469: if ($der_crl ne '') {
! 470: my $decoded = Crypt::X509::CRL->new( crl => $der_crl );
! 471: if (ref($decoded)) {
! 472: if ($decoded->error) {
! 473: print $failmsg;
! 474: } else {
! 475: my $starttime = $decoded->this_update;
! 476: my $endtime = $decoded->next_update;
! 477: if (($endtime ne '') && ($endtime < time)) {
! 478: print "Certificate Revocation List is no longer valid.\n";
! 479: } elsif ($starttime > time) {
! 480: print "Certificate Revocation List will become valid in the future.\n";
! 481: } elsif (($starttime ne '') && ($endtime ne '')) {
! 482: my $showstart = localtime($starttime);
! 483: my $showend = localtime($endtime);
! 484: print "Certificate Revocation List valid from: $showstart to: $showend\n";
! 485: $defcrlsel = 0;
! 486: } else {
! 487: print $failmsg;
! 488: }
! 489: }
! 490: } else {
! 491: print $failmsg;
! 492: }
! 493: } else {
! 494: print $failmsg;
! 495: }
! 496: } else {
! 497: print $failmsg;
! 498: }
! 499: } else {
! 500: print "Current Certificate Revocation List is not consistent with current CA certificate.\n";
! 501: }
! 502: if ($defcrlsel) {
! 503: print 'Create Certificate Revocation List [Y/n]';
! 504: } else {
! 505: print 'Create Certificate Revocation List [y/N]';
! 506: }
! 507: } else {
! 508: print "Could not check Certificate Revocation List status.\n";
! 509: print 'Create Certificate Revocation List [Y/n]';
1.1 raeburn 510: }
511: }
1.4 ! raeburn 512: if (&get_user_selection($defcrlsel)) {
! 513: if (open(PIPE,"openssl ca -gencrl -keyfile $dir/lonca/private/cakey.pem -cert $dir/lonca/cacert.pem -out $dir".
! 514: "/lonca/crl/loncapaCAcrl.pem -config $dir/lonca/opensslca.conf -passin pass:$sslkeypass |")) {
! 515: close(PIPE);
! 516: if (-e "$dir/lonca/crl/loncapaCAcrl.pem") {
! 517: if (open(PIPE,"openssl crl -in $dir/lonca/crl/loncapaCAcrl.pem -inform pem -CAfile $dir/lonca/cacert.pem -noout 2>&1 |")) {
! 518: my $revoked = <PIPE>;
! 519: close(PIPE);
! 520: chomp($revoked);
! 521: if ($revoked eq 'verify OK') {
! 522: print "Certificate Revocation List created\n";
! 523: } else {
! 524: print "Certificate Revocation List status: $revoked\n";
! 525: }
! 526: } else {
! 527: print "Could not check Certificate Revocation List status\n";
! 528: }
! 529: } else {
! 530: print "Failed to create Certificate Revocation List\n";
! 531: }
! 532: } else {
! 533: print "Failed to create Certificate Revocation List\n";
! 534: }
1.1 raeburn 535: }
1.4 ! raeburn 536: exit(0);
! 537:
1.1 raeburn 538:
539: sub cafield_to_key {
540: my %mapping = (
541: city => 'localityName',
542: state => 'stateOrProvinceName',
543: country => 'countryName',
544: email => 'emailAddress',
545: organization => 'organizationName',
546: clustername => 'commonName',
547: );
548: return %mapping;
549: }
550:
551: sub field_to_key {
552: my %mapping = (
553: days => 'default_days',
554: crldays => 'default_crl_days',
555: );
556: }
557:
558: sub parse_config {
559: my ($filepath) = @_;
560: my (%fields,%data);
561: if (open(my $fh,'<',$filepath)) {
562: my $currsection;
563: while(<$fh>) {
564: chomp();
565: s/(^\s+|\s+$)//g;
566: if (/^\[\s*([^\s]+)\s*\]/) {
567: $currsection = $1;
568: } elsif (/^([^=]+)=([^=]+)$/) {
569: my ($key,$value) = ($1,$2);
570: $key =~ s/\s+$//;
571: $value =~ s/^\s+//;
572: if ($currsection ne '') {
573: $fields{$currsection}{$key} = $value;
574: }
575: }
576: }
577: close($fh);
578: }
579: if (ref($fields{'loncapa_ca'}) eq 'HASH') {
580: my %ca_mapping = &cafield_to_key();
581: foreach my $key (keys(%ca_mapping)) {
582: $data{$key} = $fields{'loncapa_ca'}{$ca_mapping{$key}};
583: }
584: }
585: if (ref($fields{'loncapa'}) eq 'HASH') {
586: my %mapping = &field_to_key();
587: foreach my $key (keys(%mapping)) {
588: $data{$key} = $fields{'loncapa'}{$mapping{$key}};
589: }
590: }
591: return %data;
592: }
593:
594: sub save_config_changes {
595: my ($filepath,$updated) = @_;
596: return unless (ref($updated) eq 'HASH');
597: my %mapping = &field_to_key();
598: my %ca_mapping = &cafield_to_key();
599: my %revmapping = reverse(%mapping);
600: my %rev_ca_mapping = reverse(%ca_mapping);
601: my $lines;
602: if (open(my $fh,'<',$filepath)) {
603: my $currsection;
604: while(<$fh>) {
605: my $line = $_;
606: chomp();
607: s/(^\s+|\s+$)//g;
608: my $newline;
609: if (/^\[\s*([^\s]+)\s*\]/) {
610: $currsection = $1;
611: } elsif (/^([^=]+)=([^=]*)$/) {
612: my ($origkey,$origvalue) = ($1,$2);
613: my ($key,$value) = ($origkey,$origvalue);
614: $key =~ s/\s+$//;
615: $value =~ s/^\s+//;
616: if ($currsection eq 'loncapa_ca') {
617: if ((exists($rev_ca_mapping{$key})) && (exists($updated->{$rev_ca_mapping{$key}}))) {
618: if ($value eq '') {
619: if ($origvalue eq '') {
620: $origvalue = ' ';
621: }
622: $origvalue .= $updated->{$rev_ca_mapping{$key}};
623: } else {
624: $origvalue =~ s/\Q$value\E/$updated->{$rev_ca_mapping{$key}}/;
625: }
626: $newline = $origkey.'='.$origvalue."\n";
627: }
628: } elsif ($currsection eq 'loncapa') {
629: if ((exists($revmapping{$key})) && (exists($updated->{$revmapping{$key}}))) {
630: if ($value eq '') {
631: if ($origvalue eq '') {
632: $origvalue = ' ';
633: }
634: $origvalue .= $updated->{$revmapping{$key}};
635: } else {
636: $origvalue =~ s/\Q$value\E/$updated->{$revmapping{$key}}/;
637: }
638: $newline = $origkey.'='.$origvalue."\n";
639: }
640: }
641: }
642: if ($newline) {
643: $lines .= $newline;
644: } else {
645: $lines .= $line;
646: }
647: }
648: close($fh);
649: if (open(my $fout,'>',$filepath)) {
650: print $fout $lines;
651: close($fout);
652: } else {
653: print "Error: failed to open '$filepath' for writing\n";
654: }
655: }
656: return;
657: }
658:
659: #
660: # get_hostname() prompts the user to provide the server's hostname.
661: #
662: # If invalid input is provided, the routine is called recursively
663: # until, a valid hostname is provided.
664: #
665:
666: sub get_hostname {
667: my $hostname;
668: print 'Enter the hostname of this server, e.g., loncapa.somewhere.edu'."\n";
669: my $choice = <STDIN>;
670: chomp($choice);
671: $choice =~ s/(^\s+|\s+$)//g;
672: if ($choice eq '') {
673: print "Hostname you entered was either blank or contanied only white space.\n";
674: } elsif ($choice =~ /^[\w\.\-]+$/) {
675: $hostname = $choice;
676: } else {
677: print "Hostname you entered was invalid -- a hostname may only contain letters, numbers, - and .\n";
678: }
679: while ($hostname eq '') {
680: $hostname = &get_hostname();
681: }
682: print "\n";
683: return $hostname;
684: }
685:
686: sub get_new_sslkeypass {
687: my $sslkeypass;
688: my $flag=0;
689: # get password for SSL key
690: while (!$flag) {
691: $sslkeypass = &make_passphrase();
692: if ($sslkeypass) {
693: $flag = 1;
694: } else {
695: print "Invalid input (a password is required for the CA key).\n";
696: }
697: }
698: return $sslkeypass;
699: }
700:
701: sub make_passphrase {
702: my ($got_passwd,$firstpass,$secondpass,$passwd);
703: my $maxtries = 10;
704: my $trial = 0;
705: while ((!$got_passwd) && ($trial < $maxtries)) {
706: $firstpass = &get_password('Enter a password for the CA key (at least 6 characters long)');
707: if (length($firstpass) < 6) {
708: print('Password too short.'."\n".
709: 'Please choose a password with at least six characters.'."\n".
710: 'Please try again.'."\n");
711: } elsif (length($firstpass) > 30) {
712: print('Password too long.'."\n".
713: 'Please choose a password with no more than thirty characters.'."\n".
714: 'Please try again.'."\n");
715: } else {
716: my $pbad=0;
717: foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
718: if ($pbad) {
719: print('Password contains invalid characters.'."\n".
720: 'Password must consist of standard ASCII characters.'."\n".
721: 'Please try again.'."\n");
722: } else {
723: $secondpass = &get_password('Enter password a second time');
724: if ($firstpass eq $secondpass) {
725: $got_passwd = 1;
726: $passwd = $firstpass;
727: } else {
728: print('Passwords did not match.'."\n".
729: 'Please try again.'."\n");
730: }
731: }
732: }
733: $trial ++;
734: }
735: return $passwd;
736: }
737:
738: sub get_password {
739: my ($prompt) = @_;
740: local $| = 1;
741: print $prompt.': ';
742: my $newpasswd = '';
1.3 raeburn 743: Term::ReadKey::ReadMode('raw');
1.1 raeburn 744: my $key;
1.3 raeburn 745: while(ord($key = Term::ReadKey::ReadKey(0)) != 10) {
1.1 raeburn 746: if(ord($key) == 127 || ord($key) == 8) {
747: chop($newpasswd);
748: print "\b \b";
749: } elsif(!ord($key) < 32) {
750: $newpasswd .= $key;
751: print '*';
752: }
753: }
1.3 raeburn 754: Term::ReadKey::ReadMode('normal');
1.1 raeburn 755: print "\n";
756: return $newpasswd;
757: }
758:
759: #
760: # make_key() generates CA root key
761: #
762:
763: sub make_key {
764: my ($keydir,$sslkeypass) = @_;
765: # generate SSL key
766: my $created;
767: if (($keydir ne '') && ($sslkeypass ne '')) {
768: if (-f "$keydir/cakey.pem") {
769: my $mode = 0600;
770: chmod $mode, "$keydir/cakey.pem";
771: }
772: open(PIPE,"openssl genrsa -aes256 -passout pass:$sslkeypass -out $keydir/cakey.pem 2048 2>&1 |");
773: close(PIPE);
774: if (-f "$keydir/cakey.pem") {
775: my $mode = 0400;
776: chmod $mode, "$keydir/cakey.pem";
777: $created= 1;
778: }
779: } else {
780: print "Key creation failed. Missing one or more of: certificates directory, key name\n";
781: }
782: return $created;
783: }
784:
785: #
786: # make_ca_cert() generates CA root certificate
787: #
788:
789: sub make_ca_cert {
1.3 raeburn 790: my ($keydir,$certdir,$sslkeypass,$cadays) = @_;
1.1 raeburn 791: # generate SSL cert for CA
792: my $created;
1.3 raeburn 793: if ((-d $keydir) && (-d $certdir) && ($sslkeypass ne '') && ($cadays =~ /^\d+$/) && ($cadays > 0)) {
794: open(PIPE,"openssl req -x509 -key $keydir/cakey.pem -passin pass:$sslkeypass -new -days $cadays -batch -config $certdir/opensslca.conf -out $certdir/cacert.pem |");
1.1 raeburn 795: close(PIPE);
796: if (-f "$certdir/cacert.pem") {
797: my $mode = 0600;
798: chmod $mode, "$certdir/cacert.pem";
799: $created= 1;
800: }
801: } else {
1.3 raeburn 802: print "Creation of CA root certificate failed. Missing one or more of: CA directory, CA key directory, CA passphrase, or certificate lifetime (number of days).\n";
1.1 raeburn 803: }
804: return $created;
805: }
806:
807: sub get_camail {
808: my $camail;
809: my $flag=0;
810: # get Certificate Authority E-mail
811: while (!$flag) {
812: print(<<END);
813:
814: Enter e-mail address of Certificate Authority.
815: END
816:
817: my $choice=<>;
818: chomp($choice);
819: if (($choice ne '') && ($choice =~ /^[^\@]+\@[^\@]+$/)) {
820: $camail=$choice;
821: $flag=1;
822: } else {
823: print "Invalid input (a valid email address is required).\n";
824: }
825: }
826: return $camail;
827: }
828:
829: sub ssl_info {
830: print(<<END);
831:
832: ****** Information about Country, State or Province and City *****
833:
834: A two-letter country code, e.g., US, CA, DE etc. as defined by ISO 3166,
835: is required. A state or province, and a city are also required.
836: This locality information is included in two SSL certificates used internally
837: by LON-CAPA, unless you are running standalone.
838:
839: If your server will be part of either the production or development
840: clusters, then the certificate will need to be signed by the official
841: LON-CAPA Certificate Authority (CA). If you will be running your own
842: cluster then the cluster will need to create its own CA.
843:
844: END
845: }
846:
847: sub get_country {
848: my ($desiredhostname) = @_;
849: # get Country
850: my ($posscountry,$country);
851: if ($desiredhostname =~ /\.(edu|com|org)$/) {
852: $posscountry = 'us';
853: } else {
854: ($posscountry) = ($desiredhostname =~ /\.(a-z){2}$/);
855: }
856: if ($posscountry) {
1.3 raeburn 857: my $countrydesc = Locale::Country::code2country($posscountry);
1.1 raeburn 858: if ($countrydesc eq '') {
859: undef($posscountry);
860: }
861: }
862:
863: my $flag=0;
864: while (!$flag) {
865: if ($posscountry) {
866: $posscountry = uc($posscountry);
867: print "Enter Two-Letter Country Code [$posscountry]:\n";
868: } else {
869: print "Enter the Two-Letter Country Code:\n";
870: }
871: my $choice=<STDIN>;
872: chomp($choice);
873: if ($choice ne '') {
1.3 raeburn 874: if (Locale::Country::code2country(lc($choice))) {
1.1 raeburn 875: $country=uc($choice);
876: $flag=1;
877: } else {
878: print "Invalid input -- a valid two letter country code is required\n";
879: }
880: } elsif (($choice eq '') && ($posscountry ne '')) {
881: $country = $posscountry;
882: $flag = 1;
883: } else {
884: print "Invalid input -- a country code is required\n";
885: }
886: }
887: return $country;
888: }
889:
890: sub get_info {
891: my ($typename) = @_;
892: my $value;
893: my $choice = <STDIN>;
894: chomp($choice);
895: $choice =~ s/(^\s+|\s+$)//g;
896: if ($choice eq '') {
897: print "$typename you entered was either blank or contained only white space.\n";
898: } else {
899: $value = $choice;
900: }
901: while ($value eq '') {
902: $value = &get_info($typename);
903: }
904: print "\n";
905: return $value;
906: }
907:
908: sub get_days {
909: my $value;
910: my $choice = <STDIN>;
911: chomp($choice);
912: $choice =~ s/(^\s+|\s+$)//g;
913: if ($choice eq '') {
914: print "The value you entered was either blank or contained only white space.\n";
915: } elsif ($choice !~ /^\d+$/) {
916: print "The value you entered contained invalid characters -- you must enter just an integer.\n";
917: } else {
918: $value = $choice;
919: }
920: while ($value eq '') {
921: $value = &get_days();
922: }
923: print "\n";
924: return $value;
925: }
926:
927: sub confirm_config {
928: my (%data) = @_;
929: my $flag = 0;
930: while (!$flag) {
931: print(<<END);
932:
933: The cluster name, organization name, country, state and city will be
1.4 ! raeburn 934: included in the CA certificate, and in signed certificate(s) issued to
! 935: node(s) in the cluster (which will receive the default certficate lifetime).
1.1 raeburn 936:
937: 1) Cluster Name: $data{'clustername'}
938: 2) Organization Name: $data{'organization'}
939: 3) Country: $data{'country'}
940: 4) State or Province: $data{'state'}
941: 5) City: $data{'city'}
942: 6) E-mail: $data{'email'}
1.3 raeburn 943: 7) Default certificate lifetime for issued certs (days): $data{'days'}
944: 8) CRL recreation interval (days): $data{'crldays'}
945: 9) Everything is correct up above
1.1 raeburn 946:
1.4 ! raeburn 947: Enter a choice of 1-8 to change, otherwise enter 9:
1.1 raeburn 948: END
949: my $choice=<STDIN>;
950: chomp($choice);
951: if ($choice == 1) {
952: print(<<END);
953: 1) Cluster Name: $data{'clustername'}
954: Enter new value:
955: END
956: my $choice2=<STDIN>;
957: chomp($choice2);
958: $data{'clustername'}=$choice2;
959: chomp($choice2);
960: $data{'organization'}=$choice2;
961: } elsif ($choice == 3) {
962: print(<<END);
963: 3) Country: $data{'country'}
964: Enter new value (this should be a two-character code, e,g, US, CA, DE):
965: END
966: my $choice2=<STDIN>;
967: chomp($choice2);
968: $data{'country'} = uc($choice2);
969: } elsif ($choice == 4) {
970: print(<<END);
971: 4) State or Province: $data{'state'}
972: Enter new value:
973: END
974: my $choice2=<>;
975: chomp($choice2);
976: $data{'state'}=$choice2;
977: } elsif ($choice == 5) {
978: print(<<END);
979: 5) City: $data{'city'}
980: Enter new value:
981: END
982: my $choice2=<>;
983: chomp($choice2);
984: $data{'city'}=$choice2;
985: } elsif ($choice == 6) {
986: print(<<END);
987: 6) E-mail: $data{'email'}
988: Enter new value:
989: END
990: my $choice2=<>;
991: chomp($choice2);
992: $data{'email'}=$choice2;
993: } elsif ($choice == 7) {
994: print(<<END);
1.3 raeburn 995: 7) Default certificate lifetime: $data{'days'}
1.1 raeburn 996: Enter new value:
997: END
998: my $choice2=<>;
999: chomp($choice2);
1000: $choice2 =~ s/\D//g;
1.3 raeburn 1001: $data{'days'}=$choice2;
1.1 raeburn 1002: } elsif ($choice == 8) {
1003: print(<<END);
1.3 raeburn 1004: 8) CRL re-creation interval: $data{'crldays'}
1.1 raeburn 1005: Enter new value:
1006: END
1007: my $choice2=<>;
1008: chomp($choice2);
1009: $choice2 =~ s/\D//g;
1.3 raeburn 1010: $data{'crldays'}=$choice2;
1.1 raeburn 1011: } elsif ($choice == 9) {
1012: $flag=1;
1013: foreach my $key (keys(%data)) {
1014: $data{$key} =~ s{/}{ }g;
1015: }
1016: } else {
1017: print "Invalid input.\n";
1018: }
1019: }
1020: return %data;
1021: }
1022:
1023: sub get_user_selection {
1024: my ($defaultrun) = @_;
1025: my $do_action = 0;
1026: my $choice = <STDIN>;
1027: chomp($choice);
1028: $choice =~ s/(^\s+|\s+$)//g;
1029: my $yes = 'y';
1030: if ($defaultrun) {
1031: if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
1032: $do_action = 1;
1033: }
1034: } else {
1035: if ($choice =~ /^\Q$yes\E/i) {
1036: $do_action = 1;
1037: }
1038: }
1039: return $do_action;
1040: }
1041:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to CrCA.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom