#!/usr/bin/perl
# The LearningOnline Network with CAPA
# Script to create a Certificate Authority (CA) for a LON-CAPA cluster.
#
# $Id: CrCA.pl,v 1.4 2019/07/18 00:28:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/

use strict;

#
# Expected structure
#
#  /lonca
#          opensslca.cnf
#          cacert.pem
#          index.txt
#          /certs
#          /crl
#          /private
#          /requests
#

  print(<<END);

****** SSL Certificate Authority *****

If you are running your own cluster of LON-CAPA nodes you will need to
create a Certificate Authority (CA) for your cluster. You will then use
the CA to sign LON-CAPA SSL certificate signing requests generated by
the nodes in your cluster.

LON-CAPA SSL Certificates can be used in two different contexts:
(a) if you configure LON-CAPA to use a secure channel for exchange of
the shared encryption key when establishing an "internal" LON-CAPA
connection between nodes in your cluster, and (b) if you configure
LON-CAPA to use client SSL certificate validation when one node replicates
content from library node(s) in your cluster.

Although a LON-CAPA cluster may contain multiple domains and/or multiple
library nodes, there will only be one LON-CAPA certificate authority (CA)
for the cluster.  The CA certificate signing infrastructure need not be 
housed on a LON-CAPA node; it can instead be installed on a separate
Linux instance.  The instance housing the CA infrastructure needs to
have the following Linux packages installed:

openssl
perl

and the following perl modules from CPAN installed:

Term::ReadKey
Sys::Hostname::FQDN
Locale::Country
Crypt::OpenSSL::X509
Crypt::X509::CRL
MIME::Base64
DateTime::Format::x509
File::Slurp

You need to decide on a directory you wish to use to hold the
CA infrastructure. If necessary you should create a new directory.
Then move this script (CrCA.pl) to that directory, and run it with
the command: perl CrCA.pl

The script will create any required subdirectories (and files) 
within that directory, if they do not already exist.

You will need to provide a password to be used for the openssl CA key 
which will be stored in the /private subdirectory, and will be used
when signing certificate signing requests to create LON-CAPA certificates 
for use in the cluster.

END

  print ('Continue? [Y/n]');
  my $go_on = &get_user_selection(1);
  if (!$go_on) {
      exit;
  }

  eval { require Sys::Hostname::FQDN; };
  if ($@) {
      print "Could not find required perl module: Sys::Hostname::FQDN. Exiting.\n";
      exit;
  }
  eval { require Term::ReadKey; };
  if ($@) {
      print "Could not find required perl module: Term::ReadKey. Exiting\n";
      exit;
  }
  eval { require Locale::Country; };
  if ($@) {
      print "Could not find required perl module: Locale::Country. Exiting\n";
      exit;
  }
  eval { require Crypt::OpenSSL::X509; };
  if ($@) {
      print "Could not find required perl module: Crypt::OpenSSL::X509. Exiting\n";
      exit;
  }
  eval { require Crypt::X509::CRL; };
  if ($@) {
      print "Could not find required perl module: Crypt::X509::CRL. Exiting\n";
      exit;
  }
  eval { require DateTime::Format::x509; };
  if ($@) {
      print "Could not find required perl module: DateTime::Format::x509. Exiting\n";
      exit;
  }
  eval { require File::Slurp; };
  if ($@) {
      print "Could not find required perl module: File::Slurp. Exiting\n";
      exit;
  }
  eval { require MIME::Base64; };
  if ($@) {
      print "Could not find required perl core module: MIME::Base64\n";
      exit;
  }
  eval { require Cwd; };
  if ($@) {
      print "Could not find required perl core module: Cwd\n";
      exit;
  }

  my ($dir,$hostname,%data);

