Annotation of doc/loncapafiles/updatequery.piml, revision 1.89

1.2       harris41    1: <!-- updatequery.piml -->
1.1       harris41    2: 
1.89    ! raeburn     3: <!-- $Id: updatequery.piml,v 1.88 2017/05/19 00:56:34 raeburn Exp $ -->
1.1       harris41    4: 
                      5: <!--
                      6: 
                      7: This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      8: 
                      9: LON-CAPA is free software; you can redistribute it and/or modify
                     10: it under the terms of the GNU General Public License as published by
                     11: the Free Software Foundation; either version 2 of the License, or
                     12: (at your option) any later version.
                     13: 
                     14: LON-CAPA is distributed in the hope that it will be useful,
                     15: but WITHOUT ANY WARRANTY; without even the implied warranty of
                     16: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     17: GNU General Public License for more details.
                     18: 
                     19: You should have received a copy of the GNU General Public License
                     20: along with LON-CAPA; if not, write to the Free Software
                     21: Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     22: 
                     23: /home/httpd/html/adm/gpl.txt
                     24: 
                     25: http://www.lon-capa.org/
                     26: 
                     27: -->
                     28: 
                     29: <piml>
                     30: <targetroot>/</targetroot>
                     31: <files>
                     32: <file>
1.4       harris41   33: <target dist='default'>/</target>
1.1       harris41   34: <perlscript mode='fg'>
1.4       harris41   35: $|=1;
1.84      raeburn    36: use strict;
1.85      raeburn    37: use lib '/home/httpd/lib/perl/';
                     38: use LONCAPA::Configuration;
                     39: use LONCAPA::Lond;
                     40: use LONCAPA::SSL;
                     41: use LONCAPA;
                     42: use GDBM_File;
                     43: use Storable qw(thaw);
                     44: use Term::ReadKey;
                     45: use Locale::Country;
1.84      raeburn    46: 
1.88      raeburn    47: sub get_new_sslkeypass {
                     48:     my $sslkeypass;
                     49:     my $flag=0;
                     50: # get Password for SSL key
                     51:     while (!$flag) {
                     52:         $sslkeypass = &make_passphrase();
                     53:         if ($sslkeypass) {
                     54:             $flag = 1;
                     55:         } else {
                     56:             print "Invalid input (a password is required for the SSL key).\n";
                     57:         }
                     58:     }
                     59:     return $sslkeypass;
                     60: }
