Annotation of loncom/CrCA.pl, revision 1.6

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.6     ! raeburn     5: # $Id: CrCA.pl,v 1.5 2023/05/14 18:44:57 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;
1.5       raeburn   179:   }
1.1       raeburn   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: 
1.5       raeburn   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
1.6     ! raeburn   261: localityName         = supplied
1.1       raeburn   262: stateOrProvinceName  = supplied
                    263: countryName          = supplied
                    264: emailAddress         = supplied
                    265: organizationName     = supplied
                    266: organizationalUnitName = optional
                    267: 
                    268: [ certificate_extensions ]
                    269: 
                    270: basicConstraints   = CA:false
1.3       raeburn   271: crlDistributionPoints = URI:http://$clusterhostname/adm/dns/loncapaCRL
1.1       raeburn   272: 
                    273: [ req ]
                    274: 
                    275: default_bits       = 2048
1.6     ! raeburn   276: default_md         = sha256
        !           277: default_keyfile    = $dir/lonca/private/cakey.pem
        !           278: 
        !           279: prompt             = no
1.1       raeburn   280: distinguished_name = loncapa_ca
                    281: 
                    282: x509_extensions    = loncapa_ca_extensions
                    283: 
                    284: [ loncapa_ca ]
                    285: 
                    286: commonName           = $clustername
                    287: localityName         = $city
                    288: stateOrProvinceName  = $state
                    289: countryName          = $country
                    290: emailAddress         = $email
                    291: organizationName     = $organization
                    292: 
                    293: [ loncapa_ca_extensions ]
                    294: basicConstraints  = CA:true
                    295: 
                    296: [ crl_ext ]
                    297: 
                    298: authorityKeyIdentifier=keyid:always,issuer:always
                    299: 
                    300: 
                    301: END
1.6     ! raeburn   302:          close($fh);
1.1       raeburn   303:       } else {
                    304:           print 'Error: failed to wtite to '."$dir/lonca/opensslca.conf. Exiting.\n";
                    305:           exit;
                    306:       }
                    307:       %data = &parse_config("$dir/lonca/opensslca.conf");
                    308:       my %update = &confirm_config(%data);
                    309:       my %changes;
                    310:       foreach my $field ('clustername','organization','email','country','state','city','days','crldays') {
                    311:           if ($data{$field} ne $update{$field}) {
                    312:               $changes{$field} = $update{$field};
                    313:           }
                    314:       }
                    315:       if (keys(%changes)) {
                    316:           &save_config_changes("$dir/lonca/opensslca.conf",\%changes);
                    317:       }
                    318:   }
                    319: 
                    320:   my $sslkeypass;
                    321:   if (-e "$dir/lonca/private/cakey.pem") {
                    322:       my ($keyok,$try);
                    323:       print "CA key aleady exists\n";
                    324:       $try = 1;
                    325:       while (!$keyok && $try) {
                    326:           $sslkeypass = &get_password('Enter the password for the CA key');
                    327:           if ($sslkeypass ne '') {
                    328:               open(PIPE,"openssl rsa -noout -in lonca/private/cakey.pem -passin pass:$sslkeypass -check |");
                    329:               my $check = <PIPE>;
                    330:               close(PIPE);
                    331:               chomp($check);
                    332:               if ($check eq 'RSA key ok') {
                    333:                   $keyok = 1;
                    334:                   last;
                    335:               } else {
                    336:                   print "CA key check failed. Try again? [Y/n]";
                    337:                   if (!&get_user_selection(1)) {
                    338:                       $try = 0;
                    339:                   }
                    340:               }
                    341:           }
                    342:       }
                    343:       unless ($keyok) {
                    344:           print "CA key check failed. Create a new key? [Y/n]";
                    345:           if (&get_user_selection(1)) {
                    346:               $sslkeypass = &get_new_sslkeypass();
                    347:               # generate SSL key
                    348:               unless (&make_key("$dir/lonca/private",$sslkeypass)) {
                    349:                   print "Failed to create CA key\n";
                    350:                   exit;
                    351:               }
                    352:           } else {
                    353:               exit;
                    354:           }
1.5       raeburn   355:       }
1.1       raeburn   356:   } else {
                    357:       $sslkeypass = &get_new_sslkeypass();
                    358:       # generate SSL key
                    359:       unless (&make_key("$dir/lonca/private",$sslkeypass)) {
                    360:           print "Failed to create CA key\n";
                    361:           exit;
                    362:       }
                    363:   }