# Check if required subdirectories exist in current directory.
  $dir = Cwd::getcwd();

  if (-e "$dir/lonca") {
      if ((!-d "$dir/lonca") && (-f "$dir/lonca")) {
          print "A lonca directory is required, but there is an existing file of that name.\n".
                "Please either delete the lonca file, or change to a different directory, and ".
                "create the CA infrastructure there.\n";
          exit;
      }
  } else {
      mkdir("$dir/lonca",0700);
      system('chown root:root '."$dir/lonca");
  }
  if (-d "$dir/lonca") {
      foreach my $subdir ('certs','crl','private','requests') {
          if (!-d "$dir/lonca/$subdir") {
              if (-f "$dir/lonca/$subdir") {
                  print "A $subdir sub-directory is required, but there is an existing file of that name.\n".
                        "Please either delete or move the $subdir file, then run this script again.\n";
                  exit;
              } else {
                  mkdir("$dir/lonca/$subdir",0700);
                  system('chown root:root '."$dir/lonca/$subdir");
              }
          }
      }
  } else {
      print "A lonca directory is required, but no directory exists\n";
      exit;
  }  
  if (-e "$dir/lonca/opensslca.conf") {
      # retrieve existing config file and verify that if contains the required fields.
      %data = &parse_config("$dir/lonca/opensslca.conf");
      my %update = &confirm_config(%data);
      my %changes;
      foreach my $field ('clustername','organization','email','country','state','city','days','crldays') {
          if ($data{$field} ne $update{$field}) {
              $changes{$field} = $update{$field};
          }
      }
      if (keys(%changes)) {
          &save_config_changes("$dir/lonca/opensslca.conf",\%changes);
      }
  } else {
      print(<<END);
****** Certificate Authority Configuration File *****

A configuration file: $dir/lonca/opensslca.conf will be created.

The following information will be included: 
Country, State/Province, City, Cluster Name, Organizational Name, E-mail address, Default certificate lifetime (days), CRL re-creation interval (days)

END
      $hostname = Sys::Hostname::FQDN::fqdn();
      if ($hostname eq '') {
          $hostname =&get_hostname();
      } else {
          print "Hostname detected: $hostname. Is that correct? [Y/n]";
          if (!&get_user_selection(1)) {
              $hostname =&get_hostname();
          }
      }

      my %fieldname = (
                        city => 'City',
                        state => 'State or Province',
                        clustername => 'Cluster name',
                        organization => 'Organization name',
                      );
      my ($clustername,$organization,$country,$state,$city,$email,$clusterhostname,$days,$crldays);
      $clusterhostname =  $hostname;
      $country = &get_country($hostname);
      print "Enter state or province name\n";
      $state = &get_info($fieldname{'state'});
      print "Enter city name\n";
      $city = &get_info($fieldname{'city'});
      $email = &get_camail();
      print 'Enter a name for this LON-CAPA cluster, e.g., "Lon-CAPA learning network"'."\n".
            'This name will be included as the Common Name for the CA certificate.'."\n";
      $clustername = &get_info($fieldname{'clustername'});
      print 'Enter the organization name for this LON-CAPA cluster, e.g., "Lon CAPA certification authority"'."\n".
            'This name will be included as the Organization for the CA certificate.'."\n";    
      $organization = &get_info($fieldname{'organization'});
      print "Enter the default lifetime (in days) for each certificate created/signed by the CA for individual nodes, e.g., 3650\n";
      $days = &get_days();
      print "Enter the re-creation interval (in days) for the CA's certificate revocation list (CRL), e.g., 180\n";
      $crldays = &get_days();

      if (open(my $fh,'>',"$dir/lonca/opensslca.conf")) {
          print $fh <<"END";
[ ca ]
default_ca       =  loncapa

[ loncapa ]
dir              = $dir/lonca
certificate      = $dir/lonca/cacert.pem
database         = $dir/lonca/index.txt
new_certs_dir    = $dir/lonca/certs
private_key      = $dir/lonca/private/cakey.pem
serial           = $dir/lonca/serial

default_crl_days = $crldays
default_days     = $days
default_md       = sha256

policy           = loncapa_policy
x509_extensions  = certificate_extensions

[ loncapa_policy ]

commonName           = supplied
stateOrProvinceName  = supplied
countryName          = supplied
emailAddress         = supplied
organizationName     = supplied
organizationalUnitName = optional

[ certificate_extensions ]

basicConstraints   = CA:false
crlDistributionPoints = URI:http://$clusterhostname/adm/dns/loncapaCRL

[ req ]

default_bits       = 2048
distinguished_name = loncapa_ca

x509_extensions    = loncapa_ca_extensions

[ loncapa_ca ]

commonName           = $clustername
localityName         = $city
stateOrProvinceName  = $state
countryName          = $country
emailAddress         = $email
organizationName     = $organization

[ loncapa_ca_extensions ]
basicConstraints  = CA:true

[ crl_ext ]

authorityKeyIdentifier=keyid:always,issuer:always


END

      } else {
          print 'Error: failed to wtite to '."$dir/lonca/opensslca.conf. Exiting.\n";
          exit;
      }
      %data = &parse_config("$dir/lonca/opensslca.conf");
      my %update = &confirm_config(%data);
      my %changes;
      foreach my $field ('clustername','organization','email','country','state','city','days','crldays') {
          if ($data{$field} ne $update{$field}) {
              $changes{$field} = $update{$field};
          }
      }
      if (keys(%changes)) {
          &save_config_changes("$dir/lonca/opensslca.conf",\%changes);
      }
  }

  my $sslkeypass;
  if (-e "$dir/lonca/private/cakey.pem") {
      my ($keyok,$try);
      print "CA key aleady exists\n";
      $try = 1;
      while (!$keyok && $try) {
          $sslkeypass = &get_password('Enter the password for the CA key');
          if ($sslkeypass ne '') {
              open(PIPE,"openssl rsa -noout -in lonca/private/cakey.pem -passin pass:$sslkeypass -check |");
              my $check = <PIPE>;
              close(PIPE);
              chomp($check);
              if ($check eq 'RSA key ok') {
                  $keyok = 1;
                  last;
              } else {
                  print "CA key check failed. Try again? [Y/n]";
                  if (!&get_user_selection(1)) {
                      $try = 0;
                  }
              }
          }
      }
      unless ($keyok) {
          print "CA key check failed. Create a new key? [Y/n]";
          if (&get_user_selection(1)) {
              $sslkeypass = &get_new_sslkeypass();
              # generate SSL key
              unless (&make_key("$dir/lonca/private",$sslkeypass)) {
                  print "Failed to create CA key\n";
                  exit;
              }
          } else {
              exit;
          }
      } 
  } else {
      $sslkeypass = &get_new_sslkeypass();
      # generate SSL key
      unless (&make_key("$dir/lonca/private",$sslkeypass)) {
          print "Failed to create CA key\n";
          exit;
      }
  }
  my $makecacert;
  if (-e "$dir/lonca/cacert.pem") {
      print "A CA certificate exists\n";
      open(PIPE,"openssl pkey -in $dir/lonca/private/cakey.pem -passin pass:$sslkeypass -pubout -outform der | sha256sum |");
      my $hashfromkey = <PIPE>;
      close(PIPE);
      chomp($hashfromkey);
      open(PIPE,"openssl x509 -in $dir/lonca/cacert.pem -pubkey | openssl pkey -pubin -pubout -outform der | sha256sum |");
      my $hashfromcert = <PIPE>;
      close(PIPE);
      chomp($hashfromcert);
      my $defsel = 0;
      if ($hashfromkey eq $hashfromcert) {
          my ($now,$starttime,$endtime,$status,%cert);
          my $x509 = Crypt::OpenSSL::X509->new_from_file("$dir/lonca/cacert.pem");
          my @items = split(/,\s+/,$x509->subject());
          foreach my $item (@items) {
              my ($name,$value) = split(/=/,$item);
              if ($name eq 'CN') {
                  $cert{'cn'} = $value;
              }
          }
          $cert{'start'} = $x509->notBefore();
          $cert{'end'} = $x509->notAfter();
          $cert{'alg'} = $x509->sig_alg_name();
          $cert{'size'} = $x509->bit_length();
          $cert{'email'} = $x509->email();
          my $dt = DateTime::Format::x509->parse_datetime($cert{'start'});
          if (ref($dt)) {
              $starttime = $dt->epoch;
          }
          $dt =  DateTime::Format::x509->parse_datetime($cert{'end'});
          if (ref($dt)) {
              $endtime = $dt->epoch;
          }
          $now = time;
          if (($starttime ne '') && ($endtime ne '')) {
              if ($endtime <= $now) {
                  $status = 'previous';
                  print "Current CA certificate expired $cert{'end'}\n"; 
                  print 'Create a new certificate? [Y/n]';
                  $defsel = 1;
              } elsif ($starttime > $now) {
                  $status = 'future';
                  print "Current CA certificate will be valid after $cert{'start'}\n";
                  print 'Create a new certificate? [y/N]';
              } else {
                  $status eq 'active';
                  print "Current CA certificate valid until $cert{'end'}".' '.
                        "Signature Algorithm: $cert{'alg'}; Public Key size: $cert{'size'}\n"; 
                  print 'Create a new certificate? [y/N]';
              }
          } else {
              print "Could not determine validity of current CA certificate\n";
              print 'Create a new certificate? [Y/n]';
              $defsel = 1;
          }
      } else {
          print "Current CA certificate does not match key.\n";
          print 'Create a new certificate? [Y/n]';
          $defsel = 1;
      }
      if (&get_user_selection($defsel)) {
          $makecacert = 1;
      }
  } else {
      $makecacert = 1;
  }
  if ($makecacert) {
      print "Enter the lifetime (in days) for the CA root certificate distributed to all nodes, e.g., 3650\n";
      my $cadays = &get_days();
      unless (&make_ca_cert("$dir/lonca/private","$dir/lonca",$sslkeypass,$cadays)) {
          print "Failed to create CA certificate\n";
          exit;
      }
  }

  if (!-e "$dir/lonca/index.txt") {
      File::Slurp::write_file("$dir/lonca/index.txt");
  }
  if (-e "$dir/lonca/index.txt") {
      my $mode = 0600;
      chmod $mode, "$dir/lonca/index.txt";
  } else {
      print "lonca/index.txt file is missing\n";
      exit; 
  }    

  my $defcrlsel = 1;
  if (!-e "$dir/lonca/crl/loncapaCAcrl.pem") {
      print "No Revocation Certificate List found.\n";
      print 'Create Certificate Revocation List [Y/n]';
  } else {
      if (open(PIPE,"openssl crl -in $dir/lonca/crl/loncapaCAcrl.pem -inform pem -CAfile $dir/lonca/cacert.pem  -noout 2>&1 |")) {
          my $crlstatus = <PIPE>;
          close(PIPE);
          chomp($crlstatus);
          my $failmsg = "Could not determine 'valid from' and 'valid to' dates for Certificate Revocation List.\n";
          if ($crlstatus =~ /OK/) {
              print "Current Certficate Revocation List is consistent with current CA certificate.\n";
              if (open(my $fh,'<',"$dir/lonca/crl/loncapaCAcrl.pem")) {
                  my $pem_crl = '';
                  while (my $line=<$fh>) {
                      chomp($line);
                      next if ($line eq '-----BEGIN X509 CRL-----');
                      next if ($line eq '-----END X509 CRL-----');
                      $pem_crl .= $line;
                  }
                  close($fh);
                  my $der_crl = MIME::Base64::decode_base64($pem_crl);
                  if ($der_crl ne '') {
                      my $decoded = Crypt::X509::CRL->new( crl => $der_crl );
                      if (ref($decoded)) {
                          if ($decoded->error) {
                              print $failmsg; 
                          } else {
                              my $starttime = $decoded->this_update;
                              my $endtime = $decoded->next_update;
                              if (($endtime ne '') && ($endtime < time)) {
                                  print "Certificate Revocation List is no longer valid.\n";
                              } elsif ($starttime > time) {
                                  print "Certificate Revocation List will become valid in the future.\n";
                              } elsif (($starttime ne '') && ($endtime ne '')) {
                                  my $showstart = localtime($starttime);
                                  my $showend = localtime($endtime);
                                  print "Certificate Revocation List valid from: $showstart to: $showend\n";
                                  $defcrlsel = 0;
                              } else {
                                  print $failmsg;
                              }
                          }
                      } else {
                          print $failmsg; 
                      }
                  } else {
                      print $failmsg;
                  }
              } else {
                  print $failmsg;
              }
          } else {
              print "Current Certificate Revocation List is not consistent with current CA certificate.\n";
          }
          if ($defcrlsel) {
              print 'Create Certificate Revocation List [Y/n]';
          } else {
              print 'Create Certificate Revocation List [y/N]';
          }
      } else {
          print "Could not check Certificate Revocation List status.\n";
          print 'Create Certificate Revocation List [Y/n]';
      }
  }
  if (&get_user_selection($defcrlsel)) {
      if (open(PIPE,"openssl ca -gencrl -keyfile $dir/lonca/private/cakey.pem -cert $dir/lonca/cacert.pem -out $dir".
                    "/lonca/crl/loncapaCAcrl.pem -config $dir/lonca/opensslca.conf -passin pass:$sslkeypass |")) {
          close(PIPE);
          if (-e "$dir/lonca/crl/loncapaCAcrl.pem") {
              if (open(PIPE,"openssl crl -in $dir/lonca/crl/loncapaCAcrl.pem -inform pem -CAfile $dir/lonca/cacert.pem  -noout 2>&1 |")) {
                  my $revoked = <PIPE>;
                  close(PIPE);
                  chomp($revoked);
                  if ($revoked eq 'verify OK') {
                      print "Certificate Revocation List created\n";
                  } else {
                      print "Certificate Revocation List status: $revoked\n";
                  }
              } else {
                  print "Could not check Certificate Revocation List status\n";
              }
          } else {
              print "Failed to create Certificate Revocation List\n";
          }
      } else {
          print "Failed to create Certificate Revocation List\n";
      }
  }
  exit(0);