1.85      raeburn    61: 
                     62: sub get_static_config {
                     63: # get LCperlvars from loncapa_apache.conf
                     64:     my $confdir = '/etc/httpd/conf/';
1.89    ! raeburn    65:     if ('<DIST />' eq 'sles10' || '<DIST />' eq 'sles11' || '<DIST />' eq 'sles12' || '<DIST />' eq 'suse10.1' || '<DIST />' eq 'suse10.2' || '<DIST />' eq 'suse10.3' || '<DIST />' eq 'suse11.1' || '<DIST />' eq 'suse11.2' || '<DIST />' eq 'suse11.3' || '<DIST />' eq 'suse11.4' || '<DIST />' eq 'suse12.1' || '<DIST />' eq 'suse12.2' || '<DIST />' eq 'suse12.3' || '<DIST />' eq 'suse13.1' || '<DIST />' eq 'suse13.2' || '<DIST />' eq 'debian5' || '<DIST />' eq 'debian6' || '<DIST />' eq 'ubuntu6' || '<DIST />' eq 'ubuntu8' || '<DIST />' eq 'ubuntu10' || '<DIST />' eq 'ubuntu12' || '<DIST />' eq 'ubuntu14' || '<DIST />' eq 'ubuntu16' || '<DIST />' eq 'ubuntu18') {
1.85      raeburn    66:         $confdir = '/etc/apache2/';
                     67:     }
                     68:     my $filename='loncapa_apache.conf';
                     69:     my %LCperlvar;
                     70:     if (-e "$confdir$filename") {
                     71:         open(CONFIG,'&lt;'.$confdir.$filename) or die("Can't read $confdir$filename");
                     72:         while (my $configline=&lt;CONFIG&gt;) {
                     73:             if ($configline =~ /^[^\#]?PerlSetVar/) {
                     74:                 my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
                     75:                 chomp($varvalue);
                     76:                 $LCperlvar{$varname}=$varvalue;
                     77:             }
                     78:         }
                     79:         close(CONFIG);
                     80:     }
                     81:     return \%LCperlvar;
                     82: }
                     83: 
                     84: sub get_domain_config {
1.86      raeburn    85:     my ($dom,$primaryserver,$isprimary,$url,$perlvarref) = @_;
1.85      raeburn    86:     my %confhash;
                     87:     if ($isprimary) {
                     88:         if (ref($perlvarref) eq 'HASH') {
                     89:             my $lonusersdir = $perlvarref-&gt;{'lonUsersDir'};
                     90:             my $fname = $lonusersdir.'/'.$dom.'/configuration.db';
                     91:             if (-e $fname) {
                     92:                 my $dbref=&LONCAPA::locking_hash_tie($fname,&GDBM_READER());
                     93:                 if (ref($dbref) eq 'HASH') {
                     94:                     foreach my $key (sort(keys(%{$dbref}))) {
                     95:                         my $value = $dbref->{$key};
                     96:                         if ($value =~ s/^__FROZEN__//) {
                     97:                             $value = thaw(&LONCAPA::unescape($value));
                     98:                         } else {
                     99:                             $value = &LONCAPA::unescape($value);
                    100:                         }
                    101:                         $confhash{$key} = $value;
                    102:                     }
                    103:                     &LONCAPA::locking_hash_untie($dbref);
                    104:                 }
                    105:             }
                    106:         }
                    107:     } else {
1.86      raeburn   108:         if (open(PIPE,"wget --no-check-certificate '$url?primary=$primaryserver&format=raw' |")) {
1.85      raeburn   109:             my $config = '';
1.86      raeburn   110:             while (&lt;PIPE&gt;) {
1.85      raeburn   111:                 $config .= $_;
                    112:             }
                    113:             close(PIPE);
                    114:             if ($config) {
                    115:                 my @pairs=split(/\&/,$config);
                    116:                 foreach my $item (@pairs) {
                    117:                     my ($key,$value)=split(/=/,$item,2);
                    118:                     my $what = &LONCAPA::unescape($key);
                    119:                     if ($value =~ s/^__FROZEN__//) {
                    120:                         $value = thaw(&LONCAPA::unescape($value));
                    121:                     } else {
                    122:                         $value = &LONCAPA::unescape($value); 
                    123:                     }
                    124:                     $confhash{$what}=$value;
                    125:                 }
                    126:             }
                    127:         }
                    128:     }
                    129:     return (\%confhash);
                    130: }
                    131: 
                    132: sub make_passphrase {
                    133:     my ($got_passwd,$firstpass,$secondpass,$passwd);
                    134:     my $maxtries = 10;
                    135:     my $trial = 0;
                    136:     while ((!$got_passwd) && ($trial &lt; $maxtries)) {
1.88      raeburn   137:         $firstpass = &get_password('Enter a password for the SSL key (at least 6 characters long)');
1.85      raeburn   138:         if (length($firstpass) &lt; 6) {
                    139:             print('Password too short.'."\n".
                    140:               'Please choose a password with at least six characters.'."\n".
                    141:               'Please try again.'."\n");
                    142:         } elsif (length($firstpass) &gt; 30) {
                    143:             print('Password too long.'."\n".
                    144:                   'Please choose a password with no more than thirty characters.'."\n".
                    145:                   'Please try again.'."\n");
                    146:         } else {
                    147:             my $pbad=0;
                    148:             foreach (split(//,$firstpass)) {if ((ord($_)&lt;32)||(ord($_)&gt;126)){$pbad=1;}}
                    149:             if ($pbad) {
                    150:                 print('Password contains invalid characters.'."\n".
                    151:                       'Password must consist of standard ASCII characters.'."\n".
                    152:                       'Please try again.'."\n");
                    153:             } else {
                    154:                 $secondpass = &get_password('Enter password a second time');
                    155:                 if ($firstpass eq $secondpass) {
                    156:                     $got_passwd = 1;
                    157:                     $passwd = $firstpass;
                    158:                 } else {
                    159:                     print('Passwords did not match.'."\n".
                    160:                           'Please try again.'."\n");
                    161:                 }
                    162:             }
                    163:         }
                    164:         $trial ++;
                    165:     }
                    166:     return $passwd;
                    167: }
                    168: 
                    169: sub get_password {
                    170:     my ($prompt) = @_;
                    171:     local $| = 1;
                    172:     print $prompt.': ';
                    173:     my $newpasswd = '';
                    174:     ReadMode 'raw';
                    175:     my $key;
                    176:     while(ord($key = ReadKey(0)) != 10) {
                    177:         if(ord($key) == 127 || ord($key) == 8) {
                    178:             chop($newpasswd);
                    179:             print "\b \b";
                    180:         } elsif(!ord($key) &lt; 32) {
                    181:             $newpasswd .= $key;
                    182:             print '*';
                    183:         }
                    184:     }
                    185:     ReadMode 'normal';
                    186:     print "\n";
                    187:     return $newpasswd;
                    188: }
                    189: 
                    190: sub send_mail {
                    191:     my ($hostname,$recipient,$subj,$file) = @_;
                    192:     my $from = 'www@'.$hostname;
                    193:     my $certmail = "To: $recipient\n".
                    194:                    "From: $from\n".
                    195:                    "Subject: ".$subj."\n".
                    196:                    "Content-type: text/plain\; charset=UTF-8\n".
                    197:                    "MIME-Version: 1.0\n\n";
                    198:     if (open(my $fh,"&lt;$file")) {
                    199:         while (&lt;$fh&gt;) {
                    200:             $certmail .= $_;
                    201:         }
                    202:         close($fh);
                    203:         $certmail .= "\n\n";
                    204:         if (open(my $mailh, "|/usr/lib/sendmail -oi -t -odb")) {
                    205:             print $mailh $certmail;
                    206:             close($mailh);
                    207:             print "Mail sent ($subj) to $recipient\n";
                    208:         } else {
                    209:             print "Sending mail ($subj) to $recipient failed.\n";
                    210:         }
                    211:     }
                    212:     return;
                    213: }
                    214: 
1.88      raeburn   215: sub mail_csr {
                    216:     my ($types,$lonCluster,$lonHostID,$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarref) = @_;
                    217:     my ($camail,$flag);
                    218:     if ($lonCluster eq 'production' || $lonCluster eq 'development') {
                    219:         $camail = $perlvarref-&gt;{'SSLEmail'};
                    220:     } else {
                    221:         $flag=0;
                    222: # get Certificate Authority E-mail
                    223:         while (!$flag) {
                    224:             print(&lt;&lt;END);
                    225: 
                    226: ENTER EMAIL ADDRESS TO SEND CERTIFICATE SIGNING REQUESTS
                    227: END
                    228: 
                    229:             my $choice=&lt;&gt;;
                    230:             chomp($choice);
                    231:             if ($choice ne '') {
                    232:                 open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    233:                 print(OUT 'Certificate Authority Email Address'."\t".$choice."\n");
                    234:                 close(OUT);
                    235:                 $camail=$choice;
                    236:                 $flag=1;
                    237:             } else {
                    238:                 print "Invalid input (an email address is required).\n";
                    239:             }
                    240:         }
                    241:     }
                    242:     if ($camail) {
                    243:         my $subj;
                    244:         if (($types eq 'both') || ($types = 'host')) {
                    245:             if (-e "$certsdir/$connectcsr") {
                    246:                 $subj = "Certificate Request ($lonHostID)";
                    247:                 print(&send_mail($desiredhostname,$camail,$subj,"$certsdir/$connectcsr"));
                    248:             }
                    249:         }
                    250:         if (($types eq 'both') || ($types = 'hostname')) {
                    251:             if (-e "$certsdir/$replicatecsr") {
                    252:                 $subj = "Certificate Request (internal-$desiredhostname)";
                    253:                 print(&send_mail($desiredhostname,$camail,$subj,"$certsdir/$replicatecsr"));
                    254:             }
                    255:         }
                    256:     }
                    257: }
                    258: 
                    259: sub ssl_info {
                    260:     print(&lt;&lt;END);
                    261: 
                    262: ****** Information about Country, State or Province and City *****
                    263: 
                    264: A two-letter country code, e.g., US, CA, DE etc. as defined by ISO 3166,
                    265: is required. A state or province, and a city are also required.
                    266: This locality information is included in two SSL certificates used internally
                    267: by LON-CAPA, unless you are running standalone.
                    268: 
                    269: If your server will be part of either the production or development
                    270: clusters, then the certificate will need to be signed by the official
                    271: LON-CAPA Certificate Authority (CA).  If you will be running your own
                    272: cluster then the cluster will need to create its own CA.
                    273: 
                    274: END
                    275: }
                    276: 
                    277: sub get_country {
                    278:     my ($desiredhostname) = @_;
                    279: # get Country
                    280:     my ($posscountry,$country);
                    281:     if ($desiredhostname =~ /\.(edu|com|org)$/) {
                    282:         $posscountry = 'us';
                    283:     } else {
                    284:         ($posscountry) = ($desiredhostname =~ /\.(a-z){2}$/);
                    285:     }
                    286:     if ($posscountry) {
                    287:         my $countrydesc = &Locale::Country::code2country($posscountry);
                    288:         if ($countrydesc eq '') {
                    289:             undef($posscountry);
                    290:         }
                    291:     }
                    292: 
                    293:     my $flag=0;
                    294:     while (!$flag) {
                    295:         if ($posscountry) {
                    296:             $posscountry = uc($posscountry);
                    297:             print "ENTER TWO-LETTER COUNTRY CODE [$posscountry]:\n";
                    298:         } else {
                    299:             print "ENTER TWO-LETTER COUNTRY CODE:\n";
                    300:         }
                    301:         my $choice=&lt;&gt;;
                    302:         chomp($choice);
                    303:         if ($choice ne '') {
                    304:             if (&Locale::Country::code2country(lc($choice))) {
                    305:                 open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    306:                 print(OUT 'country'."\t".uc($choice)."\n");
                    307:                 close(OUT);
                    308:                 $country=uc($choice);
                    309:                 $flag=1;
                    310:             } else {
                    311:                 print "Invalid input -- a valid two letter country code is required\n";
                    312:             }
                    313:         } elsif (($choice eq '') && ($posscountry ne '')) {
                    314:             open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    315:             print(OUT 'country'."\t".$posscountry."\n");
                    316:             close(OUT);
                    317:             $country = $posscountry;
                    318:             $flag = 1;
                    319:         } else {
                    320:             print "Invalid input -- a country code is required\n";
                    321:         }
                    322:     }
                    323:     return $country;
                    324: }
                    325: 
                    326: sub get_state {
                    327: # get State or Province
                    328:     my $flag=0;
                    329:     my $state = '';
                    330:     while (!$flag) {
                    331:         print(&lt;&lt;END);
                    332: 
                    333: ENTER STATE OR PROVINCE NAME:
                    334: END
                    335: 
                    336:         my $choice=&lt;&gt;;
                    337:         chomp($choice);
                    338:         if ($choice ne '') {
                    339:             open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    340:             print(OUT 'state'."\t".$choice."\n");
                    341:             close(OUT);
                    342:             $state=$choice;
                    343:             $flag=1;
                    344:         } else {
                    345:             print "Invalid input (a state or province name is required).\n";
                    346:         }
                    347:     }
                    348:     return $state;
                    349: }
                    350: 
                    351: sub get_city {
                    352: # get City
                    353:     my $flag=0;
                    354:     my $city = '';
                    355:     while (!$flag) {
                    356:         print(&lt;&lt;END);
                    357: 
                    358: ENTER CITY NAME:
                    359: END
                    360: 
                    361:         my $choice=&lt;&gt;;
                    362:         chomp($choice);
                    363:         if ($choice ne '') {
                    364:             open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    365:             print(OUT 'city'."\t".$choice."\n");
                    366:             close(OUT);
                    367:             $city=$choice;
                    368:             $flag=1;
                    369:         } else {
                    370:             print "Invalid input (a city is required).\n";
                    371:         }
                    372:     }
                    373:     return $city;
                    374: }
                    375: 
                    376: sub confirm_locality {
                    377:     my ($domainDescription,$country,$state,$city) = @_;
                    378:     my $flag = 0;
                    379:     while (!$flag) {
                    380:         print(&lt;&lt;END);
                    381: 
                    382: The domain description, country, state and city will be
                    383: used in the SSL certificates
                    384: 
                    385: 1) Domain Description: $domainDescription
                    386: 2) Country: $country
                    387: 3) State or Province: $state
                    388: 4) City: $city
                    389: 5) Everything is correct up above
                    390: 
                    391: ENTER A CHOICE OF 1-4 TO CHANGE, otherwise ENTER 5:
                    392: END
                    393:         my $choice=&lt;&gt;;
                    394:         chomp($choice);
                    395:         if ($choice == 1) {
                    396:             print(&lt;&lt;END);
                    397: 1) Domain Description: $domainDescription
                    398: ENTER NEW VALUE
                    399: END
                    400:             my $choice2=&lt;&gt;;
                    401:             chomp($choice2);
                    402:             $domainDescription=$choice2;
                    403:         } elsif ($choice == 2) {
                    404:             print(&lt;&lt;END);
                    405: 2) Country: $country
                    406: ENTER NEW VALUE (this should be a two-character code, e,g, US, CA, DE)
                    407: END
                    408:             my $choice2=&lt;&gt;;
                    409:             chomp($choice2);
                    410:             $country = uc($choice2);
                    411:         } elsif ($choice == 3) {
                    412:             print(&lt;&lt;END);
                    413: 3) State or Province: $state
                    414: ENTER NEW VALUE:
                    415: END
                    416:             my $choice2=&lt;&gt;;
                    417:             chomp($choice2);
                    418:             $state=$choice2;
                    419:         } elsif ($choice == 4) {
                    420:             print(&lt;&lt;END);
                    421: 4) City: $city
                    422: ENTER NEW VALUE:
                    423: END
                    424:             my $choice2=&lt;&gt;;
                    425:             chomp($choice2);
                    426:             $city=$choice2;
                    427:         } elsif ($choice == 5) {
                    428:             $flag=1;
                    429:             $state =~ s{/}{ }g;
                    430:             $city =~ s{/}{ }g;
                    431:             $domainDescription =~ s{/}{ }g;
                    432:         } else {
                    433:             print "Invalid input.\n";
                    434:         }
                    435:     }
                    436:     return ($domainDescription,$country,$state,$city);
                    437: }
                    438: 
                    439: sub make_key {
                    440:     my ($certsdir,$privkey,$sslkeypass) = @_;
                    441: # generate SSL key
                    442:     if ($certsdir && $privkey) {
                    443:         if (-f "$certsdir/lonKey.enc") {
                    444:             my $mode = 0600;
                    445:             chmod $mode, "$certsdir/lonKey.enc";
                    446:         }
                    447:         open(PIPE,"openssl genrsa -des3 -passout pass:$sslkeypass -out $certsdir/lonKey.enc 2048 2&gt;&1 |");
                    448:         close(PIPE);
                    449:         if (-f "$certsdir/$privkey") {
                    450:             my $mode = 0600;
                    451:             chmod $mode, "$certsdir/$privkey";
                    452:         }
                    453:         open(PIPE,"openssl rsa -in $certsdir/lonKey.enc -passin pass:$sslkeypass -out $certsdir/$privkey -outform PEM |");
                    454:         close(PIPE);
                    455:         if (-f "$certsdir/lonKey.enc") {
                    456:             my $mode = 0400;
                    457:             chmod $mode, "$certsdir/lonKey.enc";
                    458:         }
                    459:         if (-f "$certsdir/$privkey") {
                    460:             my $mode = 0400;
                    461:             chmod $mode, "$certsdir/$privkey";
                    462:         }
                    463:     } else {
                    464:         print "Key creation failed.  Missing one or more of: certificates directory, key name\n";
                    465:     }
                    466: }
                    467: 
                    468: sub encrypt_key {
                    469:     my ($certsdir,$privkey,$sslkeypass) = @_;
                    470:     if ($certsdir && $privkey) { 
                    471:         if ((-f "$certsdir/$privkey") && (!-f "$certsdir/lonKey.enc")) {
                    472:             open(PIPE,"openssl rsa -des3 -in $certsdir/$privkey -out $certsdir/lonKey.enc |");
                    473:         }
                    474:     }
                    475:     return; 
                    476: }
                    477: 
                    478: sub make_host_csr {
                    479:     my ($certsdir,$sslkeypass,$connectcsr,$connectsubj) = @_;
                    480: # generate SSL csr for hostID
                    481:     if ($certsdir && $connectcsr && $connectsubj) {
                    482:         open(PIPE,"openssl req -key $certsdir/lonKey.enc -passin pass:$sslkeypass -new -batch -subj \"$connectsubj\" -out $certsdir/$connectcsr |");
                    483:         close(PIPE);
                    484:     } else {
                    485:         print "Creation of certificate signing request failed.  Missing one or more of: certificates directory, CSR name, or locality information.\n";
                    486:     }
                    487: }
                    488: 
                    489: sub make_hostname_csr {
                    490:     my ($certsdir,$sslkeypass,$replicatecsr,$replicatesubj) = @_;
                    491: # generate SSL csr for internal hostname
                    492:     if ($certsdir && $replicatecsr && $replicatesubj) {
                    493:         open(PIPE,"openssl req -key $certsdir/lonKey.enc -passin pass:$sslkeypass -new -batch -subj \"$replicatesubj\" -out $certsdir/$replicatecsr |");
                    494:         close(PIPE);
                    495:     } else {
                    496:         print "Creation of certificate signing request failed.  Missing one or more of: certificates directory, CSR name, or locality information.\n";
                    497:     }
                    498: }
                    499: 
                    500: sub securesetting {
                    501:     my (%perlvar) = @_;
                    502:     my ($securestatus,$securenum);
                    503:     if (($perlvar{'loncAllowInsecure'}) && ($perlvar{'londAllowInsecure'})) {
                    504:         $securenum = 4;
                    505:         $securestatus = 'Allow insecure connections - inbound and outbound';
                    506:     } elsif (($perlvar{'loncAllowInsecure'}) && (!$perlvar{'londAllowInsecure'})) {
                    507:         $securenum = 3;
                    508:         $securestatus = 'Outbound: allow insecure connections; Inbound: secure only';
                    509:     } elsif ((!$perlvar{'loncAllowInsecure'}) && ($perlvar{'londAllowInsecure'})) {
                    510:         $securenum = 2;
                    511:         $securestatus = 'Outbound: secure connections only; Inbound: allow insecure';
                    512:     } elsif ((!$perlvar{'loncAllowInsecure'}) && (!$perlvar{'londAllowInsecure'})) {
                    513:         $securenum = 1;
                    514:         $securestatus = 'Secure connections only - inbound and outbound ';
                    515:     }
                    516:     return ($securestatus,$securenum);
                    517: }
                    518: 
                    519: sub get_sslnames {
                    520:     my %sslnames = (
                    521:                       key      =&gt; 'lonnetPrivateKey',
                    522:                       host     =&gt; 'lonnetCertificate',
                    523:                       hostname =&gt; 'lonnetHostnameCertificate',
                    524:                       ca       =&gt; 'lonnetCertificateAuthority',
                    525:                    );
                    526:     return %sslnames;
                    527: }
                    528: 
                    529: sub get_ssldesc {
                    530:     my %ssldesc = (
                    531:                     key      =&gt; 'Private Key',
                    532:                     host     =&gt; 'Connections Certificate',
                    533:                     hostname =&gt; 'Replication Certificate',
                    534:                     ca       =&gt; 'LON-CAPA CA Certificate',
                    535:                   );
                    536:     return %ssldesc;
                    537: }
                    538: 
                    539: sub get_cert_status {
                    540:     my ($lonHostID,$perlvarstatic) = @_;
                    541:     my $currcerts = &LONCAPA::SSL::print_certstatus({$lonHostID =&gt; 1,},'text','cgi');
                    542:     my ($lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,%sslstatus);
                    543:     my $output = '';
                    544:     if ($currcerts eq "$lonHostID:error") {
                    545:         $output .= "No information available for SSL certificates\n";
                    546:         $sslstatus{'key'} = -1;
                    547:         $sslstatus{'host'} = -1;
                    548:         $sslstatus{'hostname'} = -1;
                    549:         $sslstatus{'ca'} = -1;
                    550:         $lonkeystatus = 'unknown status';
                    551:         $lonhostcertstatus = 'unknown status';
                    552:         $lonhostnamecertstatus = 'unknown status';
                    553:     } else {
                    554:         my %sslnames = &get_sslnames();
                    555:         my %ssldesc = &get_ssldesc();
                    556:         my ($lonhost,$info) = split(/\:/,$currcerts,2);
                    557:         if ($lonhost eq $lonHostID) {
                    558:             my @items = split(/\&/,$info);
                    559:             foreach my $item (@items) {
                    560:                 my ($key,$value) = split(/=/,$item,2);
                    561:                 my @data = split(/,/,$value);
                    562:                 if (grep(/^\Q$key\E$/,keys(%sslnames))) {
                    563:                     if (lc($data[0]) eq 'yes') {
                    564:                         $output .= "$ssldesc{$key} ".$perlvarstatic-&gt;{$sslnames{$key}}." available with status = $data[1]\n";
                    565:                         if ($key eq 'key') {
                    566:                             $lonkeystatus = "status: $data[1]";
                    567:                             if ($data[1] =~ /ok$/) {
                    568:                                 $sslstatus{$key} = 1;
                    569:                             }
                    570:                         } else {
                    571:                             my $setstatus;
                    572:                             if (($key eq 'host') || ($key eq 'hostname')) { 
                    573:                                 if ($data[1] eq 'otherkey') {
                    574:                                     $sslstatus{$key} = 4;
                    575:                                     $setstatus = 1;
                    576:                                     if ($key eq 'host') {
                    577:                                         $lonhostcertstatus = "status: created with different key";
                    578:                                     } elsif ($key eq 'hostname') {
                    579:                                         $lonhostnamecertstatus = "status: created with different key"; 
                    580:                                     }
                    581:                                 } elsif ($data[1] eq 'nokey') {
                    582:                                     $sslstatus{$key} = 5;
                    583:                                     $setstatus = 1;
                    584:                                     if ($key eq 'host') {
                    585:                                         $lonhostcertstatus = "status: created with missing key";
                    586:                                     } elsif ($key eq 'hostname') {
                    587:                                         $lonhostnamecertstatus = "status: created with missing key";
                    588:                                     }
                    589:                                 }
                    590:                             }
                    591:                             unless ($setstatus) {
                    592:                                 if ($data[1] eq 'expired') {
                    593:                                     $sslstatus{$key} = 2;
                    594:                                 } elsif ($data[1] eq 'future') {
                    595:                                     $sslstatus{$key} = 3;
                    596:                                 } else {
                    597:                                     $sslstatus{$key} = 1;
                    598:                                 }
                    599:                                 if ($key eq 'host') {
                    600:                                     $lonhostcertstatus = "status: $data[1]";
                    601:                                 } elsif ($key eq 'hostname') {
                    602:                                     $lonhostnamecertstatus = "status: $data[1]";
                    603:                                 }
                    604:                             }
                    605:                         }
                    606:                     } else {
                    607:                         $sslstatus{$key} = 0;
                    608:                         $output .= "$ssldesc{$key} ".$perlvarstatic-&gt;{$sslnames{$key}}." not available\n";
                    609:                         if (($key eq 'host') || ($key eq 'hostname')) {
                    610:                             my $csr = $perlvarstatic-&gt;{$sslnames{$key}};
                    611:                             $csr =~s /\.pem$/.csr/;
                    612:                             my $csrstatus;
                    613:                             if (-e $perlvarstatic-&gt;{'lonCertificateDirectory'}."/$csr") {
                    614:                                 open(PIPE,"openssl req -text -noout -verify -in ".$perlvarstatic-&gt;{'lonCertificateDirectory'}."/$csr 2&gt;&1 |");
                    615:                                 while(&lt;PIPE&gt;) {
                    616:                                     chomp();
                    617:                                     $csrstatus = $_;
                    618:                                     last;
                    619:                                 }
                    620:                                 close(PIPE);
                    621:                                 $output .= "Certificate signing request for $ssldesc{$key} available with status = $csrstatus\n\n";
                    622:                                 if ($key eq 'host') {
                    623:                                     $lonhostcertstatus = 'awaiting signature';
                    624:                                 } else {
                    625:                                     $lonhostnamecertstatus = 'awaiting signature';
                    626:                                 }
                    627:                                 $sslstatus{$key} = 3;
                    628:                             } else {
                    629:                                 $output .= "No certificate signing request available for $ssldesc{$key}\n\n";
                    630:                                 if ($key eq 'host') {
                    631:                                     $lonhostcertstatus = 'still needed';
                    632:                                 } else {
                    633:                                     $lonhostnamecertstatus = 'still needed';
                    634:                                 }
                    635:                             }
                    636:                         } elsif ($key eq 'key') {
                    637:                             $lonkeystatus = 'still needed';
                    638:                         }
                    639:                     }
                    640:                 }
                    641:             }
                    642:         }
                    643:     }
                    644:     return ($output,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,\%sslstatus);
                    645: }
                    646: 
                    647:   print(&lt;&lt;END);
                    648: 
                    649: 
                    650: *********************************************
                    651: *********************************************
                    652: ****                                     ****
                    653: **** LON-CAPA SYSTEM INFORMATION REQUEST ****
                    654: ****                                     ****
                    655: **** Please respond to the choices below ****
                    656: ****                                     ****
                    657: *********************************************
                    658: *********************************************
                    659: 
                    660: END
                    661: #sleep(3);
                    662: 