1.3       raeburn   364:   my $makecacert;
1.1       raeburn   365:   if (-e "$dir/lonca/cacert.pem") {
                    366:       print "A CA certificate exists\n";
                    367:       open(PIPE,"openssl pkey -in $dir/lonca/private/cakey.pem -passin pass:$sslkeypass -pubout -outform der | sha256sum |");
                    368:       my $hashfromkey = <PIPE>;
                    369:       close(PIPE);
                    370:       chomp($hashfromkey);
                    371:       open(PIPE,"openssl x509 -in $dir/lonca/cacert.pem -pubkey | openssl pkey -pubin -pubout -outform der | sha256sum |");
                    372:       my $hashfromcert = <PIPE>;
                    373:       close(PIPE);
                    374:       chomp($hashfromcert);
1.3       raeburn   375:       my $defsel = 0;
1.1       raeburn   376:       if ($hashfromkey eq $hashfromcert) {
                    377:           my ($now,$starttime,$endtime,$status,%cert);
                    378:           my $x509 = Crypt::OpenSSL::X509->new_from_file("$dir/lonca/cacert.pem");
                    379:           my @items = split(/,\s+/,$x509->subject());
                    380:           foreach my $item (@items) {
                    381:               my ($name,$value) = split(/=/,$item);
                    382:               if ($name eq 'CN') {
                    383:                   $cert{'cn'} = $value;
                    384:               }
                    385:           }
                    386:           $cert{'start'} = $x509->notBefore();
                    387:           $cert{'end'} = $x509->notAfter();
                    388:           $cert{'alg'} = $x509->sig_alg_name();
                    389:           $cert{'size'} = $x509->bit_length();
                    390:           $cert{'email'} = $x509->email();
                    391:           my $dt = DateTime::Format::x509->parse_datetime($cert{'start'});
                    392:           if (ref($dt)) {
                    393:               $starttime = $dt->epoch;
                    394:           }
                    395:           $dt =  DateTime::Format::x509->parse_datetime($cert{'end'});
                    396:           if (ref($dt)) {
                    397:               $endtime = $dt->epoch;
                    398:           }
                    399:           $now = time;
                    400:           if (($starttime ne '') && ($endtime ne '')) {
                    401:               if ($endtime <= $now) {
                    402:                   $status = 'previous';
                    403:                   print "Current CA certificate expired $cert{'end'}\n"; 
1.3       raeburn   404:                   print 'Create a new certificate? [Y/n]';
                    405:                   $defsel = 1;
1.1       raeburn   406:               } elsif ($starttime > $now) {
                    407:                   $status = 'future';
1.3       raeburn   408:                   print "Current CA certificate will be valid after $cert{'start'}\n";
                    409:                   print 'Create a new certificate? [y/N]';
1.1       raeburn   410:               } else {
                    411:                   $status eq 'active';
                    412:                   print "Current CA certificate valid until $cert{'end'}".' '.
                    413:                         "Signature Algorithm: $cert{'alg'}; Public Key size: $cert{'size'}\n"; 
1.3       raeburn   414:                   print 'Create a new certificate? [y/N]';
1.1       raeburn   415:               }
                    416:           } else {
                    417:               print "Could not determine validity of current CA certificate\n";
1.3       raeburn   418:               print 'Create a new certificate? [Y/n]';
                    419:               $defsel = 1;
1.1       raeburn   420:           }
1.3       raeburn   421:       } else {
                    422:           print "Current CA certificate does not match key.\n";
                    423:           print 'Create a new certificate? [Y/n]';
                    424:           $defsel = 1;
                    425:       }
                    426:       if (&get_user_selection($defsel)) {
                    427:           $makecacert = 1;
1.1       raeburn   428:       }
                    429:   } else {
1.3       raeburn   430:       $makecacert = 1;
                    431:   }
                    432:   if ($makecacert) {
                    433:       print "Enter the lifetime (in days) for the CA root certificate distributed to all nodes, e.g., 3650\n";
                    434:       my $cadays = &get_days();
                    435:       unless (&make_ca_cert("$dir/lonca/private","$dir/lonca",$sslkeypass,$cadays)) {
1.4       raeburn   436:           print "Failed to create CA certificate\n";
1.1       raeburn   437:           exit;
                    438:       }
                    439:   }
                    440: 
                    441:   if (!-e "$dir/lonca/index.txt") {
                    442:       File::Slurp::write_file("$dir/lonca/index.txt");
                    443:   }
                    444:   if (-e "$dir/lonca/index.txt") {
                    445:       my $mode = 0600;
                    446:       chmod $mode, "$dir/lonca/index.txt";
                    447:   } else {
                    448:       print "lonca/index.txt file is missing\n";
1.5       raeburn   449:       exit;
                    450:   }