sub cafield_to_key {
    my %mapping = (
                    city         => 'localityName',
                    state        => 'stateOrProvinceName',
                    country      => 'countryName',
                    email        => 'emailAddress',
                    organization => 'organizationName',
                    clustername  => 'commonName',
                  );
    return %mapping;
}

sub field_to_key {
    my %mapping = (
                    days    => 'default_days',
                    crldays => 'default_crl_days',
                  );
}

sub parse_config {
    my ($filepath) = @_;
    my (%fields,%data);
    if (open(my $fh,'<',$filepath)) {
        my $currsection;
        while(<$fh>) {
            chomp();
            s/(^\s+|\s+$)//g;
            if (/^\[\s*([^\s]+)\s*\]/) {
                $currsection = $1;
            } elsif (/^([^=]+)=([^=]+)$/) {
                my ($key,$value) = ($1,$2);
                $key =~ s/\s+$//;
                $value =~ s/^\s+//;
                if ($currsection ne '') {
                    $fields{$currsection}{$key} = $value;
                }
            }
        }
        close($fh); 
    }
    if (ref($fields{'loncapa_ca'}) eq 'HASH') {
        my %ca_mapping = &cafield_to_key();
        foreach my $key (keys(%ca_mapping)) {
            $data{$key} = $fields{'loncapa_ca'}{$ca_mapping{$key}};
        }
    }
    if (ref($fields{'loncapa'}) eq 'HASH') {
        my %mapping = &field_to_key();
        foreach my $key (keys(%mapping)) {
            $data{$key} = $fields{'loncapa'}{$mapping{$key}};
        }
    }
    return %data; 
}