1.1       harris41  663: </perlscript>
                    664: </file>
                    665: <file>
1.85      raeburn   666: <target dist='default'>../../loncom/hosts.tab</target>
1.22      albertel  667: <perlscript mode='fg'>
1.82      raeburn   668: my $lonCluster;
1.85      raeburn   669: my $currCluster;
                    670: 
                    671: if (-l "<TARGET />") {
                    672:   my $currlink = readlink("<TARGET />");
                    673:   if ($currlink =~ /^new_(existing|standalone|development|production)_hosts\.tab$/) {
                    674:       $currCluster = $1;
                    675:   }
                    676:   my %clustertypes = (
1.86      raeburn   677:                        production  =&gt; 'PRODUCTION',
                    678:                        standalone  =&gt; 'STAND-ALONE',
                    679:                        development =&gt; 'DEVELOPMENT',
                    680:                        existing    =&gt; 'RUNNING YOUR OWN CLUSTER',
1.85      raeburn   681:                      );
                    682:   if (($currCluster) && (exists($clustertypes{$currCluster}))) {
                    683:       print(&lt;&lt;END);
                    684: 
                    685: The cluster type for this server is currently: $clustertypes{$currCluster}
                    686: END
                    687: 
                    688:   }
                    689: }
                    690: 
                    691: print(&lt;&lt;END);
1.22      albertel  692: 
                    693: ===============================================================================
1.85      raeburn   694: 
1.30      www       695: Which cluster option would you like to have installed?
                    696: IMPORTANT: to take advantage of the cluster options 1) and 3),
1.83      raeburn   697: you must contact loncapa\@loncapa.org.
1.30      www       698: 
                    699: 1) PRODUCTION - you want to eventually connect this machine to the
                    700:                 LON-CAPA content sharing network. This setting is for
                    701:                 schools, colleges, and universities, that currently
1.83      raeburn   702:                 are running - or in the future will run - courses.
1.22      albertel  703: 2) STAND-ALONE - you want this machine to run in 'stand-alone' mode and
1.83      raeburn   704:                  not be connected to other LON-CAPA machines for now.
1.30      www       705: 3) DEVELOPMENT - you want to do software (not content!) development with
                    706:                  this workstation and eventually link it with the
                    707:                  workstations of other LON-CAPA software developers.
1.40      albertel  708: 4) RUNNING YOUR OWN CLUSTER - this machine is not in the standard LON-CAPA
                    709:                  clusters and won't be in the future and you want the existing
                    710:                  hosts.tab and domain.tab files to be left alone.
                    711:                  (This choice is unlikely what you want to select.)
1.22      albertel  712: END
                    713: # Option number 26 will install rawhide_hosts.tab, but
                    714: # the typical user does not want to be part of an intensive
                    715: # machine test cluster.
                    716: 
                    717: # get input
                    718: # if valid then process, otherwise loop
1.82      raeburn   719: my $flag=0;
1.22      albertel  720: while (!$flag) {
                    721:   print "ENTER 1, 2, 3, or 4:\n";
                    722:   my $choice=&lt;&gt;;
                    723:   chomp($choice);
                    724:   if ($choice==1) {
                    725:     $lonCluster='production'; $flag=1;
                    726:   }
                    727:   elsif ($choice==2) {
                    728:     $lonCluster='standalone'; $flag=1;
                    729:   }
                    730:   elsif ($choice==3) {
                    731:     $lonCluster='development'; $flag=1;
                    732:   }
                    733:   elsif ($choice==4) {
                    734:     $lonCluster='existing'; $flag=1;
1.52      albertel  735:     foreach my $file ('hosts.tab','dns_hosts.tab',
                    736:                       'domain.tab','dns_domain.tab') {
                    737:         if (-e '/home/httpd/lonTabs/'.$file) {
                    738: 	    `cp /home/httpd/lonTabs/$file ../existing_$file`;
                    739:         }
                    740:         else {
                    741: 	    print &lt;&lt;END;
                    742: There is no existing /home/httpd/lonTabs/$file
1.22      albertel  743: END
1.52      albertel  744:             die('');
                    745:         }
1.27      albertel  746:     }
1.22      albertel  747:   }
                    748:   elsif ($choice==26) {
                    749:     $lonCluster='rawhide'; $flag=1;
                    750:   }
                    751: }
                    752: </perlscript>
                    753: </file>
                    754: <file>
1.10      harris41  755: <target dist='default'>/home/httpd/lonTabs/hosts.tab</target>
1.1       harris41  756: <perlscript mode='fg'>
1.4       harris41  757: $|=1;
1.20      albertel  758: my $domainDescription;
1.29      albertel  759: my $domainTabExtras;
1.43      raeburn   760: my $primaryLibServer;
1.60      raeburn   761: my $protocol;
1.65      raeburn   762: my $intdom;
1.84      raeburn   763: my $desiredhostname;
1.85      raeburn   764: my $city;
                    765: my $state;
                    766: my $country;
1.43      raeburn   767: my @libservers = ();
1.1       harris41  768: unless (-e "<TARGET />") {
                    769:   print(&lt;&lt;END);
                    770:            WELCOME TO LON-CAPA!
                    771: 
1.83      raeburn   772: If you have questions, please visit http://install.loncapa.org
                    773: or contact helpdesk\@loncapa.org.
1.1       harris41  774: 
                    775: ===============================================================================
1.85      raeburn   776: The following 10 values are needed to configure LON-CAPA:
1.4       harris41  777: * Machine Role
1.8       harris41  778: * LON-CAPA Domain Name
1.82      raeburn   779: * LON-CAPA Machine ID Name
                    780: * Server Administration E-mail Address
1.68      raeburn   781: * LON-CAPA Domain's Primary Library Server Machine ID
                    782: * Web Server Protocol
                    783: * Internet Domain Name of Your Institution
1.84      raeburn   784: * Hostname
1.85      raeburn   785: * City, State, Country for LON-CAPA SSL certificate 
                    786: * Password for key for creating SSL certificates
1.32      raeburn   787: ===============================================================================
                    788: 
                    789: In addition, a Support E-mail Address can also be included. If
                    790: an address is included then one of the options in the LON-CAPA 
                    791: help menu will be a link to a form that a user will complete to
                    792: request LON-CAPA help.  
                    793: 
1.1       harris41  794: END
1.3       harris41  795: 
1.4       harris41  796: open(OUT,'&gt;/tmp/loncapa_updatequery.out');
                    797: close(OUT);
                    798: 
1.3       harris41  799: # query for Machine Role
                    800:   print(&lt;&lt;END);
                    801: **** Machine Role ****
                    802: Library server (recommended if first-time installation of LON-CAPA):
                    803:    Servers that are repositories of authoritative educational resources.
1.83      raeburn   804:    These servers also provide the authoring spaces in which content
                    805:    creators (e.g., faculty instructors) create their learning content.
1.3       harris41  806: Access server:
                    807:    Servers that load-balance high-traffic delivery of educational resources
                    808:    over the world-wide web.
1.4       harris41  809: 1) Will this be a library server? (recommended if this is your first install)
1.3       harris41  810: 2) Or, will this be an access server?
                    811: END
1.4       harris41  812: my $flag=0;
                    813: my $r='';
                    814: my $lonRole;
                    815: while (!$flag) {
                    816:   print "ENTER A CHOICE OF 1 or 2:\n";
                    817:   my $choice=&lt;&gt;;
                    818:   chomp($choice);
                    819:   if ($choice==1) {
                    820:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    821:     print(OUT 'lonRole'."\t".'library'."\n");
                    822:     close(OUT);
                    823:     $lonRole='library';
                    824:     $r='l';
                    825:     $flag=1;
                    826:   }
                    827:   elsif ($choice==2) {
                    828:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    829:     print(OUT 'lonRole'."\t".'access'."\n");
                    830:     close(OUT);
                    831:     $lonRole='access';
                    832:     $r='a';
                    833:     $flag=2;
                    834:   }
                    835:   else {
                    836: 
                    837:   }
                    838: }
1.3       harris41  839: 
                    840: # need to recommend a machine ID name (ipdomain.l.somenumber)
1.36      albertel  841: my $hostname=`hostname -f`; chomp($hostname);
1.4       harris41  842: my $ipdomain='';
                    843: if ($hostname=~/([^\.]*)\.([^\.]*)$/) {
                    844:   $ipdomain=$1;
                    845: }
1.1       harris41  846: 
                    847:   print(&lt;&lt;END);
                    848: 
1.8       harris41  849: **** Domain ****
1.83      raeburn   850: [This does NOT need to correspond to an internet address domain.
1.45      www       851:  Please make this name short AND descriptive of your organization.
                    852:  Domain names are close to impossible to change later!!!
                    853:  Good examples might be "msu" or "bionet" or "vermontcc".
                    854:  Bad examples are "physics" (too general)
1.37      www       855:    or "michiganstateuniversity" (too long)
1.83      raeburn   856:    or "msuedu" (just make it "msu", or else make it msu.edu)
1.45      www       857:    or "msuphysics" (only if there is a good reason to limit to department
                    858:                     - we don't know of one)
1.37      www       859:    or "mydomain" (what is that?)
1.45      www       860:  Avoid multiple domains at the same institution, even if it means that you 
                    861:  have to actually work together with your colleagues. You can still run
                    862:  multiple library servers within the same domain.
                    863:  If this domain is eventually going to be part of the main production
1.82      raeburn   864:  cluster, you MUST contact the LON-CAPA group at MSU (loncapa\@loncapa.org)
1.45      www       865:  to have a domain name assigned, and then use it exactly as given. This is
                    866:  also true for test installs that might eventually turn into production setups.
1.83      raeburn   867:  The short domain name needs to be unique, if your aim is to join a cluster 
                    868:  containing existing domains. Stop now if you have not yet contacted the 
                    869:  MSU LON-CAPA group.] 
1.1       harris41  870: END
1.8       harris41  871: 
                    872: # get domain name
1.1       harris41  873: # accept if valid, if not valid, tell user and repeat
1.4       harris41  874: $flag=0;
1.8       harris41  875: my $lonDefDomain;
1.4       harris41  876: while (!$flag) {
                    877: if ($ipdomain) {
                    878: print(&lt;&lt;END);
1.8       harris41  879: ENTER LONCAPA DOMAIN [$ipdomain]:
1.4       harris41  880: END
                    881: }
                    882: else {
                    883:   print(&lt;&lt;END);
1.8       harris41  884: ENTER LONCAPA DOMAIN:
1.4       harris41  885: END
                    886: }
                    887:   my $choice=&lt;&gt;;
                    888:   chomp($choice);
1.18      harris41  889:   my $bad_domain_flag=0;
1.41      albertel  890:   my @bad_domain_names=('res','raw','userfiles','priv','adm','uploaded',
                    891: 	'editupload');
1.18      harris41  892:   foreach my $bad (@bad_domain_names) {
                    893:     $bad_domain_flag=1 if $choice eq $bad;
                    894:   }
1.37      www       895:   if ($choice=~/capa/i) {
                    896:      $bad_domain_flag=1;
                    897:   }
1.8       harris41  898:   if ($ipdomain and $choice=~/^\s*$/) {
                    899:     $choice=$ipdomain;
1.4       harris41  900:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41  901:     print(OUT 'lonDefDomain'."\t".$choice."\n");
1.4       harris41  902:     close(OUT);
1.8       harris41  903:     $lonDefDomain=$choice;
1.4       harris41  904:     $flag=1;
1.86      raeburn   905:   } elsif (length($choice)&gt;35) {
1.37      www       906:     print "Name too long\n";
1.86      raeburn   907:   } elsif (length($choice)&lt;2) {
1.37      www       908:     print "Name too short\n";
1.38      www       909:   } elsif ($bad_domain_flag) {
                    910:     print "Invalid input ('$choice' conflicts with LON-CAPA namespace).\n";
                    911:     print "Please try something different than '$choice'\n";
1.51      albertel  912:   } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
1.4       harris41  913:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41  914:     print(OUT 'lonDefDomain'."\t".$choice."\n");
1.4       harris41  915:     close(OUT);
1.8       harris41  916:     $lonDefDomain=$choice;
                    917:     $r='l';
1.4       harris41  918:     $flag=1;
1.37      www       919:   } else {
1.51      albertel  920:     print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
1.4       harris41  921:   }
                    922: }
1.1       harris41  923: 
1.20      albertel  924: # get domain description
                    925: # accept if valid, if not valid, tell user and repeat
                    926: $flag=0;
                    927: 
                    928: while (!$flag) {
                    929:   print(&lt;&lt;END);
                    930: 
                    931: **** Domain Description ****
                    932: String describing the domain, to be shown to users.
                    933: [Example, msu is Michigan State University]
                    934: ENTER DOMAIN DESCRIPTION:
                    935: END
                    936: 
                    937:   my $choice=&lt;&gt;;
                    938:   chomp($choice);
                    939:   if ($choice!~/:/) {
                    940:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    941:     print(OUT 'domainDescription'."\t".$choice."\n");
                    942:     close(OUT);
                    943:     $domainDescription=$choice;
                    944:     $flag=1;
                    945:   }
                    946:   else {
                    947:     print "Invalid input (no ':' allowed).\n";
                    948:   }
                    949: }
                    950: 