1.1       raeburn   451: 
1.4       raeburn   452:   my $defcrlsel = 1;
                    453:   if (!-e "$dir/lonca/crl/loncapaCAcrl.pem") {
                    454:       print "No Revocation Certificate List found.\n";
                    455:       print 'Create Certificate Revocation List [Y/n]';
                    456:   } else {
                    457:       if (open(PIPE,"openssl crl -in $dir/lonca/crl/loncapaCAcrl.pem -inform pem -CAfile $dir/lonca/cacert.pem  -noout 2>&1 |")) {
                    458:           my $crlstatus = <PIPE>;
                    459:           close(PIPE);
                    460:           chomp($crlstatus);
                    461:           my $failmsg = "Could not determine 'valid from' and 'valid to' dates for Certificate Revocation List.\n";
                    462:           if ($crlstatus =~ /OK/) {
                    463:               print "Current Certficate Revocation List is consistent with current CA certificate.\n";
                    464:               if (open(my $fh,'<',"$dir/lonca/crl/loncapaCAcrl.pem")) {
                    465:                   my $pem_crl = '';
                    466:                   while (my $line=<$fh>) {
                    467:                       chomp($line);
                    468:                       next if ($line eq '-----BEGIN X509 CRL-----');
                    469:                       next if ($line eq '-----END X509 CRL-----');
                    470:                       $pem_crl .= $line;
                    471:                   }
                    472:                   close($fh);
                    473:                   my $der_crl = MIME::Base64::decode_base64($pem_crl);
                    474:                   if ($der_crl ne '') {
                    475:                       my $decoded = Crypt::X509::CRL->new( crl => $der_crl );
                    476:                       if (ref($decoded)) {
                    477:                           if ($decoded->error) {
                    478:                               print $failmsg; 
                    479:                           } else {
                    480:                               my $starttime = $decoded->this_update;
                    481:                               my $endtime = $decoded->next_update;
                    482:                               if (($endtime ne '') && ($endtime < time)) {
                    483:                                   print "Certificate Revocation List is no longer valid.\n";
                    484:                               } elsif ($starttime > time) {
                    485:                                   print "Certificate Revocation List will become valid in the future.\n";
                    486:                               } elsif (($starttime ne '') && ($endtime ne '')) {
                    487:                                   my $showstart = localtime($starttime);
                    488:                                   my $showend = localtime($endtime);
                    489:                                   print "Certificate Revocation List valid from: $showstart to: $showend\n";
                    490:                                   $defcrlsel = 0;
                    491:                               } else {
                    492:                                   print $failmsg;
                    493:                               }
                    494:                           }
                    495:                       } else {
                    496:                           print $failmsg; 
                    497:                       }
                    498:                   } else {
                    499:                       print $failmsg;
                    500:                   }
                    501:               } else {
                    502:                   print $failmsg;
                    503:               }
                    504:           } else {
                    505:               print "Current Certificate Revocation List is not consistent with current CA certificate.\n";
                    506:           }
                    507:           if ($defcrlsel) {
                    508:               print 'Create Certificate Revocation List [Y/n]';
                    509:           } else {
                    510:               print 'Create Certificate Revocation List [y/N]';
                    511:           }
                    512:       } else {
                    513:           print "Could not check Certificate Revocation List status.\n";
                    514:           print 'Create Certificate Revocation List [Y/n]';
1.1       raeburn   515:       }
                    516:   }