sub save_config_changes {
    my ($filepath,$updated) = @_;
    return unless (ref($updated) eq 'HASH');
    my %mapping = &field_to_key();
    my %ca_mapping = &cafield_to_key();
    my %revmapping = reverse(%mapping);
    my %rev_ca_mapping = reverse(%ca_mapping);
    my $lines;
    if (open(my $fh,'<',$filepath)) {
        my $currsection;
        while(<$fh>) {
            my $line = $_;
            chomp();
            s/(^\s+|\s+$)//g;
            my $newline;
            if (/^\[\s*([^\s]+)\s*\]/) {
                $currsection = $1;
            } elsif (/^([^=]+)=([^=]*)$/) {
                my ($origkey,$origvalue) = ($1,$2);
                my ($key,$value) = ($origkey,$origvalue);
                $key =~ s/\s+$//;
                $value =~ s/^\s+//;
                if ($currsection eq 'loncapa_ca') {
                    if ((exists($rev_ca_mapping{$key})) && (exists($updated->{$rev_ca_mapping{$key}}))) {
                        if ($value eq '') {
                            if ($origvalue eq '') {
                                $origvalue = ' ';
                            }
                            $origvalue .= $updated->{$rev_ca_mapping{$key}};
                        } else {
                            $origvalue =~ s/\Q$value\E/$updated->{$rev_ca_mapping{$key}}/;
                        }
                        $newline = $origkey.'='.$origvalue."\n";
                    }
                } elsif ($currsection eq 'loncapa') {
                    if ((exists($revmapping{$key})) && (exists($updated->{$revmapping{$key}}))) {
                        if ($value eq '') {
                            if ($origvalue eq '') {
                                $origvalue = ' ';
                            }
                            $origvalue .= $updated->{$revmapping{$key}};
                        } else {
                            $origvalue =~ s/\Q$value\E/$updated->{$revmapping{$key}}/;
                        }
                        $newline = $origkey.'='.$origvalue."\n";
                    }
                }
            }
            if ($newline) {
                $lines .= $newline;
            } else {
                $lines .= $line;
            }
        }
        close($fh);
        if (open(my $fout,'>',$filepath)) {
            print $fout $lines;
            close($fout);
        } else {
            print "Error: failed to open '$filepath' for writing\n"; 
        }
    }
    return;
}