1.8       harris41  951: my $lonHostID;
                    952: if ($lonDefDomain) {
                    953:   $lonHostID=$lonDefDomain.$r.int(1+rand(9)); # should be probably also detect
                    954:                                               # against the hosts.tab
                    955: }
                    956: 
1.1       harris41  957:   print(&lt;&lt;END);
                    958: 
1.8       harris41  959: **** Machine ID Name ****
1.45      www       960: [This does NOT need to correspond to internet address names;
1.8       harris41  961:  this name MUST be unique to the whole LON-CAPA network;
1.45      www       962:  we recommend that you use a name based off of your institution.
                    963:  Good examples: "msul1" or "bioneta2".
                    964:  Bad examples: "loncapabox" or "studentsinside".
1.37      www       965:  Note that machine names are very hard to change later.]
1.1       harris41  966: END
1.8       harris41  967: # get machine name
1.1       harris41  968: # accept if valid, if not valid, tell user and repeat
1.4       harris41  969: $flag=0;
                    970: while (!$flag) {
                    971: if ($ipdomain) {
                    972: print(&lt;&lt;END);
1.8       harris41  973: ENTER LONCAPA MACHINE ID [$lonHostID]:
1.4       harris41  974: END
                    975: }
                    976: else {
                    977:   print(&lt;&lt;END);
1.8       harris41  978: ENTER LONCAPA MACHINE ID:
1.4       harris41  979: END
                    980: }
                    981:   my $choice=&lt;&gt;;
                    982:   chomp($choice);
1.37      www       983:   if ($choice=~/capa/i) {
                    984:     print "Invalid input (names containing 'capa' are reserved).\n";
                    985:   } elsif ($lonHostID and $choice=~/^\s*$/) {
1.8       harris41  986:     $choice=$lonHostID;
1.4       harris41  987:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41  988:     print(OUT 'lonHostID'."\t".$choice."\n");
1.4       harris41  989:     close(OUT);
1.8       harris41  990:     $lonHostID=$choice;
1.4       harris41  991:     $flag=1;
1.86      raeburn   992:   } elsif (length($choice)&gt;45) {
1.37      www       993:     print "Name too long\n";
1.86      raeburn   994:   } elsif (length($choice)&lt;4) {
1.37      www       995:     print "Name too short\n";
1.51      albertel  996:   } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
1.4       harris41  997:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41  998:     print(OUT 'lonHostID'."\t".$choice."\n");
1.4       harris41  999:     close(OUT);
1.8       harris41 1000:     $lonHostID=$choice;
1.4       harris41 1001:     $flag=1;
1.37      www      1002:   } else {
1.51      albertel 1003:     print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
1.4       harris41 1004:   }
                   1005: }
1.1       harris41 1006: 
1.43      raeburn  1007: # get primary library server in domain
                   1008: if ($lonRole eq 'library') {
                   1009:     if (!grep/^\Q$lonHostID\E$/,@libservers) {
                   1010:         push(@libservers,$lonHostID);
                   1011:     } 
                   1012:     if (@libservers == 1) {
                   1013:         $primaryLibServer = $libservers[0];
                   1014:     }
                   1015: }
1.68      raeburn  1016: 
                   1017: $flag=0;
1.43      raeburn  1018: while (!$flag) {
                   1019:   print(&lt;&lt;END);
                   1020: **** Domain's Primary Library Server ID ****
                   1021: This should be the LON-CAPA machine ID of a library server in your 
                   1022: domain.  If you only have a single library server in your domain, then
                   1023: the Primary Library server ID will be the machine ID of that server. 
                   1024: This server will be where domain data which are not associated with any
1.83      raeburn  1025: specific home library server will be stored (e.g., configurations that
                   1026: apply to all nodes in the domain).
1.43      raeburn  1027: END
                   1028:     if (defined($primaryLibServer)) {
                   1029:         print(&lt;&lt;END);
                   1030: ENTER DOMAIN'S PRIMARY LIBRARY SERVER ID [$primaryLibServer]:
                   1031: END
1.86      raeburn  1032:     } elsif (@libservers &gt; 0) {
1.43      raeburn  1033:         print(&lt;&lt;END);
                   1034: ENTER DOMAIN'S PRIMARY LIBRARY SERVER ID [$libservers[0]]
                   1035: END
                   1036:     } else {
                   1037:         print (&lt;&lt;END);
                   1038: No library servers could be identified for this domain.  If you have already installed LON-CAPA on a different server (designated as a library server) in this domain, please enter the LONCAPA MACHINE ID of that server.  If not, you will need to install a LON-CAPA library server.  Enter the MACHINE ID of the server you plan to designate as a library server.
                   1039: END
                   1040:     }
                   1041: 
                   1042:     my $choice=&lt;&gt;;
                   1043:     chomp($choice);
                   1044:     if ($primaryLibServer and $choice=~/^\s*$/) {
                   1045:         $choice=$primaryLibServer;
                   1046:         open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1047:         print(OUT 'primaryLibServer'."\t".$choice."\n");
                   1048:         close(OUT);
                   1049:         $flag=1;
1.86      raeburn  1050:     } elsif (length($choice)&gt;35) {
1.43      raeburn  1051:         print "Name too long\n";
1.86      raeburn  1052:     } elsif (length($choice)&lt;4) {
1.43      raeburn  1053:         print "Name too short\n";
1.51      albertel 1054:     } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
1.43      raeburn  1055:         open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1056:         print(OUT 'primaryLibServer'."\t".$choice."\n");
                   1057:         close(OUT);
                   1058:         $primaryLibServer=$choice;
                   1059:         $flag=1;
                   1060:     } else {
1.51      albertel 1061:         print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
1.43      raeburn  1062:     }
                   1063: }
                   1064: 
                   1065: 
1.32      raeburn  1066: # get admin e-mail address
1.4       harris41 1067: # accept if valid, if not valid, tell user and repeat
                   1068: $flag=0;
1.9       harris41 1069: my $lonAdmEMail;
1.4       harris41 1070: while (!$flag) {
1.1       harris41 1071:   print(&lt;&lt;END);
                   1072: 
1.85      raeburn  1073: **** Server Administrator's E-mail ****
1.1       harris41 1074: E-mail address of the person who will manage this machine
1.4       harris41 1075: [should be in the form somebody\@somewhere]
1.32      raeburn  1076: ENTER ADMIN E-MAIL ADDRESS:
1.1       harris41 1077: END
                   1078: 
1.4       harris41 1079:   my $choice=&lt;&gt;;
                   1080:   chomp($choice);
                   1081:   if ($choice=~/\@/) {
                   1082:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.9       harris41 1083:     print(OUT 'lonAdmEMail'."\t".$choice."\n");
1.4       harris41 1084:     close(OUT);
1.9       harris41 1085:     $lonAdmEMail=$choice;
1.4       harris41 1086:     $flag=1;
                   1087:   }
                   1088:   else {
                   1089:     print "Invalid input (this needs to look like an e-mail address!).\n";
                   1090:   }
                   1091: }
                   1092: 
1.32      raeburn  1093: 
                   1094: # get support e-mail address
                   1095: # accept if valid, if not valid, tell user and repeat
                   1096: $flag=0;
                   1097: my $lonSupportEMail;
                   1098: while (!$flag) {
                   1099:   print(&lt;&lt;END);
                   1100: 
                   1101: **** Support E-mail ****
                   1102: E-mail address of the person who will receive 
                   1103: help requests from LON-CAPA users who access 
                   1104: the system via this server. If the address is left blank,
                   1105: then a help support form will not be displayed 
                   1106: as part of the help menu.
                   1107: [should be in the form somebody\@somewhere]
                   1108: ENTER SUPPORT E-MAIL ADDRESS:
                   1109: END
                   1110: 
                   1111:   my $choice=&lt;&gt;;
                   1112:   chomp($choice);
                   1113:   $choice =~ s/\s//g;
1.33      albertel 1114:   if ( ($choice=~/\@/) || $choice eq '') {
1.32      raeburn  1115:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1116:     print(OUT 'lonSupportEMail'."\t".$choice."\n");
                   1117:     close(OUT);
                   1118:     $lonSupportEMail=$choice;
                   1119:     $flag=1;
                   1120:   }
                   1121:   else {
                   1122:     print "Invalid input (this either needs to be blank, or look like an e-mail address!).\n";
                   1123:   }
                   1124: }
                   1125: 
1.68      raeburn  1126: # get protocol
                   1127: # accept if valid, if not valid, tell user and repeat
                   1128: $flag=0;
1.60      raeburn  1129: while (!$flag) {
                   1130:   print(&lt;&lt;END);
                   1131: 
                   1132: ****  Web Server Protocol ****
                   1133: If you plan to run the Apache server with SSL enabled, 
                   1134: the protocol should be: https; otherwise it should be http.
1.68      raeburn  1135: ENTER WEB SERVER PROTOCOL [http]:
1.60      raeburn  1136: END
                   1137: 
                   1138:   my $choice=&lt;&gt;;
                   1139:   chomp($choice);
1.65      raeburn  1140:   if ($choice =~ /^https?$/) {
1.60      raeburn  1141:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1142:     print(OUT 'protocol'."\t".$choice."\n");
                   1143:     close(OUT);
                   1144:     $protocol=$choice;
                   1145:     $flag=1;
1.68      raeburn  1146:   } elsif ($choice eq '') {
                   1147:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1148:     print(OUT 'protocol'."\t".'http'."\n");
                   1149:     close(OUT);
                   1150:     $protocol = 'http';
                   1151:     $flag = 1;
                   1152:   } else {
1.60      raeburn  1153:     print "Invalid input (only http or https allowed).\n";
                   1154:   }
                   1155: }
1.32      raeburn  1156: 
1.68      raeburn  1157: # get internet domain
                   1158: # accept if valid, if not valid, tell user and repeat
                   1159: $flag=0;
1.65      raeburn  1160: while (!$flag) {
                   1161:   print(&lt;&lt;END);
                   1162: 
                   1163: ****  Internet Domain Name of Your Institution ****
                   1164: 
                   1165: The internet domain name used for servers at your institution 
                   1166: should be provided.  This will be similar to: ustate.edu or
1.83      raeburn  1167: topcollege.ac.uk or myhostingcompany.com, i.e., the part of
1.65      raeburn  1168: a server hostname which indicates to which organization the 
                   1169: server belongs.
                   1170: 
                   1171: ENTER INTERNET DOMAIN NAME:
                   1172: END
                   1173: 
                   1174:   my $choice=&lt;&gt;;
                   1175:   chomp($choice);
                   1176:   if ($choice =~/[^.]+\.[^.]+/) {
                   1177:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.68      raeburn  1178:     print(OUT 'internet domain'."\t".$choice."\n");
1.65      raeburn  1179:     close(OUT);
                   1180:     $intdom=$choice;
                   1181:     $flag=1;
                   1182:   }
                   1183:   else {
                   1184:     print "Invalid input (must be at least two levels separated by .  - e.g., ustate.edu).\n";
                   1185:   }
                   1186: }
                   1187: 
1.84      raeburn  1188: # get hostname
                   1189: # accept if valid, if not valid, tell user and repeat
                   1190: $flag=0;
                   1191: my $posshostname;
                   1192: if (($hostname =~ /^[A-Za-z0-9\-]+$/) && ($intdom ne '')) {
                   1193:     $posshostname = $hostname.'.'.$intdom;
                   1194: } 
                   1195: if (($hostname =~ /^[A-Za-z0-9\-]+\.[A-Za-z0-9\-]+/) &&
                   1196:     ($hostname =~ /^[A-Za-z0-9.\-]+$/)) {
                   1197:     $posshostname = $hostname;
                   1198: }
                   1199: while (!$flag) {
                   1200:   print(&lt;&lt;END);
                   1201: 
                   1202: ****** Hostname of the server/VM *****
                   1203: 
                   1204: The hostname of the server/VM is required. This will be similar to:
1.85      raeburn  1205: somename.ustate.edu or somename.department.ustate.edu, and would be
1.84      raeburn  1206: the web address which users would point their web browsers at to
                   1207: access the server.
                   1208: 
                   1209: END
                   1210: 
                   1211: if ($posshostname) {
                   1212:     print "ENTER HOSTNAME OF SERVER [$posshostname]:\n";
                   1213: } else {
                   1214:     print "ENTER HOSTNAME OF SERVER:\n";
                   1215: }
                   1216: 
                   1217:   my $choice=&lt;&gt;;
                   1218:   chomp($choice);
                   1219:   if (($choice =~ /^[A-Za-z0-9\-]+\.[A-Za-z0-9\-]+/) &&
                   1220:       ($choice =~ /^[A-Za-z0-9.\-]+$/)) {
                   1221:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1222:     print(OUT 'hostname'."\t".$choice."\n");
                   1223:     close(OUT);
                   1224:     $desiredhostname=$choice;
                   1225:     $flag=1;
                   1226:   } elsif (($choice eq '') && ($posshostname ne '')) {
                   1227:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1228:     print(OUT 'hostname'."\t$posshostname\n");
                   1229:     close(OUT);
                   1230:     $desiredhostname = $posshostname;
                   1231:     $flag = 1;
                   1232:   } else {
                   1233:     print "Invalid input (only letters, numbers, - and . allowed, with at least one .).\n";
                   1234:   }
                   1235: }
