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

1.2       harris41    1: <!-- updatequery.piml -->
1.1       harris41    2: 
1.92    ! raeburn     3: <!-- $Id: updatequery.piml,v 1.91 2018/10/28 03:07:37 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.91      raeburn    65:     if ('<DIST />' eq 'sles10' || '<DIST />' eq 'sles11' || '<DIST />' eq 'sles12' || '<DIST />' eq 'sles15' || '<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 {
1.90      raeburn   540:     my ($lonHostID,$hostname,$perlvarstatic) = @_;
1.92    ! raeburn   541:     my $currcerts = &LONCAPA::SSL::print_certstatus({$lonHostID =&gt; $hostname,},'text','install');
1.88      raeburn   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();
1.90      raeburn   556:         my %csr;
1.88      raeburn   557:         my ($lonhost,$info) = split(/\:/,$currcerts,2);
                    558:         if ($lonhost eq $lonHostID) {
                    559:             my @items = split(/\&/,$info);
                    560:             foreach my $item (@items) {
                    561:                 my ($key,$value) = split(/=/,$item,2);
1.90      raeburn   562:                 if ($key =~ /^(host(?:|name))\-csr$/) {
                    563:                     $csr{$1} = $value;
                    564:                 }
1.88      raeburn   565:                 my @data = split(/,/,$value);
                    566:                 if (grep(/^\Q$key\E$/,keys(%sslnames))) {
1.90      raeburn   567:                     my ($checkcsr,$comparecsr);
1.88      raeburn   568:                     if (lc($data[0]) eq 'yes') {
                    569:                         $output .= "$ssldesc{$key} ".$perlvarstatic-&gt;{$sslnames{$key}}." available with status = $data[1]\n";
                    570:                         if ($key eq 'key') {
                    571:                             $lonkeystatus = "status: $data[1]";
                    572:                             if ($data[1] =~ /ok$/) {
                    573:                                 $sslstatus{$key} = 1;
                    574:                             }
                    575:                         } else {
                    576:                             my $setstatus;
                    577:                             if (($key eq 'host') || ($key eq 'hostname')) { 
                    578:                                 if ($data[1] eq 'otherkey') {
                    579:                                     $sslstatus{$key} = 4;
                    580:                                     $setstatus = 1;
                    581:                                     if ($key eq 'host') {
                    582:                                         $lonhostcertstatus = "status: created with different key";
                    583:                                     } elsif ($key eq 'hostname') {
                    584:                                         $lonhostnamecertstatus = "status: created with different key"; 
                    585:                                     }
                    586:                                 } elsif ($data[1] eq 'nokey') {
                    587:                                     $sslstatus{$key} = 5;
                    588:                                     $setstatus = 1;
                    589:                                     if ($key eq 'host') {
                    590:                                         $lonhostcertstatus = "status: created with missing key";
                    591:                                     } elsif ($key eq 'hostname') {
                    592:                                         $lonhostnamecertstatus = "status: created with missing key";
                    593:                                     }
                    594:                                 }
1.90      raeburn   595:                                 if ($setstatus) {
                    596:                                     $comparecsr = 1;
                    597:                                 }
1.88      raeburn   598:                             }
                    599:                             unless ($setstatus) {
                    600:                                 if ($data[1] eq 'expired') {
                    601:                                     $sslstatus{$key} = 2;
                    602:                                 } elsif ($data[1] eq 'future') {
                    603:                                     $sslstatus{$key} = 3;
                    604:                                 } else {
                    605:                                     $sslstatus{$key} = 1;
                    606:                                 }
                    607:                                 if ($key eq 'host') {
                    608:                                     $lonhostcertstatus = "status: $data[1]";
                    609:                                 } elsif ($key eq 'hostname') {
                    610:                                     $lonhostnamecertstatus = "status: $data[1]";
                    611:                                 }
                    612:                             }
                    613:                         }
                    614:                     } else {
                    615:                         $sslstatus{$key} = 0;
                    616:                         $output .= "$ssldesc{$key} ".$perlvarstatic-&gt;{$sslnames{$key}}." not available\n";
1.90      raeburn   617:                         if ($key eq 'key') {
                    618:                             $lonkeystatus = 'still needed';
                    619:                         } elsif (($key eq 'host') || ($key eq 'hostname')) {
                    620:                             $checkcsr = 1;
                    621:                         }
                    622:                     }
                    623:                     if (($checkcsr) || ($comparecsr)) {
                    624:                         my $csrfile = $perlvarstatic-&gt;{$sslnames{$key}};
                    625:                         $csrfile =~s /\.pem$/.csr/;
                    626:                         my $csrstatus;
                    627:                         if (-e $perlvarstatic-&gt;{'lonCertificateDirectory'}."/$csrfile") {
                    628:                             open(PIPE,"openssl req -text -noout -verify -in ".$perlvarstatic-&gt;{'lonCertificateDirectory'}."/$csrfile 2&gt;&1 |");
                    629:                             while(&lt;PIPE&gt;) {
                    630:                                 chomp();
                    631:                                 $csrstatus = $_;
                    632:                                 last;
                    633:                             }
                    634:                             close(PIPE);
                    635:                             if ((($comparecsr) && ($csr{$key})) || ($checkcsr)) {
1.88      raeburn   636:                                 $output .= "Certificate signing request for $ssldesc{$key} available with status = $csrstatus\n\n";
                    637:                                 if ($key eq 'host') {
                    638:                                     $lonhostcertstatus = 'awaiting signature';
                    639:                                 } else {
                    640:                                     $lonhostnamecertstatus = 'awaiting signature';
                    641:                                 }
                    642:                                 $sslstatus{$key} = 3;
1.90      raeburn   643:                             }
                    644:                         } elsif ($checkcsr) {
                    645:                             $output .= "No certificate signing request available for $ssldesc{$key}\n\n";
                    646:                             if ($key eq 'host') {
                    647:                                 $lonhostcertstatus = 'still needed';
1.88      raeburn   648:                             } else {
1.90      raeburn   649:                                 $lonhostnamecertstatus = 'still needed';
1.88      raeburn   650:                             }
                    651:                         }
                    652:                     }
                    653:                 }
                    654:             }
                    655:         }
                    656:     }
                    657:     return ($output,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,\%sslstatus);
                    658: }
                    659: 
                    660:   print(&lt;&lt;END);
                    661: 
                    662: 
                    663: *********************************************
                    664: *********************************************
                    665: ****                                     ****
                    666: **** LON-CAPA SYSTEM INFORMATION REQUEST ****
                    667: ****                                     ****
                    668: **** Please respond to the choices below ****
                    669: ****                                     ****
                    670: *********************************************
                    671: *********************************************
                    672: 
                    673: END
                    674: #sleep(3);
                    675: 
1.1       harris41  676: </perlscript>
                    677: </file>
                    678: <file>
1.85      raeburn   679: <target dist='default'>../../loncom/hosts.tab</target>
1.22      albertel  680: <perlscript mode='fg'>
1.82      raeburn   681: my $lonCluster;
1.85      raeburn   682: my $currCluster;
                    683: 
                    684: if (-l "<TARGET />") {
                    685:   my $currlink = readlink("<TARGET />");
                    686:   if ($currlink =~ /^new_(existing|standalone|development|production)_hosts\.tab$/) {
                    687:       $currCluster = $1;
                    688:   }
                    689:   my %clustertypes = (
1.86      raeburn   690:                        production  =&gt; 'PRODUCTION',
                    691:                        standalone  =&gt; 'STAND-ALONE',
                    692:                        development =&gt; 'DEVELOPMENT',
                    693:                        existing    =&gt; 'RUNNING YOUR OWN CLUSTER',
1.85      raeburn   694:                      );
                    695:   if (($currCluster) && (exists($clustertypes{$currCluster}))) {
                    696:       print(&lt;&lt;END);
                    697: 
                    698: The cluster type for this server is currently: $clustertypes{$currCluster}
                    699: END
                    700: 
                    701:   }
                    702: }
                    703: 
                    704: print(&lt;&lt;END);
1.22      albertel  705: 
                    706: ===============================================================================
1.85      raeburn   707: 
1.30      www       708: Which cluster option would you like to have installed?
                    709: IMPORTANT: to take advantage of the cluster options 1) and 3),
1.83      raeburn   710: you must contact loncapa\@loncapa.org.
1.30      www       711: 
                    712: 1) PRODUCTION - you want to eventually connect this machine to the
                    713:                 LON-CAPA content sharing network. This setting is for
                    714:                 schools, colleges, and universities, that currently
1.83      raeburn   715:                 are running - or in the future will run - courses.
1.22      albertel  716: 2) STAND-ALONE - you want this machine to run in 'stand-alone' mode and
1.83      raeburn   717:                  not be connected to other LON-CAPA machines for now.
1.30      www       718: 3) DEVELOPMENT - you want to do software (not content!) development with
                    719:                  this workstation and eventually link it with the
                    720:                  workstations of other LON-CAPA software developers.
1.40      albertel  721: 4) RUNNING YOUR OWN CLUSTER - this machine is not in the standard LON-CAPA
                    722:                  clusters and won't be in the future and you want the existing
                    723:                  hosts.tab and domain.tab files to be left alone.
                    724:                  (This choice is unlikely what you want to select.)
1.22      albertel  725: END
                    726: # Option number 26 will install rawhide_hosts.tab, but
                    727: # the typical user does not want to be part of an intensive
                    728: # machine test cluster.
                    729: 
                    730: # get input
                    731: # if valid then process, otherwise loop
1.82      raeburn   732: my $flag=0;
1.22      albertel  733: while (!$flag) {
                    734:   print "ENTER 1, 2, 3, or 4:\n";
                    735:   my $choice=&lt;&gt;;
                    736:   chomp($choice);
                    737:   if ($choice==1) {
                    738:     $lonCluster='production'; $flag=1;
                    739:   }
                    740:   elsif ($choice==2) {
                    741:     $lonCluster='standalone'; $flag=1;
                    742:   }
                    743:   elsif ($choice==3) {
                    744:     $lonCluster='development'; $flag=1;
                    745:   }
                    746:   elsif ($choice==4) {
                    747:     $lonCluster='existing'; $flag=1;
1.52      albertel  748:     foreach my $file ('hosts.tab','dns_hosts.tab',
                    749:                       'domain.tab','dns_domain.tab') {
                    750:         if (-e '/home/httpd/lonTabs/'.$file) {
                    751: 	    `cp /home/httpd/lonTabs/$file ../existing_$file`;
                    752:         }
                    753:         else {
                    754: 	    print &lt;&lt;END;
                    755: There is no existing /home/httpd/lonTabs/$file
1.22      albertel  756: END
1.52      albertel  757:             die('');
                    758:         }
1.27      albertel  759:     }
1.22      albertel  760:   }
                    761:   elsif ($choice==26) {
                    762:     $lonCluster='rawhide'; $flag=1;
                    763:   }
                    764: }
                    765: </perlscript>
                    766: </file>
                    767: <file>
1.10      harris41  768: <target dist='default'>/home/httpd/lonTabs/hosts.tab</target>
1.1       harris41  769: <perlscript mode='fg'>
1.4       harris41  770: $|=1;
1.20      albertel  771: my $domainDescription;
1.29      albertel  772: my $domainTabExtras;
1.43      raeburn   773: my $primaryLibServer;
1.60      raeburn   774: my $protocol;
1.65      raeburn   775: my $intdom;
1.84      raeburn   776: my $desiredhostname;
1.85      raeburn   777: my $city;
                    778: my $state;
                    779: my $country;
