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

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

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