1.65      raeburn  1236: 
1.88      raeburn  1237: &ssl_info();
1.85      raeburn  1238: 
1.88      raeburn  1239: $country = &get_country($desiredhostname);
1.85      raeburn  1240: 
1.88      raeburn  1241: $state = &get_state();
1.85      raeburn  1242: 
1.88      raeburn  1243: $city = &get_city();
1.85      raeburn  1244: 
1.88      raeburn  1245: ($domainDescription,$country,$state,$city) = &confirm_locality($domainDescription,$country,$state,$city);
1.85      raeburn  1246: 
1.88      raeburn  1247: my $perlstaticref = &get_static_config();
                   1248: if (ref($perlstaticref) eq 'HASH') {
1.85      raeburn  1249:   my ($certsdir,$privkey,$connectcsr,$replicatecsr);
1.88      raeburn  1250:   $certsdir = $perlstaticref-&gt;{'lonCertificateDirectory'};
                   1251:   $privkey = $perlstaticref-&gt;{'lonnetPrivateKey'};
                   1252:   $connectcsr = $perlstaticref-&gt;{'lonnetCertificate'};
1.85      raeburn  1253:   $connectcsr =~ s/\.pem$/.csr/;
1.88      raeburn  1254:   $replicatecsr = $perlstaticref-&gt;{'lonnetHostnameCertificate'};
1.85      raeburn  1255:   $replicatecsr =~ s/\.pem$/.csr/;
                   1256: 
                   1257:   print(&lt;&lt;END);
                   1258: 
                   1259: ****** SSL Certificates *****
                   1260: 
                   1261: You need to provide a password to be used for the openssl key which
                   1262: will be stored in $certsdir, and will be used when creating two
                   1263: certificate signing requests: $connectcsr and $replicatecsr
                   1264: 
                   1265: END
                   1266: 
1.88      raeburn  1267:   my $sslkeypass = &get_new_sslkeypass();
1.85      raeburn  1268: 
                   1269:   if ($certsdir && $privkey) {
                   1270:     my $connectsubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=$lonHostID/OU=LONCAPA/emailAddress=$lonAdmEMail";
                   1271:     my $replicatesubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=internal-$desiredhostname/OU=LONCAPA/emailAddress=$lonAdmEMail";
                   1272: 
                   1273: # generate SSL key
1.88      raeburn  1274:     &make_key($certsdir,$privkey,$sslkeypass);
1.85      raeburn  1275: # generate SSL csr for hostID
1.88      raeburn  1276:     &make_host_csr($certsdir,$sslkeypass,$connectcsr,$connectsubj);
1.85      raeburn  1277: # generate SSL csr for internal hostname
1.88      raeburn  1278:     &make_hostname_csr($certsdir,$sslkeypass,$replicatecsr,$replicatesubj);
                   1279: # mail csr files to certificate@lon-capa.org (production or dev clusters).
                   1280:     &mail_csr('both',$lonCluster,$lonHostID,$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlstaticref);
1.85      raeburn  1281: 
1.88      raeburn  1282:     } else {
                   1283:         print "Could not acquire standard names for SSL Certificate files from loncapa_apache.conf\n";
1.85      raeburn  1284:     }
1.88      raeburn  1285: } else {
                   1286:     print "Could not acquire standard names for SSL Certificate files from loncapa_apache.conf\n";
1.85      raeburn  1287: }
                   1288: 
1.1       harris41 1289: # update loncapa.conf
1.49      raeburn  1290: my $confdir = '/etc/httpd/conf/';
1.89    ! raeburn  1291: if ('<DIST />' eq 'sles10' || '<DIST />' eq 'sles11' || '<DIST />' eq 'sles12' || '<DIST />' eq 'suse10.1' || '<DIST />' eq 'suse10.2' || '<DIST />' eq 'suse10.3' || '<DIST />' eq 'suse11.1' || '<DIST />' eq 'suse11.2' || '<DIST />' eq 'suse11.3' || '<DIST />' eq 'suse11.4' || '<DIST />' eq 'suse12.1' || '<DIST />' eq 'suse12.2' || '<DIST />' eq 'suse12.3' || '<DIST />' eq 'suse13.1' || '<DIST />' eq 'suse13.2' || '<DIST />' eq 'debian5' || '<DIST />' eq 'debian6' || '<DIST />' eq 'ubuntu6' || '<DIST />' eq 'ubuntu8' || '<DIST />' eq 'ubuntu10' || '<DIST />' eq 'ubuntu12' || '<DIST />' eq 'ubuntu14' || '<DIST />' eq 'ubuntu16' || '<DIST />' eq 'ubuntu18') {
1.49      raeburn  1292:      $confdir = '/etc/apache2/';
                   1293: }   