1.43      raeburn   780: my @libservers = ();
1.1       harris41  781: unless (-e "<TARGET />") {
                    782:   print(&lt;&lt;END);
                    783:            WELCOME TO LON-CAPA!
                    784: 
1.83      raeburn   785: If you have questions, please visit http://install.loncapa.org
                    786: or contact helpdesk\@loncapa.org.
1.1       harris41  787: 
                    788: ===============================================================================
1.85      raeburn   789: The following 10 values are needed to configure LON-CAPA:
1.4       harris41  790: * Machine Role
1.8       harris41  791: * LON-CAPA Domain Name
1.82      raeburn   792: * LON-CAPA Machine ID Name
                    793: * Server Administration E-mail Address
1.68      raeburn   794: * LON-CAPA Domain's Primary Library Server Machine ID
                    795: * Web Server Protocol
                    796: * Internet Domain Name of Your Institution
1.84      raeburn   797: * Hostname
1.85      raeburn   798: * City, State, Country for LON-CAPA SSL certificate 
                    799: * Password for key for creating SSL certificates
1.32      raeburn   800: ===============================================================================
                    801: 
                    802: In addition, a Support E-mail Address can also be included. If
                    803: an address is included then one of the options in the LON-CAPA 
                    804: help menu will be a link to a form that a user will complete to
                    805: request LON-CAPA help.  
                    806: 
1.1       harris41  807: END
1.3       harris41  808: 
1.4       harris41  809: open(OUT,'&gt;/tmp/loncapa_updatequery.out');
                    810: close(OUT);
                    811: 
1.3       harris41  812: # query for Machine Role
                    813:   print(&lt;&lt;END);
                    814: **** Machine Role ****
                    815: Library server (recommended if first-time installation of LON-CAPA):
                    816:    Servers that are repositories of authoritative educational resources.
1.83      raeburn   817:    These servers also provide the authoring spaces in which content
                    818:    creators (e.g., faculty instructors) create their learning content.
1.3       harris41  819: Access server:
                    820:    Servers that load-balance high-traffic delivery of educational resources
                    821:    over the world-wide web.
1.4       harris41  822: 1) Will this be a library server? (recommended if this is your first install)
1.3       harris41  823: 2) Or, will this be an access server?
                    824: END
1.4       harris41  825: my $flag=0;
                    826: my $r='';
                    827: my $lonRole;
                    828: while (!$flag) {
                    829:   print "ENTER A CHOICE OF 1 or 2:\n";
                    830:   my $choice=&lt;&gt;;
                    831:   chomp($choice);
                    832:   if ($choice==1) {
                    833:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    834:     print(OUT 'lonRole'."\t".'library'."\n");
                    835:     close(OUT);
                    836:     $lonRole='library';
                    837:     $r='l';
                    838:     $flag=1;
                    839:   }
                    840:   elsif ($choice==2) {
                    841:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    842:     print(OUT 'lonRole'."\t".'access'."\n");
                    843:     close(OUT);
                    844:     $lonRole='access';
                    845:     $r='a';
                    846:     $flag=2;
                    847:   }
                    848:   else {
                    849: 
                    850:   }
                    851: }
1.3       harris41  852: 
                    853: # need to recommend a machine ID name (ipdomain.l.somenumber)
1.36      albertel  854: my $hostname=`hostname -f`; chomp($hostname);
1.4       harris41  855: my $ipdomain='';
                    856: if ($hostname=~/([^\.]*)\.([^\.]*)$/) {
                    857:   $ipdomain=$1;
                    858: }
1.1       harris41  859: 
                    860:   print(&lt;&lt;END);
                    861: 
1.8       harris41  862: **** Domain ****
1.83      raeburn   863: [This does NOT need to correspond to an internet address domain.
1.45      www       864:  Please make this name short AND descriptive of your organization.
                    865:  Domain names are close to impossible to change later!!!
                    866:  Good examples might be "msu" or "bionet" or "vermontcc".
                    867:  Bad examples are "physics" (too general)
1.37      www       868:    or "michiganstateuniversity" (too long)
1.83      raeburn   869:    or "msuedu" (just make it "msu", or else make it msu.edu)
1.45      www       870:    or "msuphysics" (only if there is a good reason to limit to department
                    871:                     - we don't know of one)
1.37      www       872:    or "mydomain" (what is that?)
1.45      www       873:  Avoid multiple domains at the same institution, even if it means that you 
                    874:  have to actually work together with your colleagues. You can still run
                    875:  multiple library servers within the same domain.
                    876:  If this domain is eventually going to be part of the main production
1.82      raeburn   877:  cluster, you MUST contact the LON-CAPA group at MSU (loncapa\@loncapa.org)
1.45      www       878:  to have a domain name assigned, and then use it exactly as given. This is
                    879:  also true for test installs that might eventually turn into production setups.
1.83      raeburn   880:  The short domain name needs to be unique, if your aim is to join a cluster 
                    881:  containing existing domains. Stop now if you have not yet contacted the 
                    882:  MSU LON-CAPA group.] 
1.1       harris41  883: END
1.8       harris41  884: 
                    885: # get domain name
1.1       harris41  886: # accept if valid, if not valid, tell user and repeat
1.4       harris41  887: $flag=0;
1.8       harris41  888: my $lonDefDomain;
1.4       harris41  889: while (!$flag) {
                    890: if ($ipdomain) {
                    891: print(&lt;&lt;END);
1.8       harris41  892: ENTER LONCAPA DOMAIN [$ipdomain]:
1.4       harris41  893: END
                    894: }
                    895: else {
                    896:   print(&lt;&lt;END);
1.8       harris41  897: ENTER LONCAPA DOMAIN:
1.4       harris41  898: END
                    899: }
                    900:   my $choice=&lt;&gt;;
                    901:   chomp($choice);
1.18      harris41  902:   my $bad_domain_flag=0;
1.41      albertel  903:   my @bad_domain_names=('res','raw','userfiles','priv','adm','uploaded',
                    904: 	'editupload');
1.18      harris41  905:   foreach my $bad (@bad_domain_names) {
                    906:     $bad_domain_flag=1 if $choice eq $bad;
                    907:   }
1.37      www       908:   if ($choice=~/capa/i) {
                    909:      $bad_domain_flag=1;
                    910:   }
1.8       harris41  911:   if ($ipdomain and $choice=~/^\s*$/) {
                    912:     $choice=$ipdomain;
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;
1.4       harris41  917:     $flag=1;
1.86      raeburn   918:   } elsif (length($choice)&gt;35) {
1.37      www       919:     print "Name too long\n";
1.86      raeburn   920:   } elsif (length($choice)&lt;2) {
1.37      www       921:     print "Name too short\n";
1.38      www       922:   } elsif ($bad_domain_flag) {
                    923:     print "Invalid input ('$choice' conflicts with LON-CAPA namespace).\n";
                    924:     print "Please try something different than '$choice'\n";
1.51      albertel  925:   } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
1.4       harris41  926:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41  927:     print(OUT 'lonDefDomain'."\t".$choice."\n");
1.4       harris41  928:     close(OUT);
1.8       harris41  929:     $lonDefDomain=$choice;
                    930:     $r='l';
1.4       harris41  931:     $flag=1;
1.37      www       932:   } else {
1.51      albertel  933:     print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
1.4       harris41  934:   }
                    935: }
1.1       harris41  936: 
1.20      albertel  937: # get domain description
                    938: # accept if valid, if not valid, tell user and repeat
                    939: $flag=0;
                    940: 
                    941: while (!$flag) {
                    942:   print(&lt;&lt;END);
                    943: 
                    944: **** Domain Description ****
                    945: String describing the domain, to be shown to users.
                    946: [Example, msu is Michigan State University]
                    947: ENTER DOMAIN DESCRIPTION:
                    948: END
                    949: 
                    950:   my $choice=&lt;&gt;;
                    951:   chomp($choice);
                    952:   if ($choice!~/:/) {
                    953:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                    954:     print(OUT 'domainDescription'."\t".$choice."\n");
                    955:     close(OUT);
                    956:     $domainDescription=$choice;
                    957:     $flag=1;
                    958:   }
                    959:   else {
                    960:     print "Invalid input (no ':' allowed).\n";
                    961:   }
                    962: }
                    963: 
1.8       harris41  964: my $lonHostID;
                    965: if ($lonDefDomain) {
                    966:   $lonHostID=$lonDefDomain.$r.int(1+rand(9)); # should be probably also detect
                    967:                                               # against the hosts.tab
                    968: }
                    969: 
1.1       harris41  970:   print(&lt;&lt;END);
                    971: 
1.8       harris41  972: **** Machine ID Name ****
1.45      www       973: [This does NOT need to correspond to internet address names;
1.8       harris41  974:  this name MUST be unique to the whole LON-CAPA network;
1.45      www       975:  we recommend that you use a name based off of your institution.
                    976:  Good examples: "msul1" or "bioneta2".
                    977:  Bad examples: "loncapabox" or "studentsinside".
1.37      www       978:  Note that machine names are very hard to change later.]
1.1       harris41  979: END
1.8       harris41  980: # get machine name
1.1       harris41  981: # accept if valid, if not valid, tell user and repeat
1.4       harris41  982: $flag=0;
                    983: while (!$flag) {
                    984: if ($ipdomain) {
                    985: print(&lt;&lt;END);
1.8       harris41  986: ENTER LONCAPA MACHINE ID [$lonHostID]:
1.4       harris41  987: END
                    988: }
                    989: else {
                    990:   print(&lt;&lt;END);
1.8       harris41  991: ENTER LONCAPA MACHINE ID:
1.4       harris41  992: END
                    993: }
                    994:   my $choice=&lt;&gt;;
                    995:   chomp($choice);
1.37      www       996:   if ($choice=~/capa/i) {
                    997:     print "Invalid input (names containing 'capa' are reserved).\n";
                    998:   } elsif ($lonHostID and $choice=~/^\s*$/) {
1.8       harris41  999:     $choice=$lonHostID;
1.4       harris41 1000:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41 1001:     print(OUT 'lonHostID'."\t".$choice."\n");
1.4       harris41 1002:     close(OUT);
1.8       harris41 1003:     $lonHostID=$choice;
1.4       harris41 1004:     $flag=1;
1.86      raeburn  1005:   } elsif (length($choice)&gt;45) {
1.37      www      1006:     print "Name too long\n";
1.86      raeburn  1007:   } elsif (length($choice)&lt;4) {
1.37      www      1008:     print "Name too short\n";
1.51      albertel 1009:   } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
1.4       harris41 1010:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.8       harris41 1011:     print(OUT 'lonHostID'."\t".$choice."\n");
1.4       harris41 1012:     close(OUT);
1.8       harris41 1013:     $lonHostID=$choice;
1.4       harris41 1014:     $flag=1;
1.37      www      1015:   } else {
1.51      albertel 1016:     print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
1.4       harris41 1017:   }
                   1018: }
1.1       harris41 1019: 
1.43      raeburn  1020: # get primary library server in domain
                   1021: if ($lonRole eq 'library') {
                   1022:     if (!grep/^\Q$lonHostID\E$/,@libservers) {
                   1023:         push(@libservers,$lonHostID);
                   1024:     } 
                   1025:     if (@libservers == 1) {
                   1026:         $primaryLibServer = $libservers[0];
                   1027:     }
                   1028: }
