Annotation of loncom/CrCA.pl, revision 1.2

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

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