1.5       harris41 1294: my $filename='loncapa.conf';
                   1295: my %perlvar;
                   1296:     if (-e "$confdir$filename") {
                   1297: 	open(CONFIG,'&lt;'.$confdir.$filename) or die("Can't read $confdir$filename");
                   1298: 	while (my $configline=&lt;CONFIG&gt;) {
                   1299: 	    if ($configline =~ /^[^\#]*PerlSetVar/) {
                   1300: 		my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
                   1301: 		chomp($varvalue);
1.12      harris41 1302: 		$perlvar{$varname}=$varvalue if $varvalue!~/^\{\[\[\[\[/;
1.5       harris41 1303: 	    }
                   1304: 	}
                   1305: 	close(CONFIG);
                   1306:     }
                   1307:     $perlvar{'lonHostID'}=$lonHostID;
                   1308:     $perlvar{'lonDefDomain'}=$lonDefDomain;
1.9       harris41 1309:     $perlvar{'lonAdmEMail'}=$lonAdmEMail;
1.32      raeburn  1310:     $perlvar{'lonSupportEMail'}=$lonSupportEMail;
1.5       harris41 1311:     $perlvar{'lonRole'}=$lonRole;
1.16      harris41 1312:     unless ($perlvar{'lonLoadLim'} and $perlvar{'lonLoadLim'}!~/\{\[\[\[\[/) {
1.5       harris41 1313:        $perlvar{'lonLoadLim'}='2.00';
                   1314:     }
1.25      albertel 1315:     unless ($perlvar{'lonUserLoadLim'} and $perlvar{'lonUserLoadLim'}!~/\{\[\[\[\[/) {
                   1316:        $perlvar{'lonUserLoadLim'}='0';
                   1317:     }
1.16      harris41 1318:     unless ($perlvar{'lonExpire'} and $perlvar{'lonExpire'}!~/\{\[\[\[\[/) {
1.5       harris41 1319:        $perlvar{'lonExpire'}='86400';
                   1320:     }
1.16      harris41 1321:     unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
1.5       harris41 1322:        my $lonReceipt='';
1.11      harris41 1323:        srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
1.82      raeburn  1324:        my @alnum=(0..9,"a".."z");
1.5       harris41 1325:        foreach my $i (1..20) {
                   1326: 	 $lonReceipt.=$alnum[int(rand(36))];
                   1327:        }
                   1328:        $perlvar{'lonReceipt'}=$lonReceipt;
                   1329:     }
                   1330:     open(OUT,"&gt;$confdir$filename") or
                   1331:       die("Cannot output to $confdir$filename\n");
                   1332:     foreach my $key (keys %perlvar) {
                   1333:       my $value=$perlvar{$key};
1.49      raeburn  1334:       my $line = "PerlSetVar     $key      $value"; 
                   1335:       if ($value eq '') {
                   1336:           $line = '#'.$line;
                   1337:       }
1.5       harris41 1338:       print(OUT &lt;&lt;END);
1.49      raeburn  1339: $line
1.5       harris41 1340: END
                   1341:     }
                   1342:     close(OUT);
1.1       harris41 1343: }
                   1344: </perlscript>
                   1345: </file>
                   1346: <file>
1.49      raeburn  1347: <target dist='default'>/etc/httpd/conf/</target>
1.89    ! raeburn  1348: <target dist='sles10 sles11 sles12 suse10.1 suse10.2 suse10.3 suse11.1 suse11.2 suse11.3 suse11.4 suse12.1 suse12.2 suse12.3 suse13.1 suse13.2 debian5 debian6 ubuntu6 ubuntu8 ubuntu10 ubuntu12 ubuntu14 ubuntu16 ubuntu18'>/etc/apache2/</target>
1.1       harris41 1349: <perlscript mode='fg'>
                   1350: # read values from loncapa.conf
1.49      raeburn  1351: my $confdir = "<TARGET />";
1.5       harris41 1352: my $filename='loncapa.conf';
                   1353: my %perlvar;
                   1354:     if (-e "$confdir$filename") {
                   1355: 	open(CONFIG,'&lt;'.$confdir.$filename) or 
                   1356:           die("Can't read $confdir$filename");
                   1357: 	while (my $configline=&lt;CONFIG&gt;) {
                   1358: 	    if ($configline =~ /^[^\#]*PerlSetVar/) {
                   1359: 		my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
                   1360: 		chomp($varvalue);
                   1361: 		$perlvar{$varname}=$varvalue;
                   1362: 	    }
                   1363: 	}
                   1364: 	close(CONFIG);
                   1365:     }
1.16      harris41 1366:     unless ($perlvar{'lonLoadLim'} and $perlvar{'lonLoadLim'}!~/\{\[\[\[\[/) {
                   1367:        $perlvar{'lonLoadLim'}='2.00';
                   1368:     }
1.25      albertel 1369:     unless ($perlvar{'lonUserLoadLim'} and $perlvar{'lonUserLoadLim'}!~/\{\[\[\[\[/) {
                   1370:        $perlvar{'lonUserLoadLim'}='0';
                   1371:     }
1.16      harris41 1372:     unless ($perlvar{'lonExpire'} and $perlvar{'lonExpire'}!~/\{\[\[\[\[/) {
                   1373:        $perlvar{'lonExpire'}='86400';
                   1374:     }
1.31      albertel 1375:     unless ($perlvar{'londAllowInsecure'} and $perlvar{'londAllowInsecure'}!~/\{\[\[\[\[/) {
                   1376:        $perlvar{'londAllowInsecure'}='1';
                   1377:     }
                   1378:     unless ($perlvar{'loncAllowInsecure'} and $perlvar{'loncAllowInsecure'}!~/\{\[\[\[\[/) {
                   1379:        $perlvar{'loncAllowInsecure'}='1';
                   1380:     }
1.88      raeburn  1381:     my ($securestatus,$securenum)=&securesetting(%perlvar);
1.16      harris41 1382:     unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
                   1383:        my $lonReceipt='';
                   1384:        srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
1.82      raeburn  1385:        my @alnum=(0..9,"a".."z");
1.16      harris41 1386:        foreach my $i (1..20) {
                   1387: 	 $lonReceipt.=$alnum[int(rand(36))];
                   1388:        }
                   1389:        $perlvar{'lonReceipt'}=$lonReceipt;
                   1390:     }
1.88      raeburn  1391:     my $perlvarstatic = &get_static_config();
1.55      albertel 1392: 
                   1393:     my (@hosts_files, @domain_files);
                   1394:     if ( $lonCluster ne 'existing') {
                   1395: 	push(@domain_files,'../'.$lonCluster.'_domain.tab',
                   1396: 	     '../'.$lonCluster.'_dns_domain.tab');
                   1397: 	push(@hosts_files,'../'.$lonCluster.'_hosts.tab',
                   1398: 	     '../'.$lonCluster.'_dns_hosts.tab');
                   1399:     }
                   1400:     push(@domain_files,'/home/httpd/lonTabs/domain.tab',
                   1401:          '/home/httpd/lonTabs/dns_domain.tab');
                   1402:     push(@hosts_files,'/home/httpd/lonTabs/hosts.tab',
                   1403:          '/home/httpd/lonTabs/dns_hosts.tab');
                   1404: 
1.85      raeburn  1405:     my @poss_hosts_files = @hosts_files;
1.23      albertel 1406:     if (!$domainDescription) {
1.55      albertel 1407: 	foreach my $file (@domain_files) {
                   1408: 	    open(IN,'&lt;'.$file);
                   1409: 	    while(my $line = &lt;IN&gt;) {
                   1410: 		if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
                   1411: 		    (undef,$domainDescription,$domainTabExtras)=split(/:/,$line,3);
                   1412: 		    chomp($domainDescription);
                   1413: 		    chomp($domainTabExtras);
1.60      raeburn  1414: 		    # the remaining field (primary lib server) is handled later
1.55      albertel 1415: 		    $domainTabExtras = join(':',(split(/:/,$domainTabExtras))[0..5]);
                   1416: 		    last;
                   1417: 		}
                   1418: 	    }
                   1419: 	    close(IN);
                   1420: 	    last if ($domainDescription);
                   1421: 	}
1.23      albertel 1422:     }
1.55      albertel 1423: 
1.84      raeburn  1424:     if ((!$protocol) || (!$desiredhostname)) {
1.60      raeburn  1425:         foreach my $file (@hosts_files) {
                   1426:             open(IN,'&lt;'.$file);
                   1427:             while(my $line = &lt;IN&gt;) {
1.84      raeburn  1428:                 if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:([^:]+)\:(https?)/) {
                   1429:                     if (!$desiredhostname) {
                   1430:                         $desiredhostname = $1;
                   1431:                     }
                   1432:                     if (!$protocol) { 
                   1433:                         $protocol = $2;
                   1434:                         chomp($protocol);
                   1435:                     }
1.60      raeburn  1436:                     last;
                   1437:                 }
                   1438:             }
                   1439:         }
                   1440:     }
                   1441: 
                   1442:     if (!$protocol) {
                   1443:         $protocol = 'http';
                   1444:     }
                   1445: 
1.65      raeburn  1446:     if (!$intdom) {
                   1447:         foreach my $file (@hosts_files) {
                   1448:             open(IN,'&lt;'.$file);
                   1449:             while(my $line = &lt;IN&gt;) {
1.66      raeburn  1450:                 if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:[^:]+\:https?\:([^:]+)/) {
1.65      raeburn  1451:                     $intdom = $1;
1.66      raeburn  1452:                     chomp($intdom);
1.65      raeburn  1453:                     last;
                   1454:                 }
                   1455:             }
                   1456:         }
                   1457:     }
                   1458: 
1.85      raeburn  1459:     my (%hostnames,%protocols);
1.82      raeburn  1460:     while(!$primaryLibServer && (@hosts_files || @domain_files)) {
1.55      albertel 1461: 	my $file = shift(@domain_files);
                   1462:         open(IN,'&lt;'.$file);
                   1463:         while(my $line = &lt;IN&gt;) {
                   1464:             if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
                   1465: 		$primaryLibServer=(split(/:/,$line))[8];
1.43      raeburn  1466:                 chomp($primaryLibServer);
                   1467:             }
                   1468:         }
                   1469:         close(IN);
1.55      albertel 1470: 	last if ($primaryLibServer);
                   1471: 	$file = shift(@hosts_files);
                   1472: 	open(IN,'&lt;'.$file);
                   1473: 	while(my $line = &lt;IN&gt;) {
1.85      raeburn  1474: 	    if ($line =~ /^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:([^\:]+)/) {
1.55      albertel 1475: 		push(@libservers,$1);
1.85      raeburn  1476:                 $hostnames{$1} = $2;
1.55      albertel 1477: 	    }
                   1478: 	}
1.58      albertel 1479: 	# make list unique
1.86      raeburn  1480: 	@libservers = keys(%{{ map { $_ =&gt; 1 } (@libservers) }});
1.55      albertel 1481: 	close(IN);
                   1482: 	if (@libservers == 1) {
                   1483: 	    $primaryLibServer = $libservers[0];
                   1484: 	}
1.43      raeburn  1485:     }
1.85      raeburn  1486: 
                   1487: # get hostname of primaryLibServer
                   1488:     my ($primary_hostname,$primary_protocol);
                   1489:     if ($primaryLibServer) {
                   1490:         if ($hostnames{$primaryLibServer}) {
                   1491:             $primary_hostname = $hostnames{$primaryLibServer};
                   1492:             $primary_protocol = $protocols{$primaryLibServer};
                   1493:         } else {
                   1494:             foreach my $file (@poss_hosts_files) {
                   1495:                 open(IN,'&lt;'.$file);
                   1496:                 while (my $line = &lt;IN&gt;) {
                   1497:                     if ($line =~ /^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:([^\:]+):(https?)/) {
                   1498:                         if ($1 eq $primaryLibServer) {
                   1499:                             $primary_hostname = $2;
                   1500:                             $primary_protocol = $3;
                   1501:                             last;
                   1502:                         }
                   1503:                     }
                   1504:                 }
                   1505:                 close(IN);
                   1506:                 last if ($primary_hostname);
                   1507:             }
                   1508:         }
                   1509:     }
1.23      albertel 1510:    
1.6       harris41 1511: # implement editing logic below, interactively
1.88      raeburn  1512: # update loncapa.conf until 18 is entered
1.6       harris41 1513: 
1.82      raeburn  1514: my $flag=0;
1.17      harris41 1515: 
1.85      raeburn  1516: #
                   1517: # Changes to 5, 6, and 14 not supported if configuration.db set on primary library server.
                   1518: # (requires either this machine to be primary library server or for LON-CAPA and Apache
1.88      raeburn  1519: # to be running on primary library server).
1.85      raeburn  1520: #
                   1521: 
                   1522: my ($isprimary,$domconf,$url,$gotdomconf,$adminmail,$supportmail,$connectssl,%setbygui);
                   1523: if ($primaryLibServer eq $perlvar{'lonHostID'}) {
                   1524:     $isprimary = 1;
                   1525: } else {
                   1526:     unless ($primary_protocol eq 'https') {
                   1527:         $primary_protocol = 'http';
                   1528:     } 
                   1529:     $url = $primary_protocol.'://'.$primary_hostname.'/cgi-bin/listdomconfig.pl';
                   1530: }
1.88      raeburn  1531: 
                   1532: my %sslnames = &get_sslnames();
                   1533: my %ssldesc = &get_ssldesc();
                   1534: 
1.86      raeburn  1535: my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary,
1.88      raeburn  1536:                                  $url,$perlvarstatic);
1.85      raeburn  1537: if (ref($domconf)) {
                   1538:     $gotdomconf = 1;
1.86      raeburn  1539:     if (ref($domconf-&gt;{'contacts'}) eq 'HASH') {
                   1540:         if (exists($domconf-&gt;{'contacts'}-&gt;{'adminemail'})) {
                   1541:             $adminmail = $domconf-&gt;{'contacts'}-&gt;{'adminemail'};
1.85      raeburn  1542:         }
                   1543:         if (exists($domconf->{'contacts'}->{'supportemail'})) {
1.86      raeburn  1544:             $supportmail = $domconf-&gt;{'contacts'}-&gt;{'supportemail'};
1.85      raeburn  1545:         }
                   1546:     }
1.86      raeburn  1547:     if (ref($domconf-&gt;{'ssl'}) eq 'HASH') {
                   1548:         foreach my $connect ('connto','connfrom') { 
                   1549:             if (ref($domconf-&gt;{'ssl'}-&gt;{$connect}) eq 'HASH') {       
                   1550:                 my ($sslreq,$sslnoreq,$currsetting);
                   1551:                 my %contypes; 
                   1552:                 foreach my $type ('dom','intdom','other') {
                   1553:                     my $key;
                   1554:                     if ($domconf-&gt;{'ssl'}-&gt;{'connect'}-&gt;{$type} eq 'req') {
                   1555:                         $key = 'yes';
                   1556:                     } else {
                   1557:                         $key = 'no';
                   1558:                     }
                   1559:                     if ($type eq 'dom') {
                   1560:                         $contypes{$key} .= ' own domain,';
                   1561:                     } elsif ($type eq 'intdom') {
                   1562:                         $contypes{$key} .= ' own institution,';
                   1563:                     } elsif ($type eq 'other') { 
                   1564:                         $contypes{$key} .= ' other domains,';
                   1565:                     }
1.85      raeburn  1566:                 }
1.86      raeburn  1567:                 foreach my $key (sort(keys(%contypes))) {
                   1568:                     $contypes{$key} =~ s/^\s//;
                   1569:                     $contypes{$key} =~ s/,$//;
                   1570:                     if ($key eq 'yes') {
                   1571:                         $currsetting .= ' Yes ('.$contypes{$key}.'),';
                   1572:                     } elsif ($key eq 'no') {
                   1573:                         $currsetting .= ' No ('.$contypes{$key}.')';
                   1574:                     }
                   1575:                     $currsetting =~ s/,$//;
1.85      raeburn  1576:                 }
1.86      raeburn  1577:                 if ($currsetting ne '') {
1.88      raeburn  1578:                     $connectssl = $sslnames{$connect}.' -- '.$currsetting.' | '; 
1.85      raeburn  1579:                 }
                   1580:             }
                   1581:         }
1.86      raeburn  1582:         $connectssl =~ s/\s\|\s$//; 
1.85      raeburn  1583:     }
                   1584: }
                   1585: if ($connectssl) {
                   1586:     $setbygui{'securestatus'} = 1;
                   1587:     $securestatus = 'Set by domain configuration via web GUI. Currently: '.$connectssl; 
                   1588: }
                   1589: if ($adminmail) {
                   1590:     $adminmail = 'Set by domain configuration via web GUI. Currently: '.$adminmail;
                   1591:     $setbygui{'lonAdmEMail'} = 1;
                   1592: } else {
                   1593:     $adminmail = $perlvar{'lonAdmEMail'};
                   1594: }
                   1595: if ($supportmail) {
                   1596:     $supportmail = 'Set by domain configuration via web GUI. Currently: '.$supportmail;
                   1597:     $setbygui{'lonSupportEMail'} = 1;
                   1598: } else {
                   1599:     $supportmail = $perlvar{'lonSupportEMail'};
                   1600: }
                   1601: 
                   1602: print "\nRetrieving status information for SSL key and certificates ...\n\n";
1.88      raeburn  1603: my ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) = 
                   1604:     &get_cert_status($perlvar{'lonHostID'},$perlvarstatic);
                   1605: print $certinfo;
1.85      raeburn  1606: my %sslstatus;
1.88      raeburn  1607: if (ref($sslref) eq 'HASH') {
                   1608:     %sslstatus = %{$sslref};
1.85      raeburn  1609: }
                   1610: 
1.6       harris41 1611: while (!$flag) {
1.1       harris41 1612:   print(&lt;&lt;END);
                   1613: 
                   1614: ===============================================================================
                   1615: This is now the current configuration of your machine.
1.31      albertel 1616:  1) Domain Name: $perlvar{'lonDefDomain'}
                   1617:  2) Domain Description: $domainDescription
                   1618:  3) Machine Name: $perlvar{'lonHostID'}
1.43      raeburn  1619:  4) ID of primary library server for domain: $primaryLibServer
1.85      raeburn  1620:  5) Server Administrator's E-mail Address: $adminmail
                   1621:  6) Support E-mail Address: $supportmail
1.60      raeburn  1622:  7) Web Server Protocol (http or https): $protocol 
1.65      raeburn  1623:  8) Internet Domain Name: $intdom 
1.84      raeburn  1624:  9) Hostname: $desiredhostname
                   1625: 10) Role: $perlvar{'lonRole'}
1.85      raeburn  1626: 11) Cache Expiration Time: $perlvar{'lonExpire'} (seconds)
1.84      raeburn  1627: 12) Server Load: $perlvar{'lonLoadLim'}
                   1628: 13) User Load: $perlvar{'lonUserLoadLim'}
1.88      raeburn  1629: 14) LON-CAPA "internal" connections: $securestatus
1.85      raeburn  1630: 15) Private Key for SSL: $lonkeystatus
                   1631: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1632: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   1633: 18) Everything is correct up above
1.6       harris41 1634: END
1.38      www      1635: 
1.54      albertel 1636: my @error;
1.38      www      1637: foreach my $v ($perlvar{'lonDefDomain'},$perlvar{'lonHostID'}) {
1.86      raeburn  1638:    if (length($v)&gt;35) { push(@error,"Name $v too long"); }		
                   1639:    if (length($v)&lt;2) { push(@error,"Name $v too short"); }
1.39      albertel 1640:    if ($v=~/capa/i) {
                   1641: 	if ($v!~/^oucapa\d+$/ && 
                   1642: 	    ($v!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
1.54      albertel 1643: 		 push(@error,"Name $v contains 'capa'");
1.39      albertel 1644: 	}
                   1645:    }
1.41      albertel 1646:    foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
                   1647: 	'editupload') {
1.54      albertel 1648:       push(@error,"\nName $v reserved.") if $v eq $bad;
1.38      www      1649:    }
1.54      albertel 1650:    if ($v=~/[^\w\-.]/) { push(@error,"Name $v contains special characters"); }
1.38      www      1651: }
1.53      albertel 1652: if ($domainDescription =~ /^\s*$/) {
1.54      albertel 1653:    push(@error,"Domain Description is blank.");
1.53      albertel 1654: } elsif ($domainDescription!~/^[\(\)\-\w\s,]+$/) {
1.54      albertel 1655:    push(@error,"Domain Description contains special characters.");
1.38      www      1656: } 
                   1657: foreach my $v ($perlvar{'lonExpire'},$perlvar{'lonLoadLim'}) {
1.54      albertel 1658:    unless ($v=~/^[\d+\.]+$/) { push(@error,"Number expected instead of $v"); }
1.38      www      1659: }
                   1660: unless (($perlvar{'lonRole'} eq 'library') || ($perlvar{'lonRole'} eq 'access')) {
1.54      albertel 1661:    push(@error,"Invalid Role");
1.17      harris41 1662: }
1.43      raeburn  1663: 
1.60      raeburn  1664: unless (($protocol eq 'http') || ($protocol eq 'https')) {
                   1665:    push(@error,"Invalid Protocol (must be http or https");
                   1666: }
                   1667: 
1.65      raeburn  1668: if (!defined($intdom)) { 
                   1669:    push(@error,"No internet domain name designated. Enter something like ustate.edu"); 
1.71      raeburn  1670: } elsif ($intdom !~ /[^.]+\.\w{2,6}$/) {
1.65      raeburn  1671:    push(@error,"Invalid Internet domain name (must be at least two levels separated by .  - e.g., ustate.edu");
                   1672: }
                   1673: 
1.43      raeburn  1674: if (!defined($primaryLibServer)) {
1.86      raeburn  1675:    if (@libservers &gt; 0) {
1.54      albertel 1676:        push(@error,"No primary library server ID designated. Choose from: ".join(',',sort(@libservers)));
1.43      raeburn  1677:    } else {
1.54      albertel 1678:        push(@error,"No library servers in this domain (including current server)");
1.43      raeburn  1679:    }
                   1680: } else {
1.86      raeburn  1681:    if (length($primaryLibServer)&gt;35) { push(@error,"Primary Library Server ID:  $primaryLibServer too long"); }
                   1682:    if (length($primaryLibServer)&lt;2) { push(@error,"Primary Library Server ID:  $primaryLibServer too short"); }
1.43      raeburn  1683:    if ($primaryLibServer =~/capa/i) {
                   1684:         if ($primaryLibServer!~/^oucapa\d+$/ &&
                   1685:             ($primaryLibServer!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
1.54      albertel 1686:                  push(@error,"Primary library server ID $primaryLibServer contains 'capa'")
1.43      raeburn  1687:         }
                   1688:    }
                   1689:    foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
                   1690:         'editupload') {
1.54      albertel 1691:       push(@error,"Primary library server ID $primaryLibServer reserved.") if $primaryLibServer eq $bad;
1.43      raeburn  1692:    }
1.54      albertel 1693:    if ($primaryLibServer=~/[^\w\-.]/) { push(@error,"Primary library server ID $primaryLibServer contains special characters"); }
1.43      raeburn  1694: }
                   1695: 
                   1696: 
1.85      raeburn  1697: my ($certsdir,$privkey,$connectcsr,$replicatecsr);
1.88      raeburn  1698: $certsdir = $perlvarstatic-&gt;{'lonCertificateDirectory'};
                   1699: $privkey = $perlvarstatic-&gt;{'lonnetPrivateKey'};
                   1700: $connectcsr = $perlvarstatic-&gt;{'lonnetCertificate'};
1.85      raeburn  1701: $connectcsr =~ s/\.pem$/.csr/;
1.88      raeburn  1702: $replicatecsr = $perlvarstatic-&gt;{'lonnetHostnameCertificate'};
1.85      raeburn  1703: $replicatecsr =~ s/\.pem$/.csr/;
                   1704: 
1.54      albertel 1705: if (@error) { print "\n*** ERRORS: \n\t".join("\n\t",@error)."\n"; }
1.6       harris41 1706:   print(&lt;&lt;END);
1.85      raeburn  1707: ENTER A CHOICE OF 1-17 TO CHANGE, otherwise ENTER 18:
1.1       harris41 1708: END
1.5       harris41 1709: my $choice=&lt;&gt;;
                   1710: chomp($choice);
1.6       harris41 1711:   if ($choice==1) {
                   1712:   print(&lt;&lt;END);
1.16      harris41 1713: 1) Domain Name: $perlvar{'lonDefDomain'}
1.20      albertel 1714: ENTER NEW VALUE (this is an internal value used to identify a group of
                   1715:                  LON-CAPA machines, it must be alphanumerical, we suggest
                   1716:                  using a part of your actual DNS domain. For example, for
                   1717:                  the machine loncapa.msu.edu, we set the Domain to msu):
1.6       harris41 1718: END
                   1719:     my $choice2=&lt;&gt;;
                   1720:     chomp($choice2);
1.8       harris41 1721:     $perlvar{'lonDefDomain'}=$choice2;
1.6       harris41 1722:   }
                   1723:   elsif ($choice==2) {
                   1724:   print(&lt;&lt;END);
1.20      albertel 1725: 2) Domain Description: $domainDescription
                   1726: ENTER NEW VALUE (this should be a string that describes your domain, spaces
                   1727:                  and punctuation are fine except for ':'):
                   1728: END
                   1729:     my $choice2=&lt;&gt;;
                   1730:     chomp($choice2);
                   1731:     $domainDescription=$choice2;
                   1732:   }
                   1733:   elsif ($choice==3) {
                   1734:   print(&lt;&lt;END);
                   1735: 3) Machine Name: $perlvar{'lonHostID'}
                   1736: ENTER NEW VALUE (this will be the name of the machine in the LON-CAPA network
                   1737:                  it cannot contain any of '_' '-' '.' or ':'. We suggest that
                   1738:                  if you are in the domain 'example' and are the first library
                   1739:                  server you enter 'examplel1') :
1.6       harris41 1740: END
                   1741:     my $choice2=&lt;&gt;;
                   1742:     chomp($choice2);
1.8       harris41 1743:     $perlvar{'lonHostID'}=$choice2;
1.6       harris41 1744:   }
1.20      albertel 1745:   elsif ($choice==4) {
1.6       harris41 1746:   print(&lt;&lt;END);
1.43      raeburn  1747: 4) ID of primary library server for domain: $primaryLibServer
                   1748: ENTER NEW VALUE (this will be the LON-CAPA Machine ID of a library server in
                   1749:                  your domain; it cannot contain any of '_' '-' '.' or ':'. 
                   1750:                  This server will be where domain data which are not 
                   1751:                  associated with any specific home library server
                   1752:                  will be stored (e.g., e-mail broadcast by Domain Coordinators
                   1753:                  to users in the domain).
                   1754: END
                   1755:     my $choice2=&lt;&gt;;
                   1756:     chomp($choice2);
                   1757:     $primaryLibServer=$choice2;
                   1758:   }
                   1759:   elsif ($choice==5) {
1.85      raeburn  1760:     if ($setbygui{'lonAdmEMail'}) {
                   1761:       print(&lt;&lt;END);
                   1762: 5) Server Administrator's E-mail Address: $adminmail
                   1763: Use the web GUI (as domain coordinator) to make changes after completing the UPDATE.
                   1764: END
                   1765:     } else {
                   1766:       print(&lt;&lt;END);
1.47      albertel 1767: 5) Server Administrator's E-mail Address: $perlvar{'lonAdmEMail'}
1.6       harris41 1768: ENTER NEW VALUE:
                   1769: END
1.85      raeburn  1770:       my $choice2=&lt;&gt;;
                   1771:       chomp($choice2);
                   1772:       $perlvar{'lonAdmEMail'}=$choice2;
1.88      raeburn  1773:       $adminmail=$perlvar{'lonAdmEMail'};
1.85      raeburn  1774:     }
1.6       harris41 1775:   }
1.43      raeburn  1776:   elsif ($choice==6) {
1.88      raeburn  1777:     if ($setbygui{'lonSupportEMail'}) {
1.85      raeburn  1778:       print(&lt;&lt;END);
                   1779: 6) Support E-mail Address: $supportmail
                   1780: Use the web GUI (as domain coordinator) to make changes after completing the UPDATE.
                   1781: END
                   1782:     } else {    
                   1783:       print(&lt;&lt;END);
1.43      raeburn  1784: 6) Support E-mail Address: $perlvar{'lonSupportEMail'}
1.32      raeburn  1785: ENTER NEW VALUE:
                   1786: END
1.85      raeburn  1787:       my $choice2=&lt;&gt;;
                   1788:       chomp($choice2);
                   1789:       $perlvar{'lonSupportEMail'}=$choice2;
1.88      raeburn  1790:       $supportmail=$perlvar{'lonSupportEMail'};
1.85      raeburn  1791:     }
1.32      raeburn  1792:   }
1.43      raeburn  1793:   elsif ($choice==7) {
1.32      raeburn  1794:   print(&lt;&lt;END);
1.60      raeburn  1795: 7) Server Protocol (http or https): 
                   1796: ENTER NEW VALUE: (this should be either 'http' or 'https'
                   1797:                  if in doubt set to 'http'):
                   1798: END
                   1799:     my $choice2=&lt;&gt;;
                   1800:     chomp($choice2);
                   1801:     $protocol=$choice2;
                   1802:   }
                   1803:   elsif ($choice==8) {
                   1804:   print(&lt;&lt;END);
1.65      raeburn  1805: 8) Internet Domain Name of Institution
                   1806: ENTER NEW VALUE: 
                   1807: 
                   1808: END
                   1809:     my $choice2=&lt;&gt;;
                   1810:     chomp($choice2);
                   1811:     $intdom=$choice2;
                   1812:   }
                   1813:   elsif ($choice==9) {
                   1814:   print(&lt;&lt;END);
1.84      raeburn  1815: 9) Hostname of Server/VM
                   1816: ENTER NEW VALUE:
                   1817: 
                   1818: END
                   1819:     my $choice2=&lt;&gt;;
                   1820:     chomp($choice2);
                   1821:     $desiredhostname=$choice2;
                   1822:   }
                   1823: 
                   1824:   elsif ($choice==10) {
                   1825:   print(&lt;&lt;END);
                   1826: 10) Role: $perlvar{'lonRole'}
1.20      albertel 1827: ENTER NEW VALUE (this should be either 'access' or 'library' 
                   1828:                  if in doubt select 'library'):
1.6       harris41 1829: END
                   1830:     my $choice2=&lt;&gt;;
                   1831:     chomp($choice2);
                   1832:     $perlvar{'lonRole'}=$choice2;
                   1833:   }
1.84      raeburn  1834:   elsif ($choice==11) {
1.6       harris41 1835:   print(&lt;&lt;END);
1.84      raeburn  1836: 11) Cache Expiration Time: $perlvar{'lonExpire'}
1.20      albertel 1837: ENTER NEW VALUE (in seconds, 86400 is a reasonable value):
1.6       harris41 1838: END
                   1839:     my $choice2=&lt;&gt;;
                   1840:     chomp($choice2);
                   1841:     $perlvar{'lonExpire'}=$choice2;
                   1842:   }
1.84      raeburn  1843:   elsif ($choice==12) {
1.6       harris41 1844:   print(&lt;&lt;END);
1.84      raeburn  1845: 12) Server Load: $perlvar{'lonLoadLim'}
1.6       harris41 1846: ENTER NEW VALUE:
                   1847: END
                   1848:     my $choice2=&lt;&gt;;
                   1849:     chomp($choice2);
                   1850:     $perlvar{'lonLoadLim'}=$choice2;
                   1851:   }
1.84      raeburn  1852:   elsif ($choice==13) {
1.25      albertel 1853:   print(&lt;&lt;END);
1.84      raeburn  1854: 13) User Load: $perlvar{'lonUserLoadLim'}
1.25      albertel 1855: Numer of users that can login before machine is 'overloaded'
1.26      albertel 1856: ENTER NEW VALUE (integer value, 0 means there is no limit):
1.25      albertel 1857: END
                   1858:     my $choice2=&lt;&gt;;
                   1859:     chomp($choice2);
                   1860:     $perlvar{'lonUserLoadLim'}=$choice2;
                   1861:   }
1.84      raeburn  1862:   elsif ($choice==14) {
1.85      raeburn  1863:     if ($setbygui{'securestatus'}) {
                   1864:       print(&lt;&lt;END);
                   1865: 14) Allow only secure connections: $securestatus
                   1866: Use the web GUI (as domain coordinator) to make changes after completing the UPDATE.
                   1867: END
                   1868:     } else {
                   1869:       print(&lt;&lt;END);
1.84      raeburn  1870: 14) Allow only secure connections: $securestatus 
1.31      albertel 1871: The Lon-CAPA communication daemons lonc and lond can be configured to
                   1872: allow only secure connections by default.
                   1873: 
                   1874: POSSIBLE CHOICES:
                   1875: 1) allow only secure connections and don't connect to machines that
                   1876:     can not be connected to securely
                   1877: 2) allow only secure connections but allow this machine to connect to 
                   1878:     machines that don't support secure connections
                   1879: 3) allow insecure connections to this machine but only allow connections
                   1880:     to machines that support secure connections
                   1881: 4) allow insecure connections
1.83      raeburn  1882: ENTER NEW VALUE (currently $securenum):
1.31      albertel 1883: END
1.85      raeburn  1884:       my $choice2=&lt;&gt;;
                   1885:       chomp($choice2);
                   1886:       if      ($choice2 eq '1') {
                   1887: 	  $perlvar{'loncAllowInsecure'}=0;$perlvar{'londAllowInsecure'}=0;
                   1888:       } elsif ($choice2 eq '2') {
                   1889: 	  $perlvar{'loncAllowInsecure'}=0;$perlvar{'londAllowInsecure'}=1;
                   1890:       } elsif ($choice2 eq '3') {
                   1891: 	  $perlvar{'loncAllowInsecure'}=1;$perlvar{'londAllowInsecure'}=0;
                   1892:       } elsif ($choice2 eq '4') {
                   1893: 	  $perlvar{'loncAllowInsecure'}=1;$perlvar{'londAllowInsecure'}=1;
                   1894:       }
                   1895:       ($securestatus,$securenum)=&securesetting(%perlvar);
1.31      albertel 1896:     }
1.85      raeburn  1897:   } elsif ($choice==15) {
1.88      raeburn  1898:       if ($sslstatus{'key'} == 1) {
1.86      raeburn  1899:           print(&lt;&lt;END);
1.85      raeburn  1900: 15) Private Key for SSL: $lonkeystatus
                   1901: 
                   1902: POSSIBLE CHOICES:
                   1903: 1) overwrite existing key
1.88      raeburn  1904: 2) make no change
1.85      raeburn  1905: ENTER NEW VALUE
                   1906: END
1.88      raeburn  1907:           my $choice2=&lt;&gt;;
                   1908:           chomp($choice2);
                   1909:           if ($choice2 eq '1') {
                   1910:               my $sslkeypass = &get_new_sslkeypass();
                   1911:               &make_key($certsdir,$privkey,$sslkeypass);
                   1912:           }
                   1913:       } elsif ($sslstatus{'key'} == 0) {
                   1914:           print(&lt;&lt;END);
                   1915: 15) Private Key for SSL: $lonkeystatus
                   1916: END
                   1917:           my $sslkeypass = &get_new_sslkeypass();
                   1918:           &make_key($certsdir,$privkey,$sslkeypass);
                   1919:           print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   1920:           ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
                   1921:              &get_cert_status($perlvar{'lonHostID'},$perlvarstatic);
                   1922:           if (ref($sslref) eq 'HASH') {
                   1923:               %sslstatus = %{$sslref};
                   1924:           }
                   1925:       }