1.68      raeburn  1029: 
                   1030: $flag=0;
1.43      raeburn  1031: while (!$flag) {
                   1032:   print(&lt;&lt;END);
                   1033: **** Domain's Primary Library Server ID ****
                   1034: This should be the LON-CAPA machine ID of a library server in your 
                   1035: domain.  If you only have a single library server in your domain, then
                   1036: the Primary Library server ID will be the machine ID of that server. 
                   1037: This server will be where domain data which are not associated with any
1.83      raeburn  1038: specific home library server will be stored (e.g., configurations that
                   1039: apply to all nodes in the domain).
1.43      raeburn  1040: END
                   1041:     if (defined($primaryLibServer)) {
                   1042:         print(&lt;&lt;END);
                   1043: ENTER DOMAIN'S PRIMARY LIBRARY SERVER ID [$primaryLibServer]:
                   1044: END
1.86      raeburn  1045:     } elsif (@libservers &gt; 0) {
1.43      raeburn  1046:         print(&lt;&lt;END);
                   1047: ENTER DOMAIN'S PRIMARY LIBRARY SERVER ID [$libservers[0]]
                   1048: END
                   1049:     } else {
                   1050:         print (&lt;&lt;END);
                   1051: 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.
                   1052: END
                   1053:     }
                   1054: 
                   1055:     my $choice=&lt;&gt;;
                   1056:     chomp($choice);
                   1057:     if ($primaryLibServer and $choice=~/^\s*$/) {
                   1058:         $choice=$primaryLibServer;
                   1059:         open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1060:         print(OUT 'primaryLibServer'."\t".$choice."\n");
                   1061:         close(OUT);
                   1062:         $flag=1;
1.86      raeburn  1063:     } elsif (length($choice)&gt;35) {
1.43      raeburn  1064:         print "Name too long\n";
1.86      raeburn  1065:     } elsif (length($choice)&lt;4) {
1.43      raeburn  1066:         print "Name too short\n";
1.51      albertel 1067:     } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
1.43      raeburn  1068:         open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1069:         print(OUT 'primaryLibServer'."\t".$choice."\n");
                   1070:         close(OUT);
                   1071:         $primaryLibServer=$choice;
                   1072:         $flag=1;
                   1073:     } else {
1.51      albertel 1074:         print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
1.43      raeburn  1075:     }
                   1076: }
                   1077: 
                   1078: 
1.32      raeburn  1079: # get admin e-mail address
1.4       harris41 1080: # accept if valid, if not valid, tell user and repeat
                   1081: $flag=0;
1.9       harris41 1082: my $lonAdmEMail;
1.4       harris41 1083: while (!$flag) {
1.1       harris41 1084:   print(&lt;&lt;END);
                   1085: 
1.85      raeburn  1086: **** Server Administrator's E-mail ****
1.1       harris41 1087: E-mail address of the person who will manage this machine
1.4       harris41 1088: [should be in the form somebody\@somewhere]
1.32      raeburn  1089: ENTER ADMIN E-MAIL ADDRESS:
1.1       harris41 1090: END
                   1091: 
1.4       harris41 1092:   my $choice=&lt;&gt;;
                   1093:   chomp($choice);
                   1094:   if ($choice=~/\@/) {
                   1095:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.9       harris41 1096:     print(OUT 'lonAdmEMail'."\t".$choice."\n");
1.4       harris41 1097:     close(OUT);
1.9       harris41 1098:     $lonAdmEMail=$choice;
1.4       harris41 1099:     $flag=1;
                   1100:   }
                   1101:   else {
                   1102:     print "Invalid input (this needs to look like an e-mail address!).\n";
                   1103:   }
                   1104: }
                   1105: 
1.32      raeburn  1106: 
                   1107: # get support e-mail address
                   1108: # accept if valid, if not valid, tell user and repeat
                   1109: $flag=0;
                   1110: my $lonSupportEMail;
                   1111: while (!$flag) {
                   1112:   print(&lt;&lt;END);
                   1113: 
                   1114: **** Support E-mail ****
                   1115: E-mail address of the person who will receive 
                   1116: help requests from LON-CAPA users who access 
                   1117: the system via this server. If the address is left blank,
                   1118: then a help support form will not be displayed 
                   1119: as part of the help menu.
                   1120: [should be in the form somebody\@somewhere]
                   1121: ENTER SUPPORT E-MAIL ADDRESS:
                   1122: END
                   1123: 
                   1124:   my $choice=&lt;&gt;;
                   1125:   chomp($choice);
                   1126:   $choice =~ s/\s//g;
1.33      albertel 1127:   if ( ($choice=~/\@/) || $choice eq '') {
1.32      raeburn  1128:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1129:     print(OUT 'lonSupportEMail'."\t".$choice."\n");
                   1130:     close(OUT);
                   1131:     $lonSupportEMail=$choice;
                   1132:     $flag=1;
                   1133:   }
                   1134:   else {
                   1135:     print "Invalid input (this either needs to be blank, or look like an e-mail address!).\n";
                   1136:   }
                   1137: }
                   1138: 
1.68      raeburn  1139: # get protocol
                   1140: # accept if valid, if not valid, tell user and repeat
                   1141: $flag=0;
1.60      raeburn  1142: while (!$flag) {
                   1143:   print(&lt;&lt;END);
                   1144: 
                   1145: ****  Web Server Protocol ****
                   1146: If you plan to run the Apache server with SSL enabled, 
                   1147: the protocol should be: https; otherwise it should be http.
1.68      raeburn  1148: ENTER WEB SERVER PROTOCOL [http]:
1.60      raeburn  1149: END
                   1150: 
                   1151:   my $choice=&lt;&gt;;
                   1152:   chomp($choice);
1.65      raeburn  1153:   if ($choice =~ /^https?$/) {
1.60      raeburn  1154:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1155:     print(OUT 'protocol'."\t".$choice."\n");
                   1156:     close(OUT);
                   1157:     $protocol=$choice;
                   1158:     $flag=1;
1.68      raeburn  1159:   } elsif ($choice eq '') {
                   1160:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1161:     print(OUT 'protocol'."\t".'http'."\n");
                   1162:     close(OUT);
                   1163:     $protocol = 'http';
                   1164:     $flag = 1;
                   1165:   } else {
1.60      raeburn  1166:     print "Invalid input (only http or https allowed).\n";
                   1167:   }
                   1168: }
1.32      raeburn  1169: 
1.68      raeburn  1170: # get internet domain
                   1171: # accept if valid, if not valid, tell user and repeat
                   1172: $flag=0;
1.65      raeburn  1173: while (!$flag) {
                   1174:   print(&lt;&lt;END);
                   1175: 
                   1176: ****  Internet Domain Name of Your Institution ****
                   1177: 
                   1178: The internet domain name used for servers at your institution 
                   1179: should be provided.  This will be similar to: ustate.edu or
1.83      raeburn  1180: topcollege.ac.uk or myhostingcompany.com, i.e., the part of
1.65      raeburn  1181: a server hostname which indicates to which organization the 
                   1182: server belongs.
                   1183: 
                   1184: ENTER INTERNET DOMAIN NAME:
                   1185: END
                   1186: 
                   1187:   my $choice=&lt;&gt;;
                   1188:   chomp($choice);
                   1189:   if ($choice =~/[^.]+\.[^.]+/) {
                   1190:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
1.68      raeburn  1191:     print(OUT 'internet domain'."\t".$choice."\n");
1.65      raeburn  1192:     close(OUT);
                   1193:     $intdom=$choice;
                   1194:     $flag=1;
                   1195:   }
                   1196:   else {
                   1197:     print "Invalid input (must be at least two levels separated by .  - e.g., ustate.edu).\n";
                   1198:   }
                   1199: }
                   1200: 
1.84      raeburn  1201: # get hostname
                   1202: # accept if valid, if not valid, tell user and repeat
                   1203: $flag=0;
                   1204: my $posshostname;
                   1205: if (($hostname =~ /^[A-Za-z0-9\-]+$/) && ($intdom ne '')) {
                   1206:     $posshostname = $hostname.'.'.$intdom;
                   1207: } 
                   1208: if (($hostname =~ /^[A-Za-z0-9\-]+\.[A-Za-z0-9\-]+/) &&
                   1209:     ($hostname =~ /^[A-Za-z0-9.\-]+$/)) {
                   1210:     $posshostname = $hostname;
                   1211: }
                   1212: while (!$flag) {
                   1213:   print(&lt;&lt;END);
                   1214: 
                   1215: ****** Hostname of the server/VM *****
                   1216: 
                   1217: The hostname of the server/VM is required. This will be similar to:
1.85      raeburn  1218: somename.ustate.edu or somename.department.ustate.edu, and would be
1.84      raeburn  1219: the web address which users would point their web browsers at to
                   1220: access the server.
                   1221: 
                   1222: END
                   1223: 
                   1224: if ($posshostname) {
                   1225:     print "ENTER HOSTNAME OF SERVER [$posshostname]:\n";
                   1226: } else {
                   1227:     print "ENTER HOSTNAME OF SERVER:\n";
                   1228: }
                   1229: 
                   1230:   my $choice=&lt;&gt;;
                   1231:   chomp($choice);
                   1232:   if (($choice =~ /^[A-Za-z0-9\-]+\.[A-Za-z0-9\-]+/) &&
                   1233:       ($choice =~ /^[A-Za-z0-9.\-]+$/)) {
                   1234:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1235:     print(OUT 'hostname'."\t".$choice."\n");
                   1236:     close(OUT);
                   1237:     $desiredhostname=$choice;
                   1238:     $flag=1;
                   1239:   } elsif (($choice eq '') && ($posshostname ne '')) {
                   1240:     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
                   1241:     print(OUT 'hostname'."\t$posshostname\n");
                   1242:     close(OUT);
                   1243:     $desiredhostname = $posshostname;
                   1244:     $flag = 1;
                   1245:   } else {
                   1246:     print "Invalid input (only letters, numbers, - and . allowed, with at least one .).\n";
                   1247:   }
                   1248: }