1.4       raeburn   517:   if (&get_user_selection($defcrlsel)) {
                    518:       if (open(PIPE,"openssl ca -gencrl -keyfile $dir/lonca/private/cakey.pem -cert $dir/lonca/cacert.pem -out $dir".
                    519:                     "/lonca/crl/loncapaCAcrl.pem -config $dir/lonca/opensslca.conf -passin pass:$sslkeypass |")) {
                    520:           close(PIPE);
                    521:           if (-e "$dir/lonca/crl/loncapaCAcrl.pem") {
                    522:               if (open(PIPE,"openssl crl -in $dir/lonca/crl/loncapaCAcrl.pem -inform pem -CAfile $dir/lonca/cacert.pem  -noout 2>&1 |")) {
                    523:                   my $revoked = <PIPE>;
                    524:                   close(PIPE);
                    525:                   chomp($revoked);
                    526:                   if ($revoked eq 'verify OK') {
                    527:                       print "Certificate Revocation List created\n";
                    528:                   } else {
                    529:                       print "Certificate Revocation List status: $revoked\n";
                    530:                   }
                    531:               } else {
                    532:                   print "Could not check Certificate Revocation List status\n";
                    533:               }
                    534:           } else {
                    535:               print "Failed to create Certificate Revocation List\n";
                    536:           }
                    537:       } else {
                    538:           print "Failed to create Certificate Revocation List\n";
                    539:       }
1.1       raeburn   540:   }
1.4       raeburn   541:   exit(0);
                    542: 