1.85      raeburn  1926:   } elsif ($choice==16) {
1.88      raeburn  1927:       if (($sslstatus{'host'} == 1) || ($sslstatus{'host'} == 2) || ($sslstatus{'host'} == 3)) {
                   1928:           print(&lt;&lt;END);
1.85      raeburn  1929: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1930: 
                   1931: POSSIBLE CHOICES:
                   1932: 1) create new certificate signing request with new key
                   1933: 2) create new certificate signing request with existing key
                   1934: 3) resend current certificate signing request
                   1935: 4) make no change
                   1936: ENTER NEW VALUE
                   1937: END
1.88      raeburn  1938: 
                   1939:           my $choice2=&lt;&gt;;
                   1940:           chomp($choice2);
                   1941:           if (($choice2 eq '1') || ($choice2 eq '2')) {
                   1942:               &ssl_info();
                   1943:               my $country = &get_country($desiredhostname);
                   1944:               my $state = &get_state();
                   1945:               my $city = &get_city();
                   1946:               my $connectsubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=$perlvar{'lonHostID'}/OU=LONCAPA/emailAddress=$adminmail";
                   1947:               ($domainDescription,$country,$state,$city) = &confirm_locality($domainDescription,$country,$state,$city);
                   1948:               my $sslkeypass;
                   1949:               if ($choice2 eq '1') {
                   1950:                   $sslkeypass = &get_new_sslkeypass();
                   1951:                   &make_key($certsdir,$privkey,$sslkeypass);
                   1952:               } elsif ($choice2 eq '2') {
                   1953:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   1954:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   1955:               }
                   1956:               &make_host_csr($certsdir,$sslkeypass,$connectcsr,$connectsubj);
                   1957:               &mail_csr('host',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   1958:               print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   1959:               ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
                   1960:                   &get_cert_status($perlvar{'lonHostID'},$perlvarstatic);
                   1961:               if (ref($sslref) eq 'HASH') {
                   1962:                   %sslstatus = %{$sslref};
                   1963:               }
                   1964:           } elsif ($choice2 eq '3') {
                   1965:               if (-e "$certsdir/$connectcsr") {
                   1966:                   &mail_csr('host',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   1967:               }
                   1968:           }
                   1969:       } elsif (($sslstatus{'host'} == 0) || ($sslstatus{'host'} == 4) || ($sslstatus{'host'} == 5)) {
                   1970:           my $sslkeypass;
                   1971:           if ($sslstatus{'key'} == 1) {
                   1972:               print(&lt;&lt;END);
                   1973: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1974: 
                   1975: POSSIBLE CHOICES:
                   1976: 1) create new certificate signing request with new key
                   1977: 2) create new certificate signing request with existing key
                   1978: 3) make no change
                   1979: ENTER NEW VALUE
                   1980: END
                   1981:               my $choice2=&lt;&gt;;
                   1982:               chomp($choice2);
                   1983:               if ($choice2 eq '1') {
                   1984:                   $sslkeypass = &get_new_sslkeypass();
                   1985:                   &make_key($certsdir,$privkey,$sslkeypass);
                   1986:               } elsif ($choice2 eq '2') {
                   1987:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   1988:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   1989:               }
                   1990:           } else {
                   1991:               print(&lt;&lt;END);
                   1992: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1993: END
                   1994:               $sslkeypass = &get_new_sslkeypass();
                   1995:           }
                   1996:           &ssl_info();
                   1997:           my $country = &get_country($desiredhostname);
                   1998:           my $state = &get_state();
                   1999:           my $city = &get_city();
                   2000:           my $connectsubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=$perlvar{'lonHostID'}/OU=LONCAPA/emailAddress=$adminmail";
                   2001:           &make_host_csr($certsdir,$sslkeypass,$connectcsr,$connectsubj);
                   2002:           &mail_csr('host',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2003:           print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   2004:           ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
                   2005:               &get_cert_status($perlvar{'lonHostID'},$perlvarstatic);
                   2006:           if (ref($sslref) eq 'HASH') {
                   2007:               %sslstatus = %{$sslref};
                   2008:           }
                   2009:       }