#
# get_hostname() prompts the user to provide the server's hostname.
#
# If invalid input is provided, the routine is called recursively
# until, a valid hostname is provided.
#

sub get_hostname {
    my $hostname;
    print 'Enter the hostname of this server, e.g., loncapa.somewhere.edu'."\n";
    my $choice = <STDIN>;
    chomp($choice);
    $choice =~ s/(^\s+|\s+$)//g;
    if ($choice eq '') {
        print "Hostname you entered was either blank or contanied only white space.\n";
    } elsif ($choice =~ /^[\w\.\-]+$/) {
        $hostname = $choice;
    } else {
        print "Hostname you entered was invalid --  a hostname may only contain letters, numbers, - and .\n";
    }
    while ($hostname eq '') {
        $hostname = &get_hostname();
    }
    print "\n";
    return $hostname;
}

sub get_new_sslkeypass {
    my $sslkeypass;
    my $flag=0;
# get password for SSL key
    while (!$flag) {
        $sslkeypass = &make_passphrase();
        if ($sslkeypass) {
            $flag = 1;
        } else {
            print "Invalid input (a password is required for the CA key).\n";
        }
    }
    return $sslkeypass;
}

sub make_passphrase {
    my ($got_passwd,$firstpass,$secondpass,$passwd);
    my $maxtries = 10;
    my $trial = 0;
    while ((!$got_passwd) && ($trial < $maxtries)) {
        $firstpass = &get_password('Enter a password for the CA key (at least 6 characters long)');
        if (length($firstpass) < 6) {
            print('Password too short.'."\n".
              'Please choose a password with at least six characters.'."\n".
              'Please try again.'."\n");
        } elsif (length($firstpass) > 30) {
            print('Password too long.'."\n".
                  'Please choose a password with no more than thirty characters.'."\n".
                  'Please try again.'."\n");
        } else {
            my $pbad=0;
            foreach (split(//,$firstpass)) {if ((ord($_)<32)||(ord($_)>126)){$pbad=1;}}
            if ($pbad) {
                print('Password contains invalid characters.'."\n".
                      'Password must consist of standard ASCII characters.'."\n".
                      'Please try again.'."\n");
            } else {
                $secondpass = &get_password('Enter password a second time');
                if ($firstpass eq $secondpass) {
                    $got_passwd = 1;
                    $passwd = $firstpass;
                } else {
                    print('Passwords did not match.'."\n".
                          'Please try again.'."\n");
                }
            }
        }
        $trial ++;
    }
    return $passwd;
}

sub get_password {
    my ($prompt) = @_;
    local $| = 1;
    print $prompt.': ';
    my $newpasswd = '';
    Term::ReadKey::ReadMode('raw');
    my $key;
    while(ord($key = Term::ReadKey::ReadKey(0)) != 10) {
        if(ord($key) == 127 || ord($key) == 8) {
            chop($newpasswd);
            print "\b \b";
        } elsif(!ord($key) < 32) {
            $newpasswd .= $key;
            print '*';
        }
    }
    Term::ReadKey::ReadMode('normal');
    print "\n";
    return $newpasswd;
}

#
# make_key() generates CA root key
#

sub make_key {
    my ($keydir,$sslkeypass) = @_;
# generate SSL key
    my $created;
    if (($keydir ne '') && ($sslkeypass ne '')) {
        if (-f "$keydir/cakey.pem") {
            my $mode = 0600;
            chmod $mode, "$keydir/cakey.pem";
        }
        open(PIPE,"openssl genrsa -aes256 -passout pass:$sslkeypass -out $keydir/cakey.pem 2048 2>&1 |");
        close(PIPE);
        if (-f "$keydir/cakey.pem") {
            my $mode = 0400;
            chmod $mode, "$keydir/cakey.pem";
            $created= 1;
        }
    } else {
        print "Key creation failed.  Missing one or more of: certificates directory, key name\n";
    }
    return $created;
}

#
# make_ca_cert() generates CA root certificate
#

sub make_ca_cert {
    my ($keydir,$certdir,$sslkeypass,$cadays) = @_;
# generate SSL cert for CA
    my $created;
    if ((-d $keydir) && (-d $certdir) && ($sslkeypass ne '') && ($cadays =~ /^\d+$/) && ($cadays > 0))  {
        open(PIPE,"openssl req -x509 -key $keydir/cakey.pem -passin pass:$sslkeypass -new -days $cadays -batch -config $certdir/opensslca.conf -out $certdir/cacert.pem |");
        close(PIPE);
        if (-f "$certdir/cacert.pem") {
            my $mode = 0600;
            chmod $mode, "$certdir/cacert.pem";
            $created= 1;
        }
    } else {
        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";
    }
    return $created;
}

sub get_camail {
    my $camail;
    my $flag=0;
# get Certificate Authority E-mail
    while (!$flag) {
        print(<<END);

Enter e-mail address of Certificate Authority. 
END

        my $choice=<>;
        chomp($choice);
        if (($choice ne '') && ($choice =~ /^[^\@]+\@[^\@]+$/)) {
            $camail=$choice;
            $flag=1;
        } else {
            print "Invalid input (a valid email address is required).\n";
        }
    }
    return $camail;
}

sub ssl_info {
    print(<<END);

****** Information about Country, State or Province and City *****

A two-letter country code, e.g., US, CA, DE etc. as defined by ISO 3166,
is required. A state or province, and a city are also required.
This locality information is included in two SSL certificates used internally
by LON-CAPA, unless you are running standalone.

If your server will be part of either the production or development
clusters, then the certificate will need to be signed by the official
LON-CAPA Certificate Authority (CA).  If you will be running your own
cluster then the cluster will need to create its own CA.

END
}

sub get_country {
    my ($desiredhostname) = @_;
# get Country
    my ($posscountry,$country);
    if ($desiredhostname =~ /\.(edu|com|org)$/) {
        $posscountry = 'us';
    } else {
        ($posscountry) = ($desiredhostname =~ /\.(a-z){2}$/);
    }
    if ($posscountry) {
        my $countrydesc = Locale::Country::code2country($posscountry);
        if ($countrydesc eq '') {
            undef($posscountry);
        }
    }

    my $flag=0;
    while (!$flag) {
        if ($posscountry) {
            $posscountry = uc($posscountry);
            print "Enter Two-Letter Country Code [$posscountry]:\n";
        } else {
            print "Enter the Two-Letter Country Code:\n";
        }
        my $choice=<STDIN>;
        chomp($choice);
        if ($choice ne '') {
            if (Locale::Country::code2country(lc($choice))) {
                $country=uc($choice);
                $flag=1;
            } else {
                print "Invalid input -- a valid two letter country code is required\n";
            }
        } elsif (($choice eq '') && ($posscountry ne '')) {
            $country = $posscountry;
            $flag = 1;
        } else {
            print "Invalid input -- a country code is required\n";
        }
    }
    return $country;
}

sub get_info {
    my ($typename) = @_;
    my $value;
    my $choice = <STDIN>;
    chomp($choice);
    $choice =~ s/(^\s+|\s+$)//g;
    if ($choice eq '') {
        print "$typename you entered was either blank or contained only white space.\n";
    } else {
        $value = $choice;
    }
    while ($value eq '') {
        $value = &get_info($typename);
    }
    print "\n";
    return $value;
}

sub get_days {
    my $value;
    my $choice = <STDIN>;
    chomp($choice);
    $choice =~ s/(^\s+|\s+$)//g;
    if ($choice eq '') {
        print "The value you entered was either blank or contained only white space.\n";
    } elsif ($choice !~ /^\d+$/) {
        print "The value you entered contained invalid characters -- you must enter just an integer.\n";
    } else {
        $value = $choice;
    }
    while ($value eq '') {
        $value = &get_days();
    }
    print "\n";
    return $value;
}

sub confirm_config {
    my (%data) = @_;
    my $flag = 0;
    while (!$flag) {
        print(<<END);

The cluster name, organization name, country, state and city will be 
included in the CA certificate, and in signed certificate(s) issued to
node(s) in the cluster (which will receive the default certficate lifetime).

1) Cluster Name: $data{'clustername'}
2) Organization Name: $data{'organization'}
3) Country: $data{'country'}
4) State or Province: $data{'state'}
5) City: $data{'city'}
6) E-mail: $data{'email'}
7) Default certificate lifetime for issued certs (days): $data{'days'}
8) CRL recreation interval (days): $data{'crldays'}
9) Everything is correct up above