1.1       raeburn   543: 
                    544: sub cafield_to_key {
                    545:     my %mapping = (
                    546:                     city         => 'localityName',
                    547:                     state        => 'stateOrProvinceName',
                    548:                     country      => 'countryName',
                    549:                     email        => 'emailAddress',
                    550:                     organization => 'organizationName',
                    551:                     clustername  => 'commonName',
                    552:                   );
                    553:     return %mapping;
                    554: }
                    555: 
                    556: sub field_to_key {
                    557:     my %mapping = (
                    558:                     days    => 'default_days',
                    559:                     crldays => 'default_crl_days',
                    560:                   );
                    561: }
                    562: 
                    563: sub parse_config {
                    564:     my ($filepath) = @_;
                    565:     my (%fields,%data);
                    566:     if (open(my $fh,'<',$filepath)) {
                    567:         my $currsection;
                    568:         while(<$fh>) {
                    569:             chomp();
                    570:             s/(^\s+|\s+$)//g;
                    571:             if (/^\[\s*([^\s]+)\s*\]/) {
                    572:                 $currsection = $1;
                    573:             } elsif (/^([^=]+)=([^=]+)$/) {
                    574:                 my ($key,$value) = ($1,$2);
                    575:                 $key =~ s/\s+$//;
                    576:                 $value =~ s/^\s+//;
                    577:                 if ($currsection ne '') {
                    578:                     $fields{$currsection}{$key} = $value;
                    579:                 }
                    580:             }
                    581:         }
                    582:         close($fh); 
                    583:     }
                    584:     if (ref($fields{'loncapa_ca'}) eq 'HASH') {
                    585:         my %ca_mapping = &cafield_to_key();
                    586:         foreach my $key (keys(%ca_mapping)) {
                    587:             $data{$key} = $fields{'loncapa_ca'}{$ca_mapping{$key}};
                    588:         }
                    589:     }
                    590:     if (ref($fields{'loncapa'}) eq 'HASH') {
                    591:         my %mapping = &field_to_key();
                    592:         foreach my $key (keys(%mapping)) {
                    593:             $data{$key} = $fields{'loncapa'}{$mapping{$key}};
                    594:         }
                    595:     }
                    596:     return %data; 
                    597: }
                    598: 
                    599: sub save_config_changes {
                    600:     my ($filepath,$updated) = @_;
                    601:     return unless (ref($updated) eq 'HASH');
                    602:     my %mapping = &field_to_key();
                    603:     my %ca_mapping = &cafield_to_key();
                    604:     my %revmapping = reverse(%mapping);
                    605:     my %rev_ca_mapping = reverse(%ca_mapping);
                    606:     my $lines;
                    607:     if (open(my $fh,'<',$filepath)) {
                    608:         my $currsection;
                    609:         while(<$fh>) {
                    610:             my $line = $_;
                    611:             chomp();
                    612:             s/(^\s+|\s+$)//g;
                    613:             my $newline;
                    614:             if (/^\[\s*([^\s]+)\s*\]/) {
                    615:                 $currsection = $1;
                    616:             } elsif (/^([^=]+)=([^=]*)$/) {
                    617:                 my ($origkey,$origvalue) = ($1,$2);
                    618:                 my ($key,$value) = ($origkey,$origvalue);
                    619:                 $key =~ s/\s+$//;
                    620:                 $value =~ s/^\s+//;
                    621:                 if ($currsection eq 'loncapa_ca') {
                    622:                     if ((exists($rev_ca_mapping{$key})) && (exists($updated->{$rev_ca_mapping{$key}}))) {
                    623:                         if ($value eq '') {
                    624:                             if ($origvalue eq '') {
                    625:                                 $origvalue = ' ';
                    626:                             }
                    627:                             $origvalue .= $updated->{$rev_ca_mapping{$key}};
                    628:                         } else {
                    629:                             $origvalue =~ s/\Q$value\E/$updated->{$rev_ca_mapping{$key}}/;
                    630:                         }
                    631:                         $newline = $origkey.'='.$origvalue."\n";
                    632:                     }
                    633:                 } elsif ($currsection eq 'loncapa') {
                    634:                     if ((exists($revmapping{$key})) && (exists($updated->{$revmapping{$key}}))) {
                    635:                         if ($value eq '') {
                    636:                             if ($origvalue eq '') {
                    637:                                 $origvalue = ' ';
                    638:                             }
                    639:                             $origvalue .= $updated->{$revmapping{$key}};
                    640:                         } else {
                    641:                             $origvalue =~ s/\Q$value\E/$updated->{$revmapping{$key}}/;
                    642:                         }
                    643:                         $newline = $origkey.'='.$origvalue."\n";
                    644:                     }
                    645:                 }
                    646:             }
                    647:             if ($newline) {
                    648:                 $lines .= $newline;
                    649:             } else {
                    650:                 $lines .= $line;
                    651:             }
                    652:         }
                    653:         close($fh);
                    654:         if (open(my $fout,'>',$filepath)) {
                    655:             print $fout $lines;
                    656:             close($fout);
                    657:         } else {
                    658:             print "Error: failed to open '$filepath' for writing\n"; 
                    659:         }
                    660:     }
                    661:     return;
                    662: }
                    663: 
                    664: #
                    665: # get_hostname() prompts the user to provide the server's hostname.
                    666: #
                    667: # If invalid input is provided, the routine is called recursively
                    668: # until, a valid hostname is provided.
                    669: #
                    670: 
                    671: sub get_hostname {
                    672:     my $hostname;
                    673:     print 'Enter the hostname of this server, e.g., loncapa.somewhere.edu'."\n";
                    674:     my $choice = <STDIN>;
                    675:     chomp($choice);
                    676:     $choice =~ s/(^\s+|\s+$)//g;
                    677:     if ($choice eq '') {
                    678:         print "Hostname you entered was either blank or contanied only white space.\n";
                    679:     } elsif ($choice =~ /^[\w\.\-]+$/) {
                    680:         $hostname = $choice;
                    681:     } else {
                    682:         print "Hostname you entered was invalid --  a hostname may only contain letters, numbers, - and .\n";
                    683:     }
                    684:     while ($hostname eq '') {
                    685:         $hostname = &get_hostname();
                    686:     }
                    687:     print "\n";
                    688:     return $hostname;
                    689: }
                    690: 
                    691: sub get_new_sslkeypass {
                    692:     my $sslkeypass;
                    693:     my $flag=0;
                    694: # get password for SSL key
                    695:     while (!$flag) {
                    696:         $sslkeypass = &make_passphrase();
                    697:         if ($sslkeypass) {
                    698:             $flag = 1;
                    699:         } else {
                    700:             print "Invalid input (a password is required for the CA key).\n";
                    701:         }
                    702:     }
                    703:     return $sslkeypass;
                    704: }
                    705: 
                    706: sub make_passphrase {
                    707:     my ($got_passwd,$firstpass,$secondpass,$passwd);
                    708:     my $maxtries = 10;
                    709:     my $trial = 0;
                    710:     while ((!$got_passwd) && ($trial < $maxtries)) {
                    711:         $firstpass = &get_password('Enter a password for the CA key (at least 6 characters long)');
                    712:         if (length($firstpass) < 6) {
                    713:             print('Password too short.'."\n".
                    714:               'Please choose a password with at least six characters.'."\n".
                    715:               'Please try again.'."\n");
                    716:         } elsif (length($firstpass) > 30) {
                    717:             print('Password too long.'."\n".
                    718:                   'Please choose a password with no more than thirty characters.'."\n".
                    719:                   'Please try again.'."\n");
                    720:         } else {
                    721:             my $pbad=0;
                    722:             foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
                    723:             if ($pbad) {
                    724:                 print('Password contains invalid characters.'."\n".
                    725:                       'Password must consist of standard ASCII characters.'."\n".
                    726:                       'Please try again.'."\n");
                    727:             } else {
                    728:                 $secondpass = &get_password('Enter password a second time');
                    729:                 if ($firstpass eq $secondpass) {
                    730:                     $got_passwd = 1;
                    731:                     $passwd = $firstpass;
                    732:                 } else {
                    733:                     print('Passwords did not match.'."\n".
                    734:                           'Please try again.'."\n");
                    735:                 }
                    736:             }
                    737:         }
                    738:         $trial ++;
                    739:     }
                    740:     return $passwd;
                    741: }
                    742: 
                    743: sub get_password {
                    744:     my ($prompt) = @_;
                    745:     local $| = 1;
                    746:     print $prompt.': ';
                    747:     my $newpasswd = '';
1.3       raeburn   748:     Term::ReadKey::ReadMode('raw');
1.1       raeburn   749:     my $key;
1.3       raeburn   750:     while(ord($key = Term::ReadKey::ReadKey(0)) != 10) {
1.1       raeburn   751:         if(ord($key) == 127 || ord($key) == 8) {
                    752:             chop($newpasswd);
                    753:             print "\b \b";
                    754:         } elsif(!ord($key) < 32) {
                    755:             $newpasswd .= $key;
                    756:             print '*';
                    757:         }
                    758:     }
1.3       raeburn   759:     Term::ReadKey::ReadMode('normal');
1.1       raeburn   760:     print "\n";
                    761:     return $newpasswd;
                    762: }
                    763: 
                    764: #
                    765: # make_key() generates CA root key
                    766: #
                    767: 
                    768: sub make_key {
                    769:     my ($keydir,$sslkeypass) = @_;
                    770: # generate SSL key
                    771:     my $created;
                    772:     if (($keydir ne '') && ($sslkeypass ne '')) {
                    773:         if (-f "$keydir/cakey.pem") {
                    774:             my $mode = 0600;
                    775:             chmod $mode, "$keydir/cakey.pem";
                    776:         }
                    777:         open(PIPE,"openssl genrsa -aes256 -passout pass:$sslkeypass -out $keydir/cakey.pem 2048 2>&1 |");
                    778:         close(PIPE);
                    779:         if (-f "$keydir/cakey.pem") {
                    780:             my $mode = 0400;
                    781:             chmod $mode, "$keydir/cakey.pem";
                    782:             $created= 1;
                    783:         }
                    784:     } else {
                    785:         print "Key creation failed.  Missing one or more of: certificates directory, key name\n";
                    786:     }
                    787:     return $created;
                    788: }
                    789: 
                    790: #
                    791: # make_ca_cert() generates CA root certificate
                    792: #
                    793: 
                    794: sub make_ca_cert {
1.3       raeburn   795:     my ($keydir,$certdir,$sslkeypass,$cadays) = @_;
1.1       raeburn   796: # generate SSL cert for CA
                    797:     my $created;
1.3       raeburn   798:     if ((-d $keydir) && (-d $certdir) && ($sslkeypass ne '') && ($cadays =~ /^\d+$/) && ($cadays > 0))  {
                    799:         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   800:         close(PIPE);
                    801:         if (-f "$certdir/cacert.pem") {
                    802:             my $mode = 0600;
                    803:             chmod $mode, "$certdir/cacert.pem";
                    804:             $created= 1;
                    805:         }
                    806:     } else {
1.3       raeburn   807:         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   808:     }
                    809:     return $created;
                    810: }
                    811: 
                    812: sub get_camail {
                    813:     my $camail;
                    814:     my $flag=0;
                    815: # get Certificate Authority E-mail
                    816:     while (!$flag) {
                    817:         print(<<END);
                    818: 
                    819: Enter e-mail address of Certificate Authority. 
                    820: END
                    821: 
                    822:         my $choice=<>;
                    823:         chomp($choice);
                    824:         if (($choice ne '') && ($choice =~ /^[^\@]+\@[^\@]+$/)) {
                    825:             $camail=$choice;
                    826:             $flag=1;
                    827:         } else {
                    828:             print "Invalid input (a valid email address is required).\n";
                    829:         }
                    830:     }
                    831:     return $camail;
                    832: }
                    833: 
                    834: sub ssl_info {
                    835:     print(<<END);
                    836: 
                    837: ****** Information about Country, State or Province and City *****
                    838: 
                    839: A two-letter country code, e.g., US, CA, DE etc. as defined by ISO 3166,
                    840: is required. A state or province, and a city are also required.
                    841: This locality information is included in two SSL certificates used internally
                    842: by LON-CAPA, unless you are running standalone.
                    843: 
                    844: If your server will be part of either the production or development
                    845: clusters, then the certificate will need to be signed by the official
                    846: LON-CAPA Certificate Authority (CA).  If you will be running your own
                    847: cluster then the cluster will need to create its own CA.
                    848: 
                    849: END
                    850: }
                    851: 
                    852: sub get_country {
                    853:     my ($desiredhostname) = @_;
                    854: # get Country
                    855:     my ($posscountry,$country);
                    856:     if ($desiredhostname =~ /\.(edu|com|org)$/) {
                    857:         $posscountry = 'us';
                    858:     } else {
                    859:         ($posscountry) = ($desiredhostname =~ /\.(a-z){2}$/);
                    860:     }
                    861:     if ($posscountry) {
1.3       raeburn   862:         my $countrydesc = Locale::Country::code2country($posscountry);
1.1       raeburn   863:         if ($countrydesc eq '') {
                    864:             undef($posscountry);
                    865:         }
                    866:     }
                    867: 
                    868:     my $flag=0;
                    869:     while (!$flag) {
                    870:         if ($posscountry) {
                    871:             $posscountry = uc($posscountry);
                    872:             print "Enter Two-Letter Country Code [$posscountry]:\n";
                    873:         } else {
                    874:             print "Enter the Two-Letter Country Code:\n";
                    875:         }
                    876:         my $choice=<STDIN>;
                    877:         chomp($choice);
                    878:         if ($choice ne '') {
1.3       raeburn   879:             if (Locale::Country::code2country(lc($choice))) {
1.1       raeburn   880:                 $country=uc($choice);
                    881:                 $flag=1;
                    882:             } else {
                    883:                 print "Invalid input -- a valid two letter country code is required\n";
                    884:             }
                    885:         } elsif (($choice eq '') && ($posscountry ne '')) {
                    886:             $country = $posscountry;
                    887:             $flag = 1;
                    888:         } else {
                    889:             print "Invalid input -- a country code is required\n";
                    890:         }
                    891:     }
                    892:     return $country;
                    893: }
                    894: 
                    895: sub get_info {
                    896:     my ($typename) = @_;
                    897:     my $value;
                    898:     my $choice = <STDIN>;
                    899:     chomp($choice);
                    900:     $choice =~ s/(^\s+|\s+$)//g;
                    901:     if ($choice eq '') {
                    902:         print "$typename you entered was either blank or contained only white space.\n";
                    903:     } else {
                    904:         $value = $choice;
                    905:     }
                    906:     while ($value eq '') {
                    907:         $value = &get_info($typename);
                    908:     }
                    909:     print "\n";
                    910:     return $value;
                    911: }
                    912: 
                    913: sub get_days {
                    914:     my $value;
                    915:     my $choice = <STDIN>;
                    916:     chomp($choice);
                    917:     $choice =~ s/(^\s+|\s+$)//g;
                    918:     if ($choice eq '') {
                    919:         print "The value you entered was either blank or contained only white space.\n";
                    920:     } elsif ($choice !~ /^\d+$/) {
                    921:         print "The value you entered contained invalid characters -- you must enter just an integer.\n";
                    922:     } else {
                    923:         $value = $choice;
                    924:     }
                    925:     while ($value eq '') {
                    926:         $value = &get_days();
                    927:     }
                    928:     print "\n";
                    929:     return $value;
                    930: }
                    931: 
                    932: sub confirm_config {
                    933:     my (%data) = @_;
                    934:     my $flag = 0;
                    935:     while (!$flag) {
                    936:         print(<<END);
                    937: 
                    938: The cluster name, organization name, country, state and city will be 
1.4       raeburn   939: included in the CA certificate, and in signed certificate(s) issued to
                    940: node(s) in the cluster (which will receive the default certficate lifetime).
1.1       raeburn   941: 
                    942: 1) Cluster Name: $data{'clustername'}
                    943: 2) Organization Name: $data{'organization'}
                    944: 3) Country: $data{'country'}
                    945: 4) State or Province: $data{'state'}
                    946: 5) City: $data{'city'}
                    947: 6) E-mail: $data{'email'}