1.85      raeburn  2010:   } elsif ($choice==17) {
1.88      raeburn  2011:       if (($sslstatus{'hostname'} == 1) || ($sslstatus{'hostname'} == 2) || ($sslstatus{'hostname'} == 3)) {
                   2012:           print(&lt;&lt;END);
1.85      raeburn  2013: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   2014: 
                   2015: POSSIBLE CHOICES:
                   2016: 1) create new certificate signing request with new key
                   2017: 2) create new certificate signing request with existing key
                   2018: 3) resend current certificate signing request
                   2019: 4) make no change
                   2020: ENTER NEW VALUE
                   2021: END
1.88      raeburn  2022:           my $choice2=&lt;&gt;;
                   2023:           chomp($choice2);
                   2024:           if (($choice2 eq '1') || ($choice2 eq '2')) {
                   2025:               &ssl_info();
                   2026:               my $country = &get_country($desiredhostname);
                   2027:               my $state = &get_state();
                   2028:               my $city = &get_city();
                   2029:               my $replicatesubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=internal-$desiredhostname/OU=LONCAPA/emailAddress=$adminmail";
                   2030:               my $sslkeypass;
                   2031:               if ($choice2 eq '1') {
                   2032:                   $sslkeypass = &get_new_sslkeypass();
                   2033:                   &make_key($certsdir,$privkey,$sslkeypass);
                   2034:               } elsif ($choice2 eq '2') {
                   2035:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   2036:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   2037:               }
                   2038:               &make_hostname_csr($certsdir,$sslkeypass,$replicatecsr,$replicatesubj);
                   2039:               &mail_csr('hostname',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2040:               print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   2041:               ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
                   2042:                   &get_cert_status($perlvar{'lonHostID'},$perlvarstatic);
                   2043:               if (ref($sslref) eq 'HASH') {
                   2044:                   %sslstatus = %{$sslref};
                   2045:               }
                   2046:           } elsif ($choice2 eq '3') {
                   2047:               if (-e "$certsdir/$replicatecsr") {
                   2048:                   &mail_csr('hostname',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2049:               }
                   2050:           }
                   2051:       } elsif (($sslstatus{'hostname'} == 0) || ($sslstatus{'hostname'} == 4) || ($sslstatus{'hostname'} == 5)) {
                   2052:           my $sslkeypass;
                   2053:           if ($sslstatus{'key'} == 1) {
                   2054:               print(&lt;&lt;END);
                   2055: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   2056: 
                   2057: POSSIBLE CHOICES:
                   2058: 1) create new certificate signing request with new key
                   2059: 2) create new certificate signing request with existing key
                   2060: 3) make no change
                   2061: ENTER NEW VALUE
                   2062: END
                   2063:               my $choice2=&lt;&gt;;
                   2064:               chomp($choice2);
                   2065:               if ($choice2 eq '1') {
                   2066:                   $sslkeypass = &get_new_sslkeypass();
                   2067:                   &make_key($certsdir,$privkey,$sslkeypass);
                   2068:               } elsif ($choice2 eq '2') {
                   2069:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   2070:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   2071:               }
                   2072:           } else {
                   2073:               print(&lt;&lt;END);
                   2074: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   2075: END
                   2076:               $sslkeypass = &get_new_sslkeypass();
                   2077:           }
                   2078:           &ssl_info();
                   2079:           my $country = &get_country($desiredhostname);
                   2080:           my $state = &get_state();
                   2081:           my $city = &get_city();
                   2082:           my $replicatesubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=internal-$desiredhostname/OU=LONCAPA/emailAddress=$adminmail";
                   2083:           &make_hostname_csr($certsdir,$sslkeypass,$replicatecsr,$replicatesubj);
                   2084:           &mail_csr('hostname',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2085:           print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   2086:           ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
                   2087:               &get_cert_status($perlvar{'lonHostID'},$perlvarstatic);
                   2088:           if (ref($sslref) eq 'HASH') {
                   2089:               %sslstatus = %{$sslref};
                   2090:           }
                   2091:       }
1.85      raeburn  2092:   } elsif (($choice==18) && (!@error)) {
1.6       harris41 2093:     $flag=1;
1.85      raeburn  2094:   } else {
1.38      www      2095:     print "Invalid input.\n";
1.6       harris41 2096:   }
                   2097: }
1.84      raeburn  2098: 
1.7       harris41 2099:     open(OUT,"&gt;$confdir$filename") or
                   2100:       die("Cannot output to $confdir$filename\n");
                   2101:     foreach my $key (keys %perlvar) {
                   2102:       my $value=$perlvar{$key};
1.49      raeburn  2103:       my $line = "PerlSetVar     $key      $value";
                   2104:       if ($value eq '') {
                   2105:           $line = '#'.$line;
                   2106:       }
1.88      raeburn  2107:       print(OUT &lt;&lt;END) unless ($perlvarstatic-&gt;{$key});
1.49      raeburn  2108: $line
1.7       harris41 2109: END
                   2110:     }
                   2111:     close(OUT);
1.1       harris41 2112: </perlscript>
                   2113: </file>
                   2114: <file>
                   2115: <target dist='default'>loncom/hosts.tab</target>
                   2116: <perlscript mode='fg'>
                   2117: unless (-l "<TARGET />") {
1.84      raeburn  2118:   if ($desiredhostname eq '') { 
                   2119:       my $hostname=`hostname -f`;chomp($hostname);
                   2120:       $desiredhostname = $hostname;
                   2121:   }
1.82      raeburn  2122:   my $date=`date -I`; chomp($date);
                   2123:   my $lonHostID=$perlvar{'lonHostID'};
1.51      albertel 2124:   $lonHostID=~s/[^\w\-.]//g;
1.82      raeburn  2125:   my $lineexistflag=0;
                   2126:   my $hostidexistflag=0;
                   2127:   my $line2insert=&lt;&lt;END;
1.84      raeburn  2128: $perlvar{'lonHostID'}:$perlvar{'lonDefDomain'}:$perlvar{'lonRole'}:$desiredhostname:$protocol:$intdom
1.15      harris41 2129: END
1.57      albertel 2130:   if (!$domainTabExtras) {
                   2131: 	$domainTabExtras=':::::';
                   2132:   }
1.82      raeburn  2133:   my $domaininsert="$perlvar{'lonDefDomain'}:$domainDescription:$domainTabExtras:$primaryLibServer\n";
1.23      albertel 2134:   if ($lonCluster eq 'standalone') {
                   2135:     open(OUT,'&gt;../'.$lonCluster.'_hosts.tab') or
                   2136:       die('file generation error');
                   2137:       print(OUT $line2insert);
1.84      raeburn  2138:       print OUT ("^$desiredhostname:$protocol\n");
1.52      albertel 2139:     close(OUT);
                   2140:     open(OUT,'&gt;../'.$lonCluster.'_dns_hosts.tab') or
                   2141:       die('file generation error');
                   2142:       print(OUT $line2insert);
1.23      albertel 2143:     close(OUT);
1.27      albertel 2144:     open(OUT,'&gt;../'.$lonCluster.'_domain.tab') or
                   2145:       die('file generation error');
                   2146:       print(OUT $domaininsert);
                   2147:     close(OUT);
1.52      albertel 2148:     open(OUT,'&gt;../'.$lonCluster.'_dns_domain.tab') or
                   2149:       die('file generation error');
                   2150:       print(OUT $domaininsert);
                   2151:     close(OUT);
1.23      albertel 2152:   }
1.15      harris41 2153:   if ($flag==1) {
1.6       harris41 2154:     `rm -f ../hosts.tab`;
1.52      albertel 2155:     `rm -f ../dns_hosts.tab`;
                   2156:     `ln -s ${lonCluster}_dns_hosts.tab ../dns_hosts.tab`;
                   2157:     open(IN,'&lt;../'.$lonCluster.'_dns_hosts.tab');
                   2158:     while(my $line = &lt;IN&gt;) {
                   2159:       if ($line =~ /^\Q$line2insert\E$/) {
1.13      harris41 2160:         $lineexistflag=1;
                   2161:       }
1.52      albertel 2162:       if ($line =~ /^\Q$lonHostID\E\:/) {
1.13      harris41 2163:         $hostidexistflag=1;
                   2164:       }
                   2165:     }
                   2166:     close(IN);
                   2167:     if ($hostidexistflag and !$lineexistflag) {
                   2168:       print &lt;&lt;END;
                   2169: WARNING: $lonHostID already exists inside
1.52      albertel 2170: loncapa/loncom/${lonCluster}_dns_hosts.tab.  The entry inside
                   2171: ${lonCluster}_dns_hosts.tab does not match your settings.
                   2172: An entry inside ${lonCluster}_hosts.tab will be made
1.13      harris41 2173: with your new values.
                   2174: END
1.15      harris41 2175:       `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
                   2176:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_hosts.tab') or
                   2177:          die("cannot open loncom/${lonCluster}_hosts.tab for output\n");
1.14      harris41 2178:          print(OUT $line2insert);
1.13      harris41 2179:        close(OUT);
1.15      harris41 2180:       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
1.13      harris41 2181:       # email appropriate message
1.65      raeburn  2182:       `echo "REPLACE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "REPLACE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1.13      harris41 2183:     }
                   2184:     elsif ($hostidexistflag and $lineexistflag) {
1.15      harris41 2185:       print &lt;&lt;END;
1.52      albertel 2186: Entry exists in ${lonCluster}_dns_hosts.tab. Making duplicate entry in ${lonCluster}_hosts.tab
1.15      harris41 2187: END
1.52      albertel 2188:       `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
                   2189:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_hosts.tab') or
                   2190:          die("cannot open loncom/${lonCluster}_hosts.tab for output\n");
                   2191:          print(OUT $line2insert);
                   2192:        close(OUT);
                   2193:       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
1.15      harris41 2194:       # email appropriate message
1.65      raeburn  2195:       `echo "STABLEUPDATE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "STABLEUPDATE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1.13      harris41 2196:     }
1.15      harris41 2197:     elsif (!$hostidexistflag and !$lineexistflag) {
                   2198:       print &lt;&lt;END;
                   2199: New entry for $lonCluster.
1.6       harris41 2200: END
1.15      harris41 2201:       `cat ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
1.21      albertel 2202:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_hosts.tab') or
                   2203:          die("cannot open loncom/new_${lonCluster}_hosts.tab for output\n");
1.15      harris41 2204:          print(OUT $line2insert);
                   2205:        close(OUT);
                   2206:       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
                   2207:       # email appropriate message
1.65      raeburn  2208:       `echo "INSERT:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "INSERT:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1.27      albertel 2209:     }
                   2210:   }
                   2211:   $lineexistflag=0;
1.82      raeburn  2212:   my $domainexistflag=0;
1.27      albertel 2213:   if ($flag==1) {
                   2214:     `rm -f ../domain.tab`;
1.52      albertel 2215:     `rm -f ../dns_domain.tab`;
                   2216:     `ln -s ${lonCluster}_dns_domain.tab ../dns_domain.tab`;
                   2217:     open(IN,'&lt;../'.$lonCluster.'_dns_domain.tab');
                   2218:     while(my $line = &lt;IN&gt;) {
                   2219:       if ($line =~/^\Q$domaininsert\E$/) {
1.27      albertel 2220:         $lineexistflag=1;
                   2221:       }
1.52      albertel 2222:       if ($line =~/^\Q$perlvar{'lonDefDomain'}\E\:/) {
1.27      albertel 2223:         $domainexistflag=1;
                   2224:       }
                   2225:     }
                   2226:     close(IN);
                   2227:     if ($domainexistflag and !$lineexistflag) {
                   2228:       print &lt;&lt;END;
                   2229: WARNING: $perlvar{'lonDefDomain'} already exists inside
1.52      albertel 2230: loncapa/loncom/${lonCluster}_dns_domain.tab.  The entry inside
                   2231: ${lonCluster}_dns_domain.tab does not match your settings.
                   2232: An entry will be made in inside ${lonCluster}_domain.tab
1.27      albertel 2233: with your new values.
                   2234: END
                   2235:       `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
                   2236:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
                   2237:          die("cannot open loncom/${lonCluster}_domain.tab for output\n");
                   2238:          print(OUT $domaininsert);
                   2239:        close(OUT);
                   2240:       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
                   2241:       # email appropriate message
1.82      raeburn  2242:       `echo "REPLACEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "REPLACEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
1.27      albertel 2243:     }
                   2244:     elsif ($domainexistflag and $lineexistflag) {
1.52      albertel 2245:       `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
                   2246:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
                   2247:          die("cannot open loncom/${lonCluster}_domain.tab for output\n");
                   2248:          print(OUT $domaininsert);
                   2249:        close(OUT);
1.27      albertel 2250:       print &lt;&lt;END;
1.52      albertel 2251: Entry exists in ${lonCluster}_dns_domain.tab. Making duplicate entry in ${lonCluster}_domain.tab
1.27      albertel 2252: END
1.52      albertel 2253:       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
1.27      albertel 2254:       # email appropriate message
                   2255:       `echo "STABLEUPDATEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "STABLEUPDATEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
                   2256:     }
                   2257:     elsif (!$domainexistflag and !$lineexistflag) {
                   2258:       print &lt;&lt;END;
                   2259: New entry for $lonCluster.
                   2260: END
                   2261:       `cat ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
                   2262:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
                   2263:          die("cannot open loncom/new_${lonCluster}_domain.tab for output\n");
                   2264:          print(OUT $domaininsert);
                   2265:        close(OUT);
                   2266:       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
                   2267:       # email appropriate message
                   2268:       `echo "INSERTdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "INSERTdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
1.6       harris41 2269:     }
                   2270:   }
1.1       harris41 2271: }
                   2272: </perlscript>
                   2273: </file>
                   2274: </files>
                   2275: </piml>

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