1.65      raeburn  1249: 
1.88      raeburn  1250: &ssl_info();
1.85      raeburn  1251: 
1.88      raeburn  1252: $country = &get_country($desiredhostname);
1.85      raeburn  1253: 
1.88      raeburn  1254: $state = &get_state();
1.85      raeburn  1255: 
1.88      raeburn  1256: $city = &get_city();
1.85      raeburn  1257: 
1.88      raeburn  1258: ($domainDescription,$country,$state,$city) = &confirm_locality($domainDescription,$country,$state,$city);
1.85      raeburn  1259: 
1.88      raeburn  1260: my $perlstaticref = &get_static_config();
                   1261: if (ref($perlstaticref) eq 'HASH') {
1.85      raeburn  1262:   my ($certsdir,$privkey,$connectcsr,$replicatecsr);
1.88      raeburn  1263:   $certsdir = $perlstaticref-&gt;{'lonCertificateDirectory'};
                   1264:   $privkey = $perlstaticref-&gt;{'lonnetPrivateKey'};
                   1265:   $connectcsr = $perlstaticref-&gt;{'lonnetCertificate'};
1.85      raeburn  1266:   $connectcsr =~ s/\.pem$/.csr/;
1.88      raeburn  1267:   $replicatecsr = $perlstaticref-&gt;{'lonnetHostnameCertificate'};
1.85      raeburn  1268:   $replicatecsr =~ s/\.pem$/.csr/;
                   1269: 
                   1270:   print(&lt;&lt;END);
                   1271: 
                   1272: ****** SSL Certificates *****
                   1273: 
                   1274: You need to provide a password to be used for the openssl key which
                   1275: will be stored in $certsdir, and will be used when creating two
                   1276: certificate signing requests: $connectcsr and $replicatecsr
                   1277: 
                   1278: END
                   1279: 
1.88      raeburn  1280:   my $sslkeypass = &get_new_sslkeypass();
1.85      raeburn  1281: 
                   1282:   if ($certsdir && $privkey) {
                   1283:     my $connectsubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=$lonHostID/OU=LONCAPA/emailAddress=$lonAdmEMail";
                   1284:     my $replicatesubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=internal-$desiredhostname/OU=LONCAPA/emailAddress=$lonAdmEMail";
                   1285: 
                   1286: # generate SSL key
1.88      raeburn  1287:     &make_key($certsdir,$privkey,$sslkeypass);
1.85      raeburn  1288: # generate SSL csr for hostID
1.88      raeburn  1289:     &make_host_csr($certsdir,$sslkeypass,$connectcsr,$connectsubj);
1.85      raeburn  1290: # generate SSL csr for internal hostname
1.88      raeburn  1291:     &make_hostname_csr($certsdir,$sslkeypass,$replicatecsr,$replicatesubj);
                   1292: # mail csr files to certificate@lon-capa.org (production or dev clusters).
                   1293:     &mail_csr('both',$lonCluster,$lonHostID,$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlstaticref);
1.85      raeburn  1294: 
1.88      raeburn  1295:     } else {
                   1296:         print "Could not acquire standard names for SSL Certificate files from loncapa_apache.conf\n";
1.85      raeburn  1297:     }
1.88      raeburn  1298: } else {
                   1299:     print "Could not acquire standard names for SSL Certificate files from loncapa_apache.conf\n";
1.85      raeburn  1300: }
                   1301: 
1.1       harris41 1302: # update loncapa.conf
1.49      raeburn  1303: my $confdir = '/etc/httpd/conf/';
1.91      raeburn  1304: if ('<DIST />' eq 'sles10' || '<DIST />' eq 'sles11' || '<DIST />' eq 'sles12' || '<DIST />' eq 'sles15' || '<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  1305:      $confdir = '/etc/apache2/';
                   1306: }   