1.3       raeburn   948: 7) Default certificate lifetime for issued certs (days): $data{'days'}
                    949: 8) CRL recreation interval (days): $data{'crldays'}
                    950: 9) Everything is correct up above
1.1       raeburn   951: 
1.4       raeburn   952: Enter a choice of 1-8 to change, otherwise enter 9:
1.1       raeburn   953: END
                    954:         my $choice=<STDIN>;
                    955:         chomp($choice);
                    956:         if ($choice == 1) {
                    957:             print(<<END);
                    958: 1) Cluster Name: $data{'clustername'}
                    959: Enter new value:
                    960: END
                    961:             my $choice2=<STDIN>;
                    962:             chomp($choice2);
                    963:             $data{'clustername'}=$choice2;
                    964:             chomp($choice2);
                    965:             $data{'organization'}=$choice2;
                    966:         } elsif ($choice == 3) {
                    967:             print(<<END);
                    968: 3) Country: $data{'country'}
                    969: Enter new value (this should be a two-character code, e,g, US, CA, DE):
                    970: END
                    971:             my $choice2=<STDIN>;
                    972:             chomp($choice2);
                    973:             $data{'country'} = uc($choice2);
                    974:         } elsif ($choice == 4) {
                    975:             print(<<END);
                    976: 4) State or Province: $data{'state'}
                    977: Enter new value:
                    978: END
                    979:             my $choice2=<>;
                    980:             chomp($choice2);
                    981:             $data{'state'}=$choice2;
                    982:         } elsif ($choice == 5) {
                    983:             print(<<END);
                    984: 5) City: $data{'city'}
                    985: Enter new value:
                    986: END
                    987:             my $choice2=<>;
                    988:             chomp($choice2);
                    989:             $data{'city'}=$choice2;
                    990:         } elsif ($choice == 6) {
                    991:             print(<<END);
                    992: 6) E-mail: $data{'email'}
                    993: Enter new value:
                    994: END
                    995:             my $choice2=<>;
                    996:             chomp($choice2);
                    997:             $data{'email'}=$choice2;
                    998:         } elsif ($choice == 7) {
                    999: print(<<END);
1.3       raeburn  1000: 7) Default certificate lifetime: $data{'days'}
1.1       raeburn  1001: Enter new value:
                   1002: END
                   1003:             my $choice2=<>;
                   1004:             chomp($choice2);
                   1005:             $choice2 =~ s/\D//g;
