File:  [LON-CAPA] / loncom / CrCA.pl
Revision 1.6: download - view: text, annotated - select for diffs
Sun May 14 19:11:47 2023 UTC (11 months, 2 weeks ago) by raeburn
Branches: MAIN
CVS tags: HEAD
- Script to create a Certificate Authority (CA) for a LON-CAPA cluster.
  - policy section: localityName requirement set to "supplied"
  - req section: set default key, message digest and prompt
  - call close() after writing opensslca.conf file.

    1: #!/usr/bin/perl
    2: # The LearningOnline Network with CAPA
    3: # Script to create a Certificate Authority (CA) for a LON-CAPA cluster.
    4: #
    5: # $Id: CrCA.pl,v 1.6 2023/05/14 19:11:47 raeburn Exp $
    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: 
   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
   75: Crypt::X509::CRL
   76: MIME::Base64
   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: 
   95:   print ('Continue? [Y/n]');
   96:   my $go_on = &get_user_selection(1);
   97:   if (!$go_on) {
   98:       exit;
   99:   }
  100: 
  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:   }
  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:
  200: Country, State/Province, City, Cluster Name, Organizational Name, E-mail address, Default certificate lifetime (days), CRL re-creation interval (days)
  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:                       );
  219:       my ($clustername,$organization,$country,$state,$city,$email,$clusterhostname,$days,$crldays);
  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".
  231:             'This name will be included as the Organization for the CA certificate.'."\n";    
  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: localityName         = supplied
  262: stateOrProvinceName  = supplied
  263: countryName          = supplied
  264: emailAddress         = supplied
  265: organizationName     = supplied
  266: organizationalUnitName = optional
  267: 
  268: [ certificate_extensions ]
  269: 
  270: basicConstraints   = CA:false
  271: crlDistributionPoints = URI:http://$clusterhostname/adm/dns/loncapaCRL
  272: 
  273: [ req ]
  274: 
  275: default_bits       = 2048
  276: default_md         = sha256
  277: default_keyfile    = $dir/lonca/private/cakey.pem
  278: 
  279: prompt             = no
  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
  302:          close($fh);
  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:           }
  355:       }
  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:   }
  364:   my $makecacert;
  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);
  375:       my $defsel = 0;
  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"; 
  404:                   print 'Create a new certificate? [Y/n]';
  405:                   $defsel = 1;
  406:               } elsif ($starttime > $now) {
  407:                   $status = 'future';
  408:                   print "Current CA certificate will be valid after $cert{'start'}\n";
  409:                   print 'Create a new certificate? [y/N]';
  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"; 
  414:                   print 'Create a new certificate? [y/N]';
  415:               }
  416:           } else {
  417:               print "Could not determine validity of current CA certificate\n";
  418:               print 'Create a new certificate? [Y/n]';
  419:               $defsel = 1;
  420:           }
  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;
  428:       }
  429:   } else {
  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)) {
  436:           print "Failed to create CA certificate\n";
  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";
  449:       exit;
  450:   }
  451: 
  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]';
  515:       }
  516:   }
  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:       }
  540:   }
  541:   exit(0);
  542: 
  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 = '';
  748:     Term::ReadKey::ReadMode('raw');
  749:     my $key;
  750:     while(ord($key = Term::ReadKey::ReadKey(0)) != 10) {
  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:     }
  759:     Term::ReadKey::ReadMode('normal');
  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 {
  795:     my ($keydir,$certdir,$sslkeypass,$cadays) = @_;
  796: # generate SSL cert for CA
  797:     my $created;
  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 |");
  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 {
  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";
  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) {
  862:         my $countrydesc = Locale::Country::code2country($posscountry);
  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 '') {
  879:             if (Locale::Country::code2country(lc($choice))) {
  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 
  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).
  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'}
  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
  951: 
  952: Enter a choice of 1-8 to change, otherwise enter 9:
  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);
 1000: 7) Default certificate lifetime: $data{'days'}
 1001: Enter new value:
 1002: END
 1003:             my $choice2=<>;
 1004:             chomp($choice2);
 1005:             $choice2 =~ s/\D//g;
 1006:             $data{'days'}=$choice2;
 1007:         } elsif ($choice == 8) {
 1008: print(<<END);
 1009: 8) CRL re-creation interval: $data{'crldays'}
 1010: Enter new value:
 1011: END
 1012:             my $choice2=<>;
 1013:             chomp($choice2);
 1014:             $choice2 =~ s/\D//g;
 1015:             $data{'crldays'}=$choice2;
 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>