1.5       harris41 1307: my $filename='loncapa.conf';
                   1308: my %perlvar;
                   1309:     if (-e "$confdir$filename") {
                   1310: 	open(CONFIG,'&lt;'.$confdir.$filename) or die("Can't read $confdir$filename");
                   1311: 	while (my $configline=&lt;CONFIG&gt;) {
                   1312: 	    if ($configline =~ /^[^\#]*PerlSetVar/) {
                   1313: 		my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
                   1314: 		chomp($varvalue);
1.12      harris41 1315: 		$perlvar{$varname}=$varvalue if $varvalue!~/^\{\[\[\[\[/;
1.5       harris41 1316: 	    }
                   1317: 	}
                   1318: 	close(CONFIG);
                   1319:     }
                   1320:     $perlvar{'lonHostID'}=$lonHostID;
                   1321:     $perlvar{'lonDefDomain'}=$lonDefDomain;
1.9       harris41 1322:     $perlvar{'lonAdmEMail'}=$lonAdmEMail;
1.32      raeburn  1323:     $perlvar{'lonSupportEMail'}=$lonSupportEMail;
1.5       harris41 1324:     $perlvar{'lonRole'}=$lonRole;
1.16      harris41 1325:     unless ($perlvar{'lonLoadLim'} and $perlvar{'lonLoadLim'}!~/\{\[\[\[\[/) {
1.5       harris41 1326:        $perlvar{'lonLoadLim'}='2.00';
                   1327:     }
1.25      albertel 1328:     unless ($perlvar{'lonUserLoadLim'} and $perlvar{'lonUserLoadLim'}!~/\{\[\[\[\[/) {
                   1329:        $perlvar{'lonUserLoadLim'}='0';
                   1330:     }
1.16      harris41 1331:     unless ($perlvar{'lonExpire'} and $perlvar{'lonExpire'}!~/\{\[\[\[\[/) {
1.5       harris41 1332:        $perlvar{'lonExpire'}='86400';
                   1333:     }
1.16      harris41 1334:     unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
1.5       harris41 1335:        my $lonReceipt='';
1.11      harris41 1336:        srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
1.82      raeburn  1337:        my @alnum=(0..9,"a".."z");
1.5       harris41 1338:        foreach my $i (1..20) {
                   1339: 	 $lonReceipt.=$alnum[int(rand(36))];
                   1340:        }
                   1341:        $perlvar{'lonReceipt'}=$lonReceipt;
                   1342:     }
                   1343:     open(OUT,"&gt;$confdir$filename") or
                   1344:       die("Cannot output to $confdir$filename\n");
                   1345:     foreach my $key (keys %perlvar) {
                   1346:       my $value=$perlvar{$key};
1.49      raeburn  1347:       my $line = "PerlSetVar     $key      $value"; 
                   1348:       if ($value eq '') {
                   1349:           $line = '#'.$line;
                   1350:       }
1.5       harris41 1351:       print(OUT &lt;&lt;END);
1.49      raeburn  1352: $line
1.5       harris41 1353: END
                   1354:     }
                   1355:     close(OUT);
1.1       harris41 1356: }
                   1357: </perlscript>
                   1358: </file>
                   1359: <file>
1.49      raeburn  1360: <target dist='default'>/etc/httpd/conf/</target>
1.91      raeburn  1361: <target dist='sles10 sles11 sles12 sles15 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 1362: <perlscript mode='fg'>
                   1363: # read values from loncapa.conf
1.49      raeburn  1364: my $confdir = "<TARGET />";
1.5       harris41 1365: my $filename='loncapa.conf';
                   1366: my %perlvar;
                   1367:     if (-e "$confdir$filename") {
                   1368: 	open(CONFIG,'&lt;'.$confdir.$filename) or 
                   1369:           die("Can't read $confdir$filename");
                   1370: 	while (my $configline=&lt;CONFIG&gt;) {
                   1371: 	    if ($configline =~ /^[^\#]*PerlSetVar/) {
                   1372: 		my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
                   1373: 		chomp($varvalue);
                   1374: 		$perlvar{$varname}=$varvalue;
                   1375: 	    }
                   1376: 	}
                   1377: 	close(CONFIG);
                   1378:     }
1.16      harris41 1379:     unless ($perlvar{'lonLoadLim'} and $perlvar{'lonLoadLim'}!~/\{\[\[\[\[/) {
                   1380:        $perlvar{'lonLoadLim'}='2.00';
                   1381:     }
1.25      albertel 1382:     unless ($perlvar{'lonUserLoadLim'} and $perlvar{'lonUserLoadLim'}!~/\{\[\[\[\[/) {
                   1383:        $perlvar{'lonUserLoadLim'}='0';
                   1384:     }
1.16      harris41 1385:     unless ($perlvar{'lonExpire'} and $perlvar{'lonExpire'}!~/\{\[\[\[\[/) {
                   1386:        $perlvar{'lonExpire'}='86400';
                   1387:     }
1.31      albertel 1388:     unless ($perlvar{'londAllowInsecure'} and $perlvar{'londAllowInsecure'}!~/\{\[\[\[\[/) {
                   1389:        $perlvar{'londAllowInsecure'}='1';
                   1390:     }
                   1391:     unless ($perlvar{'loncAllowInsecure'} and $perlvar{'loncAllowInsecure'}!~/\{\[\[\[\[/) {
                   1392:        $perlvar{'loncAllowInsecure'}='1';
                   1393:     }
1.88      raeburn  1394:     my ($securestatus,$securenum)=&securesetting(%perlvar);
1.16      harris41 1395:     unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
                   1396:        my $lonReceipt='';
                   1397:        srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
1.82      raeburn  1398:        my @alnum=(0..9,"a".."z");
1.16      harris41 1399:        foreach my $i (1..20) {
                   1400: 	 $lonReceipt.=$alnum[int(rand(36))];
                   1401:        }
                   1402:        $perlvar{'lonReceipt'}=$lonReceipt;
                   1403:     }
1.88      raeburn  1404:     my $perlvarstatic = &get_static_config();
1.55      albertel 1405: 
                   1406:     my (@hosts_files, @domain_files);
                   1407:     if ( $lonCluster ne 'existing') {
                   1408: 	push(@domain_files,'../'.$lonCluster.'_domain.tab',
                   1409: 	     '../'.$lonCluster.'_dns_domain.tab');
                   1410: 	push(@hosts_files,'../'.$lonCluster.'_hosts.tab',
                   1411: 	     '../'.$lonCluster.'_dns_hosts.tab');
                   1412:     }
                   1413:     push(@domain_files,'/home/httpd/lonTabs/domain.tab',
                   1414:          '/home/httpd/lonTabs/dns_domain.tab');
                   1415:     push(@hosts_files,'/home/httpd/lonTabs/hosts.tab',
                   1416:          '/home/httpd/lonTabs/dns_hosts.tab');
                   1417: 
1.85      raeburn  1418:     my @poss_hosts_files = @hosts_files;
1.23      albertel 1419:     if (!$domainDescription) {
1.55      albertel 1420: 	foreach my $file (@domain_files) {
                   1421: 	    open(IN,'&lt;'.$file);
                   1422: 	    while(my $line = &lt;IN&gt;) {
                   1423: 		if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
                   1424: 		    (undef,$domainDescription,$domainTabExtras)=split(/:/,$line,3);
                   1425: 		    chomp($domainDescription);
                   1426: 		    chomp($domainTabExtras);
1.60      raeburn  1427: 		    # the remaining field (primary lib server) is handled later
1.55      albertel 1428: 		    $domainTabExtras = join(':',(split(/:/,$domainTabExtras))[0..5]);
                   1429: 		    last;
                   1430: 		}
                   1431: 	    }
                   1432: 	    close(IN);
                   1433: 	    last if ($domainDescription);
                   1434: 	}
1.23      albertel 1435:     }
1.55      albertel 1436: 
1.84      raeburn  1437:     if ((!$protocol) || (!$desiredhostname)) {
1.60      raeburn  1438:         foreach my $file (@hosts_files) {
                   1439:             open(IN,'&lt;'.$file);
                   1440:             while(my $line = &lt;IN&gt;) {
1.84      raeburn  1441:                 if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:([^:]+)\:(https?)/) {
                   1442:                     if (!$desiredhostname) {
                   1443:                         $desiredhostname = $1;
                   1444:                     }
                   1445:                     if (!$protocol) { 
                   1446:                         $protocol = $2;
                   1447:                         chomp($protocol);
                   1448:                     }
1.60      raeburn  1449:                     last;
                   1450:                 }
                   1451:             }
                   1452:         }
                   1453:     }
                   1454: 
                   1455:     if (!$protocol) {
                   1456:         $protocol = 'http';
                   1457:     }
                   1458: 
1.65      raeburn  1459:     if (!$intdom) {
                   1460:         foreach my $file (@hosts_files) {
                   1461:             open(IN,'&lt;'.$file);
                   1462:             while(my $line = &lt;IN&gt;) {
1.66      raeburn  1463:                 if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:[^:]+\:https?\:([^:]+)/) {
1.65      raeburn  1464:                     $intdom = $1;
1.66      raeburn  1465:                     chomp($intdom);
1.65      raeburn  1466:                     last;
                   1467:                 }
                   1468:             }
                   1469:         }
                   1470:     }
                   1471: 
1.85      raeburn  1472:     my (%hostnames,%protocols);
1.82      raeburn  1473:     while(!$primaryLibServer && (@hosts_files || @domain_files)) {
1.55      albertel 1474: 	my $file = shift(@domain_files);
                   1475:         open(IN,'&lt;'.$file);
                   1476:         while(my $line = &lt;IN&gt;) {
                   1477:             if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
                   1478: 		$primaryLibServer=(split(/:/,$line))[8];
1.43      raeburn  1479:                 chomp($primaryLibServer);
                   1480:             }
                   1481:         }
                   1482:         close(IN);
1.55      albertel 1483: 	last if ($primaryLibServer);
                   1484: 	$file = shift(@hosts_files);
                   1485: 	open(IN,'&lt;'.$file);
                   1486: 	while(my $line = &lt;IN&gt;) {
1.85      raeburn  1487: 	    if ($line =~ /^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:([^\:]+)/) {
1.55      albertel 1488: 		push(@libservers,$1);
1.85      raeburn  1489:                 $hostnames{$1} = $2;
1.55      albertel 1490: 	    }
                   1491: 	}
1.58      albertel 1492: 	# make list unique
1.86      raeburn  1493: 	@libservers = keys(%{{ map { $_ =&gt; 1 } (@libservers) }});
1.55      albertel 1494: 	close(IN);
                   1495: 	if (@libservers == 1) {
                   1496: 	    $primaryLibServer = $libservers[0];
                   1497: 	}
1.43      raeburn  1498:     }
1.85      raeburn  1499: 
                   1500: # get hostname of primaryLibServer
                   1501:     my ($primary_hostname,$primary_protocol);
                   1502:     if ($primaryLibServer) {
                   1503:         if ($hostnames{$primaryLibServer}) {
                   1504:             $primary_hostname = $hostnames{$primaryLibServer};
                   1505:             $primary_protocol = $protocols{$primaryLibServer};
                   1506:         } else {
                   1507:             foreach my $file (@poss_hosts_files) {
                   1508:                 open(IN,'&lt;'.$file);
                   1509:                 while (my $line = &lt;IN&gt;) {
                   1510:                     if ($line =~ /^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:([^\:]+):(https?)/) {
                   1511:                         if ($1 eq $primaryLibServer) {
                   1512:                             $primary_hostname = $2;
                   1513:                             $primary_protocol = $3;
                   1514:                             last;
                   1515:                         }
                   1516:                     }
                   1517:                 }
                   1518:                 close(IN);
                   1519:                 last if ($primary_hostname);
                   1520:             }
                   1521:         }
                   1522:     }
1.23      albertel 1523:    
1.6       harris41 1524: # implement editing logic below, interactively
1.88      raeburn  1525: # update loncapa.conf until 18 is entered
1.6       harris41 1526: 
1.82      raeburn  1527: my $flag=0;
1.17      harris41 1528: 
1.85      raeburn  1529: #
                   1530: # Changes to 5, 6, and 14 not supported if configuration.db set on primary library server.
                   1531: # (requires either this machine to be primary library server or for LON-CAPA and Apache
1.88      raeburn  1532: # to be running on primary library server).
1.85      raeburn  1533: #
                   1534: 
                   1535: my ($isprimary,$domconf,$url,$gotdomconf,$adminmail,$supportmail,$connectssl,%setbygui);
                   1536: if ($primaryLibServer eq $perlvar{'lonHostID'}) {
                   1537:     $isprimary = 1;
                   1538: } else {
                   1539:     unless ($primary_protocol eq 'https') {
                   1540:         $primary_protocol = 'http';
                   1541:     } 
                   1542:     $url = $primary_protocol.'://'.$primary_hostname.'/cgi-bin/listdomconfig.pl';
                   1543: }
1.88      raeburn  1544: 
                   1545: my %sslnames = &get_sslnames();
                   1546: my %ssldesc = &get_ssldesc();
                   1547: 
1.86      raeburn  1548: my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary,
1.88      raeburn  1549:                                  $url,$perlvarstatic);
1.85      raeburn  1550: if (ref($domconf)) {
                   1551:     $gotdomconf = 1;
1.86      raeburn  1552:     if (ref($domconf-&gt;{'contacts'}) eq 'HASH') {
                   1553:         if (exists($domconf-&gt;{'contacts'}-&gt;{'adminemail'})) {
                   1554:             $adminmail = $domconf-&gt;{'contacts'}-&gt;{'adminemail'};
1.85      raeburn  1555:         }
                   1556:         if (exists($domconf->{'contacts'}->{'supportemail'})) {
1.86      raeburn  1557:             $supportmail = $domconf-&gt;{'contacts'}-&gt;{'supportemail'};
1.85      raeburn  1558:         }
                   1559:     }
1.86      raeburn  1560:     if (ref($domconf-&gt;{'ssl'}) eq 'HASH') {
                   1561:         foreach my $connect ('connto','connfrom') { 
                   1562:             if (ref($domconf-&gt;{'ssl'}-&gt;{$connect}) eq 'HASH') {       
                   1563:                 my ($sslreq,$sslnoreq,$currsetting);
                   1564:                 my %contypes; 
                   1565:                 foreach my $type ('dom','intdom','other') {
                   1566:                     my $key;
                   1567:                     if ($domconf-&gt;{'ssl'}-&gt;{'connect'}-&gt;{$type} eq 'req') {
                   1568:                         $key = 'yes';
                   1569:                     } else {
                   1570:                         $key = 'no';
                   1571:                     }
                   1572:                     if ($type eq 'dom') {
                   1573:                         $contypes{$key} .= ' own domain,';
                   1574:                     } elsif ($type eq 'intdom') {
                   1575:                         $contypes{$key} .= ' own institution,';
                   1576:                     } elsif ($type eq 'other') { 
                   1577:                         $contypes{$key} .= ' other domains,';
                   1578:                     }
1.85      raeburn  1579:                 }
1.86      raeburn  1580:                 foreach my $key (sort(keys(%contypes))) {
                   1581:                     $contypes{$key} =~ s/^\s//;
                   1582:                     $contypes{$key} =~ s/,$//;
                   1583:                     if ($key eq 'yes') {
                   1584:                         $currsetting .= ' Yes ('.$contypes{$key}.'),';
                   1585:                     } elsif ($key eq 'no') {
                   1586:                         $currsetting .= ' No ('.$contypes{$key}.')';
                   1587:                     }
                   1588:                     $currsetting =~ s/,$//;
1.85      raeburn  1589:                 }
1.86      raeburn  1590:                 if ($currsetting ne '') {
1.88      raeburn  1591:                     $connectssl = $sslnames{$connect}.' -- '.$currsetting.' | '; 
1.85      raeburn  1592:                 }
                   1593:             }
                   1594:         }
1.86      raeburn  1595:         $connectssl =~ s/\s\|\s$//; 
1.85      raeburn  1596:     }
                   1597: }
                   1598: if ($connectssl) {
                   1599:     $setbygui{'securestatus'} = 1;
                   1600:     $securestatus = 'Set by domain configuration via web GUI. Currently: '.$connectssl; 
                   1601: }
                   1602: if ($adminmail) {
                   1603:     $adminmail = 'Set by domain configuration via web GUI. Currently: '.$adminmail;
                   1604:     $setbygui{'lonAdmEMail'} = 1;
                   1605: } else {
                   1606:     $adminmail = $perlvar{'lonAdmEMail'};
                   1607: }
                   1608: if ($supportmail) {
                   1609:     $supportmail = 'Set by domain configuration via web GUI. Currently: '.$supportmail;
                   1610:     $setbygui{'lonSupportEMail'} = 1;
                   1611: } else {
                   1612:     $supportmail = $perlvar{'lonSupportEMail'};
                   1613: }
                   1614: 
                   1615: print "\nRetrieving status information for SSL key and certificates ...\n\n";
1.88      raeburn  1616: my ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) = 
1.90      raeburn  1617:     &get_cert_status($perlvar{'lonHostID'},$desiredhostname,$perlvarstatic);
1.88      raeburn  1618: print $certinfo;
1.85      raeburn  1619: my %sslstatus;
1.88      raeburn  1620: if (ref($sslref) eq 'HASH') {
                   1621:     %sslstatus = %{$sslref};
1.85      raeburn  1622: }
                   1623: 
1.6       harris41 1624: while (!$flag) {
1.1       harris41 1625:   print(&lt;&lt;END);
                   1626: 
                   1627: ===============================================================================
                   1628: This is now the current configuration of your machine.
1.31      albertel 1629:  1) Domain Name: $perlvar{'lonDefDomain'}
                   1630:  2) Domain Description: $domainDescription
                   1631:  3) Machine Name: $perlvar{'lonHostID'}
1.43      raeburn  1632:  4) ID of primary library server for domain: $primaryLibServer
1.85      raeburn  1633:  5) Server Administrator's E-mail Address: $adminmail
                   1634:  6) Support E-mail Address: $supportmail
1.60      raeburn  1635:  7) Web Server Protocol (http or https): $protocol 
1.65      raeburn  1636:  8) Internet Domain Name: $intdom 
1.84      raeburn  1637:  9) Hostname: $desiredhostname
                   1638: 10) Role: $perlvar{'lonRole'}
1.85      raeburn  1639: 11) Cache Expiration Time: $perlvar{'lonExpire'} (seconds)
1.84      raeburn  1640: 12) Server Load: $perlvar{'lonLoadLim'}
                   1641: 13) User Load: $perlvar{'lonUserLoadLim'}
1.88      raeburn  1642: 14) LON-CAPA "internal" connections: $securestatus
1.85      raeburn  1643: 15) Private Key for SSL: $lonkeystatus
                   1644: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1645: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   1646: 18) Everything is correct up above
1.6       harris41 1647: END
1.38      www      1648: 
1.54      albertel 1649: my @error;
1.38      www      1650: foreach my $v ($perlvar{'lonDefDomain'},$perlvar{'lonHostID'}) {
1.86      raeburn  1651:    if (length($v)&gt;35) { push(@error,"Name $v too long"); }		
                   1652:    if (length($v)&lt;2) { push(@error,"Name $v too short"); }
1.39      albertel 1653:    if ($v=~/capa/i) {
                   1654: 	if ($v!~/^oucapa\d+$/ && 
                   1655: 	    ($v!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
1.54      albertel 1656: 		 push(@error,"Name $v contains 'capa'");
1.39      albertel 1657: 	}
                   1658:    }
1.41      albertel 1659:    foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
                   1660: 	'editupload') {
1.54      albertel 1661:       push(@error,"\nName $v reserved.") if $v eq $bad;
1.38      www      1662:    }
1.54      albertel 1663:    if ($v=~/[^\w\-.]/) { push(@error,"Name $v contains special characters"); }
1.38      www      1664: }
1.53      albertel 1665: if ($domainDescription =~ /^\s*$/) {
1.54      albertel 1666:    push(@error,"Domain Description is blank.");
1.53      albertel 1667: } elsif ($domainDescription!~/^[\(\)\-\w\s,]+$/) {
1.54      albertel 1668:    push(@error,"Domain Description contains special characters.");
1.38      www      1669: } 
                   1670: foreach my $v ($perlvar{'lonExpire'},$perlvar{'lonLoadLim'}) {
1.54      albertel 1671:    unless ($v=~/^[\d+\.]+$/) { push(@error,"Number expected instead of $v"); }
1.38      www      1672: }
                   1673: unless (($perlvar{'lonRole'} eq 'library') || ($perlvar{'lonRole'} eq 'access')) {
1.54      albertel 1674:    push(@error,"Invalid Role");
1.17      harris41 1675: }
1.43      raeburn  1676: 
1.60      raeburn  1677: unless (($protocol eq 'http') || ($protocol eq 'https')) {
                   1678:    push(@error,"Invalid Protocol (must be http or https");
                   1679: }
                   1680: 
1.65      raeburn  1681: if (!defined($intdom)) { 
                   1682:    push(@error,"No internet domain name designated. Enter something like ustate.edu"); 
1.71      raeburn  1683: } elsif ($intdom !~ /[^.]+\.\w{2,6}$/) {
1.65      raeburn  1684:    push(@error,"Invalid Internet domain name (must be at least two levels separated by .  - e.g., ustate.edu");
                   1685: }
                   1686: 
1.43      raeburn  1687: if (!defined($primaryLibServer)) {
1.86      raeburn  1688:    if (@libservers &gt; 0) {
1.54      albertel 1689:        push(@error,"No primary library server ID designated. Choose from: ".join(',',sort(@libservers)));
1.43      raeburn  1690:    } else {
1.54      albertel 1691:        push(@error,"No library servers in this domain (including current server)");
1.43      raeburn  1692:    }
                   1693: } else {
1.86      raeburn  1694:    if (length($primaryLibServer)&gt;35) { push(@error,"Primary Library Server ID:  $primaryLibServer too long"); }
                   1695:    if (length($primaryLibServer)&lt;2) { push(@error,"Primary Library Server ID:  $primaryLibServer too short"); }
1.43      raeburn  1696:    if ($primaryLibServer =~/capa/i) {
                   1697:         if ($primaryLibServer!~/^oucapa\d+$/ &&
                   1698:             ($primaryLibServer!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
1.54      albertel 1699:                  push(@error,"Primary library server ID $primaryLibServer contains 'capa'")
1.43      raeburn  1700:         }
                   1701:    }
                   1702:    foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
                   1703:         'editupload') {
1.54      albertel 1704:       push(@error,"Primary library server ID $primaryLibServer reserved.") if $primaryLibServer eq $bad;
1.43      raeburn  1705:    }
1.54      albertel 1706:    if ($primaryLibServer=~/[^\w\-.]/) { push(@error,"Primary library server ID $primaryLibServer contains special characters"); }
1.43      raeburn  1707: }
                   1708: 
                   1709: 
1.85      raeburn  1710: my ($certsdir,$privkey,$connectcsr,$replicatecsr);
1.88      raeburn  1711: $certsdir = $perlvarstatic-&gt;{'lonCertificateDirectory'};
                   1712: $privkey = $perlvarstatic-&gt;{'lonnetPrivateKey'};
                   1713: $connectcsr = $perlvarstatic-&gt;{'lonnetCertificate'};
1.85      raeburn  1714: $connectcsr =~ s/\.pem$/.csr/;
1.88      raeburn  1715: $replicatecsr = $perlvarstatic-&gt;{'lonnetHostnameCertificate'};
1.85      raeburn  1716: $replicatecsr =~ s/\.pem$/.csr/;
                   1717: 
1.54      albertel 1718: if (@error) { print "\n*** ERRORS: \n\t".join("\n\t",@error)."\n"; }
1.6       harris41 1719:   print(&lt;&lt;END);
1.85      raeburn  1720: ENTER A CHOICE OF 1-17 TO CHANGE, otherwise ENTER 18:
1.1       harris41 1721: END
1.5       harris41 1722: my $choice=&lt;&gt;;
                   1723: chomp($choice);
1.6       harris41 1724:   if ($choice==1) {
                   1725:   print(&lt;&lt;END);
1.16      harris41 1726: 1) Domain Name: $perlvar{'lonDefDomain'}
1.20      albertel 1727: ENTER NEW VALUE (this is an internal value used to identify a group of
                   1728:                  LON-CAPA machines, it must be alphanumerical, we suggest
                   1729:                  using a part of your actual DNS domain. For example, for
                   1730:                  the machine loncapa.msu.edu, we set the Domain to msu):
1.6       harris41 1731: END
                   1732:     my $choice2=&lt;&gt;;
                   1733:     chomp($choice2);
1.8       harris41 1734:     $perlvar{'lonDefDomain'}=$choice2;
1.6       harris41 1735:   }
                   1736:   elsif ($choice==2) {
                   1737:   print(&lt;&lt;END);
1.20      albertel 1738: 2) Domain Description: $domainDescription
                   1739: ENTER NEW VALUE (this should be a string that describes your domain, spaces
                   1740:                  and punctuation are fine except for ':'):
                   1741: END
                   1742:     my $choice2=&lt;&gt;;
                   1743:     chomp($choice2);
                   1744:     $domainDescription=$choice2;
                   1745:   }
                   1746:   elsif ($choice==3) {
                   1747:   print(&lt;&lt;END);
                   1748: 3) Machine Name: $perlvar{'lonHostID'}
                   1749: ENTER NEW VALUE (this will be the name of the machine in the LON-CAPA network
                   1750:                  it cannot contain any of '_' '-' '.' or ':'. We suggest that
                   1751:                  if you are in the domain 'example' and are the first library
                   1752:                  server you enter 'examplel1') :
1.6       harris41 1753: END
                   1754:     my $choice2=&lt;&gt;;
                   1755:     chomp($choice2);
1.8       harris41 1756:     $perlvar{'lonHostID'}=$choice2;
1.6       harris41 1757:   }
1.20      albertel 1758:   elsif ($choice==4) {
1.6       harris41 1759:   print(&lt;&lt;END);
1.43      raeburn  1760: 4) ID of primary library server for domain: $primaryLibServer
                   1761: ENTER NEW VALUE (this will be the LON-CAPA Machine ID of a library server in
                   1762:                  your domain; it cannot contain any of '_' '-' '.' or ':'. 
                   1763:                  This server will be where domain data which are not 
                   1764:                  associated with any specific home library server
                   1765:                  will be stored (e.g., e-mail broadcast by Domain Coordinators
                   1766:                  to users in the domain).
                   1767: END
                   1768:     my $choice2=&lt;&gt;;
                   1769:     chomp($choice2);
                   1770:     $primaryLibServer=$choice2;
                   1771:   }
                   1772:   elsif ($choice==5) {
1.85      raeburn  1773:     if ($setbygui{'lonAdmEMail'}) {
                   1774:       print(&lt;&lt;END);
                   1775: 5) Server Administrator's E-mail Address: $adminmail
                   1776: Use the web GUI (as domain coordinator) to make changes after completing the UPDATE.
                   1777: END
                   1778:     } else {
                   1779:       print(&lt;&lt;END);
1.47      albertel 1780: 5) Server Administrator's E-mail Address: $perlvar{'lonAdmEMail'}
1.6       harris41 1781: ENTER NEW VALUE:
                   1782: END
1.85      raeburn  1783:       my $choice2=&lt;&gt;;
                   1784:       chomp($choice2);
                   1785:       $perlvar{'lonAdmEMail'}=$choice2;
1.88      raeburn  1786:       $adminmail=$perlvar{'lonAdmEMail'};
1.85      raeburn  1787:     }
1.6       harris41 1788:   }
1.43      raeburn  1789:   elsif ($choice==6) {
1.88      raeburn  1790:     if ($setbygui{'lonSupportEMail'}) {
1.85      raeburn  1791:       print(&lt;&lt;END);
                   1792: 6) Support E-mail Address: $supportmail
                   1793: Use the web GUI (as domain coordinator) to make changes after completing the UPDATE.
                   1794: END
                   1795:     } else {    
                   1796:       print(&lt;&lt;END);
1.43      raeburn  1797: 6) Support E-mail Address: $perlvar{'lonSupportEMail'}
1.32      raeburn  1798: ENTER NEW VALUE:
                   1799: END
1.85      raeburn  1800:       my $choice2=&lt;&gt;;
                   1801:       chomp($choice2);
                   1802:       $perlvar{'lonSupportEMail'}=$choice2;
1.88      raeburn  1803:       $supportmail=$perlvar{'lonSupportEMail'};
1.85      raeburn  1804:     }
1.32      raeburn  1805:   }
1.43      raeburn  1806:   elsif ($choice==7) {
1.32      raeburn  1807:   print(&lt;&lt;END);
1.60      raeburn  1808: 7) Server Protocol (http or https): 
                   1809: ENTER NEW VALUE: (this should be either 'http' or 'https'
                   1810:                  if in doubt set to 'http'):
                   1811: END
                   1812:     my $choice2=&lt;&gt;;
                   1813:     chomp($choice2);
                   1814:     $protocol=$choice2;
                   1815:   }
                   1816:   elsif ($choice==8) {
                   1817:   print(&lt;&lt;END);
1.65      raeburn  1818: 8) Internet Domain Name of Institution
                   1819: ENTER NEW VALUE: 
                   1820: 
                   1821: END
                   1822:     my $choice2=&lt;&gt;;
                   1823:     chomp($choice2);
                   1824:     $intdom=$choice2;
                   1825:   }
                   1826:   elsif ($choice==9) {
                   1827:   print(&lt;&lt;END);
1.84      raeburn  1828: 9) Hostname of Server/VM
                   1829: ENTER NEW VALUE:
                   1830: 
                   1831: END
                   1832:     my $choice2=&lt;&gt;;
                   1833:     chomp($choice2);
                   1834:     $desiredhostname=$choice2;
                   1835:   }
                   1836: 
                   1837:   elsif ($choice==10) {
                   1838:   print(&lt;&lt;END);
                   1839: 10) Role: $perlvar{'lonRole'}
1.20      albertel 1840: ENTER NEW VALUE (this should be either 'access' or 'library' 
                   1841:                  if in doubt select 'library'):
1.6       harris41 1842: END
                   1843:     my $choice2=&lt;&gt;;
                   1844:     chomp($choice2);
                   1845:     $perlvar{'lonRole'}=$choice2;
                   1846:   }
1.84      raeburn  1847:   elsif ($choice==11) {
1.6       harris41 1848:   print(&lt;&lt;END);
1.84      raeburn  1849: 11) Cache Expiration Time: $perlvar{'lonExpire'}
1.20      albertel 1850: ENTER NEW VALUE (in seconds, 86400 is a reasonable value):
1.6       harris41 1851: END
                   1852:     my $choice2=&lt;&gt;;
                   1853:     chomp($choice2);
                   1854:     $perlvar{'lonExpire'}=$choice2;
                   1855:   }
1.84      raeburn  1856:   elsif ($choice==12) {
1.6       harris41 1857:   print(&lt;&lt;END);
1.84      raeburn  1858: 12) Server Load: $perlvar{'lonLoadLim'}
1.6       harris41 1859: ENTER NEW VALUE:
                   1860: END
                   1861:     my $choice2=&lt;&gt;;
                   1862:     chomp($choice2);
                   1863:     $perlvar{'lonLoadLim'}=$choice2;
                   1864:   }
1.84      raeburn  1865:   elsif ($choice==13) {
1.25      albertel 1866:   print(&lt;&lt;END);
1.84      raeburn  1867: 13) User Load: $perlvar{'lonUserLoadLim'}
1.25      albertel 1868: Numer of users that can login before machine is 'overloaded'
1.26      albertel 1869: ENTER NEW VALUE (integer value, 0 means there is no limit):
1.25      albertel 1870: END
                   1871:     my $choice2=&lt;&gt;;
                   1872:     chomp($choice2);
                   1873:     $perlvar{'lonUserLoadLim'}=$choice2;
                   1874:   }
1.84      raeburn  1875:   elsif ($choice==14) {
1.85      raeburn  1876:     if ($setbygui{'securestatus'}) {
                   1877:       print(&lt;&lt;END);
                   1878: 14) Allow only secure connections: $securestatus
                   1879: Use the web GUI (as domain coordinator) to make changes after completing the UPDATE.
                   1880: END
                   1881:     } else {
                   1882:       print(&lt;&lt;END);
1.84      raeburn  1883: 14) Allow only secure connections: $securestatus 
1.31      albertel 1884: The Lon-CAPA communication daemons lonc and lond can be configured to
                   1885: allow only secure connections by default.
                   1886: 
                   1887: POSSIBLE CHOICES:
                   1888: 1) allow only secure connections and don't connect to machines that
                   1889:     can not be connected to securely
                   1890: 2) allow only secure connections but allow this machine to connect to 
                   1891:     machines that don't support secure connections
                   1892: 3) allow insecure connections to this machine but only allow connections
                   1893:     to machines that support secure connections
                   1894: 4) allow insecure connections
1.83      raeburn  1895: ENTER NEW VALUE (currently $securenum):
1.31      albertel 1896: END
1.85      raeburn  1897:       my $choice2=&lt;&gt;;
                   1898:       chomp($choice2);
                   1899:       if      ($choice2 eq '1') {
                   1900: 	  $perlvar{'loncAllowInsecure'}=0;$perlvar{'londAllowInsecure'}=0;
                   1901:       } elsif ($choice2 eq '2') {
                   1902: 	  $perlvar{'loncAllowInsecure'}=0;$perlvar{'londAllowInsecure'}=1;
                   1903:       } elsif ($choice2 eq '3') {
                   1904: 	  $perlvar{'loncAllowInsecure'}=1;$perlvar{'londAllowInsecure'}=0;
                   1905:       } elsif ($choice2 eq '4') {
                   1906: 	  $perlvar{'loncAllowInsecure'}=1;$perlvar{'londAllowInsecure'}=1;
                   1907:       }
                   1908:       ($securestatus,$securenum)=&securesetting(%perlvar);
1.31      albertel 1909:     }
1.85      raeburn  1910:   } elsif ($choice==15) {
1.88      raeburn  1911:       if ($sslstatus{'key'} == 1) {
1.86      raeburn  1912:           print(&lt;&lt;END);
1.85      raeburn  1913: 15) Private Key for SSL: $lonkeystatus
                   1914: 
                   1915: POSSIBLE CHOICES:
                   1916: 1) overwrite existing key
1.88      raeburn  1917: 2) make no change
1.85      raeburn  1918: ENTER NEW VALUE
                   1919: END
1.88      raeburn  1920:           my $choice2=&lt;&gt;;
                   1921:           chomp($choice2);
                   1922:           if ($choice2 eq '1') {
                   1923:               my $sslkeypass = &get_new_sslkeypass();
                   1924:               &make_key($certsdir,$privkey,$sslkeypass);
                   1925:           }
                   1926:       } elsif ($sslstatus{'key'} == 0) {
                   1927:           print(&lt;&lt;END);
                   1928: 15) Private Key for SSL: $lonkeystatus
                   1929: END
                   1930:           my $sslkeypass = &get_new_sslkeypass();
                   1931:           &make_key($certsdir,$privkey,$sslkeypass);
                   1932:           print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   1933:           ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
1.90      raeburn  1934:              &get_cert_status($perlvar{'lonHostID'},$desiredhostname,$perlvarstatic);
1.88      raeburn  1935:           if (ref($sslref) eq 'HASH') {
                   1936:               %sslstatus = %{$sslref};
                   1937:           }
                   1938:       }