Enter a choice of 1-8 to change, otherwise enter 9:
END
        my $choice=<STDIN>;
        chomp($choice);
        if ($choice == 1) {
            print(<<END);
1) Cluster Name: $data{'clustername'}
Enter new value:
END
            my $choice2=<STDIN>;
            chomp($choice2);
            $data{'clustername'}=$choice2;
            chomp($choice2);
            $data{'organization'}=$choice2;
        } elsif ($choice == 3) {
            print(<<END);
3) Country: $data{'country'}
Enter new value (this should be a two-character code, e,g, US, CA, DE):
END
            my $choice2=<STDIN>;
            chomp($choice2);
            $data{'country'} = uc($choice2);
        } elsif ($choice == 4) {
            print(<<END);
4) State or Province: $data{'state'}
Enter new value:
END
            my $choice2=<>;
            chomp($choice2);
            $data{'state'}=$choice2;
        } elsif ($choice == 5) {
            print(<<END);
5) City: $data{'city'}
Enter new value:
END
            my $choice2=<>;
            chomp($choice2);
            $data{'city'}=$choice2;
        } elsif ($choice == 6) {
            print(<<END);
6) E-mail: $data{'email'}
Enter new value:
END
            my $choice2=<>;
            chomp($choice2);
            $data{'email'}=$choice2;
        } elsif ($choice == 7) {
print(<<END);
7) Default certificate lifetime: $data{'days'}
Enter new value:
END
            my $choice2=<>;
            chomp($choice2);
            $choice2 =~ s/\D//g;
            $data{'days'}=$choice2;
        } elsif ($choice == 8) {
print(<<END);
8) CRL re-creation interval: $data{'crldays'}
Enter new value:
END
            my $choice2=<>;
            chomp($choice2);
            $choice2 =~ s/\D//g;
            $data{'crldays'}=$choice2;
        } elsif ($choice == 9) {
            $flag=1;
            foreach my $key (keys(%data)) { 
                $data{$key} =~ s{/}{ }g;
            }  
        } else {
            print "Invalid input.\n";
        }
    }
    return %data; 
}

sub get_user_selection {
    my ($defaultrun) = @_;
    my $do_action = 0;
    my $choice = <STDIN>;
    chomp($choice);
    $choice =~ s/(^\s+|\s+$)//g;
    my $yes = 'y';
    if ($defaultrun) {
        if (($choice eq '') || ($choice =~ /^\Q$yes\E/i)) {
            $do_action = 1;
        }
    } else {
        if ($choice =~ /^\Q$yes\E/i) {
            $do_action = 1;
        }
    }
    return $do_action;
}