1.3       raeburn  1006:             $data{'days'}=$choice2;
1.1       raeburn  1007:         } elsif ($choice == 8) {
                   1008: print(<<END);
1.3       raeburn  1009: 8) CRL re-creation interval: $data{'crldays'}
1.1       raeburn  1010: Enter new value:
                   1011: END
                   1012:             my $choice2=<>;
                   1013:             chomp($choice2);
                   1014:             $choice2 =~ s/\D//g;
1.3       raeburn  1015:             $data{'crldays'}=$choice2;
1.1       raeburn  1016:         } elsif ($choice == 9) {
                   1017:             $flag=1;
                   1018:             foreach my $key (keys(%data)) { 
                   1019:                 $data{$key} =~ s{/}{ }g;
                   1020:             }  
                   1021:         } else {
                   1022:             print "Invalid input.\n";
                   1023:         }
                   1024:     }
                   1025:     return %data; 
                   1026: }
                   1027: 
                   1028: sub get_user_selection {
                   1029:     my ($defaultrun) = @_;
                   1030:     my $do_action = 0;
                   1031:     my $choice = <STDIN>;
                   1032:     chomp($choice);
                   1033:     $choice =~ s/(^\s+|\s+$)//g;
                   1034:     my $yes = 'y';
                   1035:     if ($defaultrun) {
                   1036:         if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
                   1037:             $do_action = 1;
                   1038:         }
                   1039:     } else {
                   1040:         if ($choice =~ /^\Q$yes\E/i) {
                   1041:             $do_action = 1;
                   1042:         }
                   1043:     }
                   1044:     return $do_action;
                   1045: }
                   1046: 

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