1.85      raeburn  1939:   } elsif ($choice==16) {
1.88      raeburn  1940:       if (($sslstatus{'host'} == 1) || ($sslstatus{'host'} == 2) || ($sslstatus{'host'} == 3)) {
                   1941:           print(&lt;&lt;END);
1.85      raeburn  1942: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1943: 
                   1944: POSSIBLE CHOICES:
                   1945: 1) create new certificate signing request with new key
                   1946: 2) create new certificate signing request with existing key
                   1947: 3) resend current certificate signing request
                   1948: 4) make no change
                   1949: ENTER NEW VALUE
                   1950: END
1.88      raeburn  1951: 
                   1952:           my $choice2=&lt;&gt;;
                   1953:           chomp($choice2);
                   1954:           if (($choice2 eq '1') || ($choice2 eq '2')) {
                   1955:               &ssl_info();
                   1956:               my $country = &get_country($desiredhostname);
                   1957:               my $state = &get_state();
                   1958:               my $city = &get_city();
                   1959:               my $connectsubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=$perlvar{'lonHostID'}/OU=LONCAPA/emailAddress=$adminmail";
                   1960:               ($domainDescription,$country,$state,$city) = &confirm_locality($domainDescription,$country,$state,$city);
                   1961:               my $sslkeypass;
                   1962:               if ($choice2 eq '1') {
                   1963:                   $sslkeypass = &get_new_sslkeypass();
                   1964:                   &make_key($certsdir,$privkey,$sslkeypass);
                   1965:               } elsif ($choice2 eq '2') {
                   1966:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   1967:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   1968:               }
                   1969:               &make_host_csr($certsdir,$sslkeypass,$connectcsr,$connectsubj);
                   1970:               &mail_csr('host',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   1971:               print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   1972:               ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
1.90      raeburn  1973:                   &get_cert_status($perlvar{'lonHostID'},$desiredhostname,$perlvarstatic);
1.88      raeburn  1974:               if (ref($sslref) eq 'HASH') {
                   1975:                   %sslstatus = %{$sslref};
                   1976:               }
                   1977:           } elsif ($choice2 eq '3') {
                   1978:               if (-e "$certsdir/$connectcsr") {
                   1979:                   &mail_csr('host',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   1980:               }
                   1981:           }
                   1982:       } elsif (($sslstatus{'host'} == 0) || ($sslstatus{'host'} == 4) || ($sslstatus{'host'} == 5)) {
                   1983:           my $sslkeypass;
                   1984:           if ($sslstatus{'key'} == 1) {
                   1985:               print(&lt;&lt;END);
                   1986: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   1987: 
                   1988: POSSIBLE CHOICES:
                   1989: 1) create new certificate signing request with new key
                   1990: 2) create new certificate signing request with existing key
                   1991: 3) make no change
                   1992: ENTER NEW VALUE
                   1993: END
                   1994:               my $choice2=&lt;&gt;;
                   1995:               chomp($choice2);
                   1996:               if ($choice2 eq '1') {
                   1997:                   $sslkeypass = &get_new_sslkeypass();
                   1998:                   &make_key($certsdir,$privkey,$sslkeypass);
                   1999:               } elsif ($choice2 eq '2') {
                   2000:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   2001:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   2002:               }
                   2003:           } else {
                   2004:               print(&lt;&lt;END);
                   2005: 16) SSL Certificate for LON-CAPA server connections: $lonhostcertstatus
                   2006: END
                   2007:               $sslkeypass = &get_new_sslkeypass();
                   2008:           }
                   2009:           &ssl_info();
                   2010:           my $country = &get_country($desiredhostname);
                   2011:           my $state = &get_state();
                   2012:           my $city = &get_city();
                   2013:           my $connectsubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=$perlvar{'lonHostID'}/OU=LONCAPA/emailAddress=$adminmail";
                   2014:           &make_host_csr($certsdir,$sslkeypass,$connectcsr,$connectsubj);
                   2015:           &mail_csr('host',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2016:           print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   2017:           ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
1.90      raeburn  2018:               &get_cert_status($perlvar{'lonHostID'},$desiredhostname,$perlvarstatic);
1.88      raeburn  2019:           if (ref($sslref) eq 'HASH') {
                   2020:               %sslstatus = %{$sslref};
                   2021:           }
                   2022:       }
1.85      raeburn  2023:   } elsif ($choice==17) {
1.88      raeburn  2024:       if (($sslstatus{'hostname'} == 1) || ($sslstatus{'hostname'} == 2) || ($sslstatus{'hostname'} == 3)) {
                   2025:           print(&lt;&lt;END);
1.85      raeburn  2026: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   2027: 
                   2028: POSSIBLE CHOICES:
                   2029: 1) create new certificate signing request with new key
                   2030: 2) create new certificate signing request with existing key
                   2031: 3) resend current certificate signing request
                   2032: 4) make no change
                   2033: ENTER NEW VALUE
                   2034: END
1.88      raeburn  2035:           my $choice2=&lt;&gt;;
                   2036:           chomp($choice2);
                   2037:           if (($choice2 eq '1') || ($choice2 eq '2')) {
                   2038:               &ssl_info();
                   2039:               my $country = &get_country($desiredhostname);
                   2040:               my $state = &get_state();
                   2041:               my $city = &get_city();
                   2042:               my $replicatesubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=internal-$desiredhostname/OU=LONCAPA/emailAddress=$adminmail";
                   2043:               my $sslkeypass;
                   2044:               if ($choice2 eq '1') {
                   2045:                   $sslkeypass = &get_new_sslkeypass();
                   2046:                   &make_key($certsdir,$privkey,$sslkeypass);
                   2047:               } elsif ($choice2 eq '2') {
                   2048:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   2049:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   2050:               }
                   2051:               &make_hostname_csr($certsdir,$sslkeypass,$replicatecsr,$replicatesubj);
                   2052:               &mail_csr('hostname',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2053:               print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   2054:               ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
1.90      raeburn  2055:                   &get_cert_status($perlvar{'lonHostID'},$desiredhostname,$perlvarstatic);
1.88      raeburn  2056:               if (ref($sslref) eq 'HASH') {
                   2057:                   %sslstatus = %{$sslref};
                   2058:               }
                   2059:           } elsif ($choice2 eq '3') {
                   2060:               if (-e "$certsdir/$replicatecsr") {
                   2061:                   &mail_csr('hostname',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2062:               }
                   2063:           }
                   2064:       } elsif (($sslstatus{'hostname'} == 0) || ($sslstatus{'hostname'} == 4) || ($sslstatus{'hostname'} == 5)) {
                   2065:           my $sslkeypass;
                   2066:           if ($sslstatus{'key'} == 1) {
                   2067:               print(&lt;&lt;END);
                   2068: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   2069: 
                   2070: POSSIBLE CHOICES:
                   2071: 1) create new certificate signing request with new key
                   2072: 2) create new certificate signing request with existing key
                   2073: 3) make no change
                   2074: ENTER NEW VALUE
                   2075: END
                   2076:               my $choice2=&lt;&gt;;
                   2077:               chomp($choice2);
                   2078:               if ($choice2 eq '1') {
                   2079:                   $sslkeypass = &get_new_sslkeypass();
                   2080:                   &make_key($certsdir,$privkey,$sslkeypass);
                   2081:               } elsif ($choice2 eq '2') {
                   2082:                   $sslkeypass = &get_password('Enter existing password for SSL key');
                   2083:                   &encrypt_key($certsdir,$privkey,$sslkeypass);
                   2084:               }
                   2085:           } else {
                   2086:               print(&lt;&lt;END);
                   2087: 17) SSL Certificate for Content Replication: $lonhostnamecertstatus
                   2088: END
                   2089:               $sslkeypass = &get_new_sslkeypass();
                   2090:           }
                   2091:           &ssl_info();
                   2092:           my $country = &get_country($desiredhostname);
                   2093:           my $state = &get_state();
                   2094:           my $city = &get_city();
                   2095:           my $replicatesubj = "/C=$country/ST=$state/O=$domainDescription/L=$city/CN=internal-$desiredhostname/OU=LONCAPA/emailAddress=$adminmail";
                   2096:           &make_hostname_csr($certsdir,$sslkeypass,$replicatecsr,$replicatesubj);
                   2097:           &mail_csr('hostname',$lonCluster,$perlvar{'lonHostID'},$desiredhostname,$certsdir,$connectcsr,$replicatecsr,$perlvarstatic);
                   2098:           print "\nRetrieving status information for SSL key and certificates ...\n\n";
                   2099:           ($certinfo,$lonkeystatus,$lonhostcertstatus,$lonhostnamecertstatus,$sslref) =
1.90      raeburn  2100:               &get_cert_status($perlvar{'lonHostID'},$desiredhostname,$perlvarstatic);
1.88      raeburn  2101:           if (ref($sslref) eq 'HASH') {
                   2102:               %sslstatus = %{$sslref};
                   2103:           }
                   2104:       }
1.85      raeburn  2105:   } elsif (($choice==18) && (!@error)) {
1.6       harris41 2106:     $flag=1;
1.85      raeburn  2107:   } else {
1.38      www      2108:     print "Invalid input.\n";
1.6       harris41 2109:   }
                   2110: }
1.84      raeburn  2111: 
1.7       harris41 2112:     open(OUT,"&gt;$confdir$filename") or
                   2113:       die("Cannot output to $confdir$filename\n");
                   2114:     foreach my $key (keys %perlvar) {
                   2115:       my $value=$perlvar{$key};
1.49      raeburn  2116:       my $line = "PerlSetVar     $key      $value";
                   2117:       if ($value eq '') {
                   2118:           $line = '#'.$line;
                   2119:       }
1.88      raeburn  2120:       print(OUT &lt;&lt;END) unless ($perlvarstatic-&gt;{$key});
1.49      raeburn  2121: $line
1.7       harris41 2122: END
                   2123:     }
                   2124:     close(OUT);
1.1       harris41 2125: </perlscript>
                   2126: </file>
                   2127: <file>
                   2128: <target dist='default'>loncom/hosts.tab</target>
                   2129: <perlscript mode='fg'>
                   2130: unless (-l "<TARGET />") {
1.84      raeburn  2131:   if ($desiredhostname eq '') { 
                   2132:       my $hostname=`hostname -f`;chomp($hostname);
                   2133:       $desiredhostname = $hostname;
                   2134:   }
1.82      raeburn  2135:   my $date=`date -I`; chomp($date);
                   2136:   my $lonHostID=$perlvar{'lonHostID'};
1.51      albertel 2137:   $lonHostID=~s/[^\w\-.]//g;
1.82      raeburn  2138:   my $lineexistflag=0;
                   2139:   my $hostidexistflag=0;
                   2140:   my $line2insert=&lt;&lt;END;
1.84      raeburn  2141: $perlvar{'lonHostID'}:$perlvar{'lonDefDomain'}:$perlvar{'lonRole'}:$desiredhostname:$protocol:$intdom
1.15      harris41 2142: END
1.57      albertel 2143:   if (!$domainTabExtras) {
                   2144: 	$domainTabExtras=':::::';
                   2145:   }
1.82      raeburn  2146:   my $domaininsert="$perlvar{'lonDefDomain'}:$domainDescription:$domainTabExtras:$primaryLibServer\n";
1.23      albertel 2147:   if ($lonCluster eq 'standalone') {
                   2148:     open(OUT,'&gt;../'.$lonCluster.'_hosts.tab') or
                   2149:       die('file generation error');
                   2150:       print(OUT $line2insert);
1.84      raeburn  2151:       print OUT ("^$desiredhostname:$protocol\n");
1.52      albertel 2152:     close(OUT);
                   2153:     open(OUT,'&gt;../'.$lonCluster.'_dns_hosts.tab') or
                   2154:       die('file generation error');
                   2155:       print(OUT $line2insert);
1.23      albertel 2156:     close(OUT);
1.27      albertel 2157:     open(OUT,'&gt;../'.$lonCluster.'_domain.tab') or
                   2158:       die('file generation error');
                   2159:       print(OUT $domaininsert);
                   2160:     close(OUT);
1.52      albertel 2161:     open(OUT,'&gt;../'.$lonCluster.'_dns_domain.tab') or
                   2162:       die('file generation error');
                   2163:       print(OUT $domaininsert);
                   2164:     close(OUT);
1.23      albertel 2165:   }
1.15      harris41 2166:   if ($flag==1) {
1.6       harris41 2167:     `rm -f ../hosts.tab`;
1.52      albertel 2168:     `rm -f ../dns_hosts.tab`;
                   2169:     `ln -s ${lonCluster}_dns_hosts.tab ../dns_hosts.tab`;
                   2170:     open(IN,'&lt;../'.$lonCluster.'_dns_hosts.tab');
                   2171:     while(my $line = &lt;IN&gt;) {
                   2172:       if ($line =~ /^\Q$line2insert\E$/) {
1.13      harris41 2173:         $lineexistflag=1;
                   2174:       }
1.52      albertel 2175:       if ($line =~ /^\Q$lonHostID\E\:/) {
1.13      harris41 2176:         $hostidexistflag=1;
                   2177:       }
                   2178:     }
                   2179:     close(IN);
                   2180:     if ($hostidexistflag and !$lineexistflag) {
                   2181:       print &lt;&lt;END;
                   2182: WARNING: $lonHostID already exists inside
1.52      albertel 2183: loncapa/loncom/${lonCluster}_dns_hosts.tab.  The entry inside
                   2184: ${lonCluster}_dns_hosts.tab does not match your settings.
                   2185: An entry inside ${lonCluster}_hosts.tab will be made
1.13      harris41 2186: with your new values.
                   2187: END
1.15      harris41 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");
1.14      harris41 2191:          print(OUT $line2insert);
1.13      harris41 2192:        close(OUT);
1.15      harris41 2193:       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
1.13      harris41 2194:       # email appropriate message
1.65      raeburn  2195:       `echo "REPLACE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "REPLACE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1.13      harris41 2196:     }
                   2197:     elsif ($hostidexistflag and $lineexistflag) {
1.15      harris41 2198:       print &lt;&lt;END;
1.52      albertel 2199: Entry exists in ${lonCluster}_dns_hosts.tab. Making duplicate entry in ${lonCluster}_hosts.tab
1.15      harris41 2200: END
1.52      albertel 2201:       `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
                   2202:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_hosts.tab') or
                   2203:          die("cannot open loncom/${lonCluster}_hosts.tab for output\n");
                   2204:          print(OUT $line2insert);
                   2205:        close(OUT);
                   2206:       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
1.15      harris41 2207:       # email appropriate message
1.65      raeburn  2208:       `echo "STABLEUPDATE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "STABLEUPDATE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1.13      harris41 2209:     }
1.15      harris41 2210:     elsif (!$hostidexistflag and !$lineexistflag) {
                   2211:       print &lt;&lt;END;
                   2212: New entry for $lonCluster.
1.6       harris41 2213: END
1.15      harris41 2214:       `cat ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
1.21      albertel 2215:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_hosts.tab') or
                   2216:          die("cannot open loncom/new_${lonCluster}_hosts.tab for output\n");
1.15      harris41 2217:          print(OUT $line2insert);
                   2218:        close(OUT);
                   2219:       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
                   2220:       # email appropriate message
1.65      raeburn  2221:       `echo "INSERT:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "INSERT:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1.27      albertel 2222:     }
                   2223:   }
                   2224:   $lineexistflag=0;
1.82      raeburn  2225:   my $domainexistflag=0;
1.27      albertel 2226:   if ($flag==1) {
                   2227:     `rm -f ../domain.tab`;
1.52      albertel 2228:     `rm -f ../dns_domain.tab`;
                   2229:     `ln -s ${lonCluster}_dns_domain.tab ../dns_domain.tab`;
                   2230:     open(IN,'&lt;../'.$lonCluster.'_dns_domain.tab');
                   2231:     while(my $line = &lt;IN&gt;) {
                   2232:       if ($line =~/^\Q$domaininsert\E$/) {
1.27      albertel 2233:         $lineexistflag=1;
                   2234:       }
1.52      albertel 2235:       if ($line =~/^\Q$perlvar{'lonDefDomain'}\E\:/) {
1.27      albertel 2236:         $domainexistflag=1;
                   2237:       }
                   2238:     }
                   2239:     close(IN);
                   2240:     if ($domainexistflag and !$lineexistflag) {
                   2241:       print &lt;&lt;END;
                   2242: WARNING: $perlvar{'lonDefDomain'} already exists inside
1.52      albertel 2243: loncapa/loncom/${lonCluster}_dns_domain.tab.  The entry inside
                   2244: ${lonCluster}_dns_domain.tab does not match your settings.
                   2245: An entry will be made in inside ${lonCluster}_domain.tab
1.27      albertel 2246: with your new values.
                   2247: END
                   2248:       `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
                   2249:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
                   2250:          die("cannot open loncom/${lonCluster}_domain.tab for output\n");
                   2251:          print(OUT $domaininsert);
                   2252:        close(OUT);
                   2253:       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
                   2254:       # email appropriate message
1.82      raeburn  2255:       `echo "REPLACEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "REPLACEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
1.27      albertel 2256:     }
                   2257:     elsif ($domainexistflag and $lineexistflag) {
1.52      albertel 2258:       `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
                   2259:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
                   2260:          die("cannot open loncom/${lonCluster}_domain.tab for output\n");
                   2261:          print(OUT $domaininsert);
                   2262:        close(OUT);
1.27      albertel 2263:       print &lt;&lt;END;
1.52      albertel 2264: Entry exists in ${lonCluster}_dns_domain.tab. Making duplicate entry in ${lonCluster}_domain.tab
1.27      albertel 2265: END
1.52      albertel 2266:       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
1.27      albertel 2267:       # email appropriate message
                   2268:       `echo "STABLEUPDATEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "STABLEUPDATEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
                   2269:     }
                   2270:     elsif (!$domainexistflag and !$lineexistflag) {
                   2271:       print &lt;&lt;END;
                   2272: New entry for $lonCluster.
                   2273: END
                   2274:       `cat ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
                   2275:        open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
                   2276:          die("cannot open loncom/new_${lonCluster}_domain.tab for output\n");
                   2277:          print(OUT $domaininsert);
                   2278:        close(OUT);
                   2279:       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
                   2280:       # email appropriate message
                   2281:       `echo "INSERTdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "INSERTdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
1.6       harris41 2282:     }
                   2283:   }
1.1       harris41 2284: }
                   2285: </perlscript>
                   2286: </file>
                   2287: </files>
                   2288: </piml>

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