1: <!-- updatequery.piml -->
2:
3: <!-- $Id: updatequery.piml,v 1.86 2017/02/25 20:31:03 raeburn Exp $ -->
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>
33: <target dist='default'>/</target>
34: <perlscript mode='fg'>
35: $|=1;
36: use strict;
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;
46:
47: print(<<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
61: #sleep(3);
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,'<'.$confdir.$filename) or die("Can't read $confdir$filename");
73: while (my $configline=<CONFIG>) {
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 {
86: my ($dom,$primaryserver,$isprimary,$url,$perlvarref) = @_;
87: my %confhash;
88: if ($isprimary) {
89: if (ref($perlvarref) eq 'HASH') {
90: my $lonusersdir = $perlvarref->{'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 {
109: if (open(PIPE,"wget --no-check-certificate '$url?primary=$primaryserver&format=raw' |")) {
110: my $config = '';
111: while (<PIPE>) {
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 < $maxtries)) {
138: $firstpass = &get_password('Enter password');
139: if (length($firstpass) < 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) > 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($_)<32)||(ord($_)>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) < 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,"<$file")) {
200: while (<$fh>) {
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:
216: </perlscript>
217: </file>
218: <file>
219: <target dist='default'>../../loncom/hosts.tab</target>
220: <perlscript mode='fg'>
221: my $lonCluster;
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 = (
230: production => 'PRODUCTION',
231: standalone => 'STAND-ALONE',
232: development => 'DEVELOPMENT',
233: existing => 'RUNNING YOUR OWN CLUSTER',
234: );
235: if (($currCluster) && (exists($clustertypes{$currCluster}))) {
236: print(<<END);
237:
238: The cluster type for this server is currently: $clustertypes{$currCluster}
239: END
240:
241: }
242: }
243:
244: print(<<END);
245:
246: ===============================================================================
247:
248: Which cluster option would you like to have installed?
249: IMPORTANT: to take advantage of the cluster options 1) and 3),
250: you must contact loncapa\@loncapa.org.
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
255: are running - or in the future will run - courses.
256: 2) STAND-ALONE - you want this machine to run in 'stand-alone' mode and
257: not be connected to other LON-CAPA machines for now.
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.
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.)
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
272: my $flag=0;
273: while (!$flag) {
274: print "ENTER 1, 2, 3, or 4:\n";
275: my $choice=<>;
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;
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 <<END;
295: There is no existing /home/httpd/lonTabs/$file
296: END
297: die('');
298: }
299: }
300: }
301: elsif ($choice==26) {
302: $lonCluster='rawhide'; $flag=1;
303: }
304: }
305: </perlscript>
306: </file>
307: <file>
308: <target dist='default'>/home/httpd/lonTabs/hosts.tab</target>
309: <perlscript mode='fg'>
310: $|=1;
311: my $domainDescription;
312: my $domainTabExtras;
313: my $primaryLibServer;
314: my $protocol;
315: my $intdom;
316: my $desiredhostname;
317: my $city;
318: my $state;
319: my $country;
320: my @libservers = ();
321: unless (-e "<TARGET />") {
322: print(<<END);
323: WELCOME TO LON-CAPA!
324:
325: If you have questions, please visit http://install.loncapa.org
326: or contact helpdesk\@loncapa.org.
327:
328: ===============================================================================
329: The following 10 values are needed to configure LON-CAPA:
330: * Machine Role
331: * LON-CAPA Domain Name
332: * LON-CAPA Machine ID Name
333: * Server Administration E-mail Address
334: * LON-CAPA Domain's Primary Library Server Machine ID
335: * Web Server Protocol
336: * Internet Domain Name of Your Institution
337: * Hostname
338: * City, State, Country for LON-CAPA SSL certificate
339: * Password for key for creating SSL certificates
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:
347: END
348:
349: open(OUT,'>/tmp/loncapa_updatequery.out');
350: close(OUT);
351:
352: # query for Machine Role
353: print(<<END);
354: **** Machine Role ****
355: Library server (recommended if first-time installation of LON-CAPA):
356: Servers that are repositories of authoritative educational resources.
357: These servers also provide the authoring spaces in which content
358: creators (e.g., faculty instructors) create their learning content.
359: Access server:
360: Servers that load-balance high-traffic delivery of educational resources
361: over the world-wide web.
362: 1) Will this be a library server? (recommended if this is your first install)
363: 2) Or, will this be an access server?
364: END
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=<>;
371: chomp($choice);
372: if ($choice==1) {
373: open(OUT,'>>/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,'>>/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: }
392:
393: # need to recommend a machine ID name (ipdomain.l.somenumber)
394: my $hostname=`hostname -f`; chomp($hostname);
395: my $ipdomain='';
396: if ($hostname=~/([^\.]*)\.([^\.]*)$/) {
397: $ipdomain=$1;
398: }
399:
400: print(<<END);
401:
402: **** Domain ****
403: [This does NOT need to correspond to an internet address domain.
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)
408: or "michiganstateuniversity" (too long)
409: or "msuedu" (just make it "msu", or else make it msu.edu)
410: or "msuphysics" (only if there is a good reason to limit to department
411: - we don't know of one)
412: or "mydomain" (what is that?)
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
417: cluster, you MUST contact the LON-CAPA group at MSU (loncapa\@loncapa.org)
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.
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.]
423: END
424:
425: # get domain name
426: # accept if valid, if not valid, tell user and repeat
427: $flag=0;
428: my $lonDefDomain;
429: while (!$flag) {
430: if ($ipdomain) {
431: print(<<END);
432: ENTER LONCAPA DOMAIN [$ipdomain]:
433: END
434: }
435: else {
436: print(<<END);
437: ENTER LONCAPA DOMAIN:
438: END
439: }
440: my $choice=<>;
441: chomp($choice);
442: my $bad_domain_flag=0;
443: my @bad_domain_names=('res','raw','userfiles','priv','adm','uploaded',
444: 'editupload');
445: foreach my $bad (@bad_domain_names) {
446: $bad_domain_flag=1 if $choice eq $bad;
447: }
448: if ($choice=~/capa/i) {
449: $bad_domain_flag=1;
450: }
451: if ($ipdomain and $choice=~/^\s*$/) {
452: $choice=$ipdomain;
453: open(OUT,'>>/tmp/loncapa_updatequery.out');
454: print(OUT 'lonDefDomain'."\t".$choice."\n");
455: close(OUT);
456: $lonDefDomain=$choice;
457: $flag=1;
458: } elsif (length($choice)>35) {
459: print "Name too long\n";
460: } elsif (length($choice)<2) {
461: print "Name too short\n";
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";
465: } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
466: open(OUT,'>>/tmp/loncapa_updatequery.out');
467: print(OUT 'lonDefDomain'."\t".$choice."\n");
468: close(OUT);
469: $lonDefDomain=$choice;
470: $r='l';
471: $flag=1;
472: } else {
473: print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
474: }
475: }
476:
477: # get domain description
478: # accept if valid, if not valid, tell user and repeat
479: $flag=0;
480:
481: while (!$flag) {
482: print(<<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=<>;
491: chomp($choice);
492: if ($choice!~/:/) {
493: open(OUT,'>>/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:
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:
510: print(<<END);
511:
512: **** Machine ID Name ****
513: [This does NOT need to correspond to internet address names;
514: this name MUST be unique to the whole LON-CAPA network;
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".
518: Note that machine names are very hard to change later.]
519: END
520: # get machine name
521: # accept if valid, if not valid, tell user and repeat
522: $flag=0;
523: while (!$flag) {
524: if ($ipdomain) {
525: print(<<END);
526: ENTER LONCAPA MACHINE ID [$lonHostID]:
527: END
528: }
529: else {
530: print(<<END);
531: ENTER LONCAPA MACHINE ID:
532: END
533: }
534: my $choice=<>;
535: chomp($choice);
536: if ($choice=~/capa/i) {
537: print "Invalid input (names containing 'capa' are reserved).\n";
538: } elsif ($lonHostID and $choice=~/^\s*$/) {
539: $choice=$lonHostID;
540: open(OUT,'>>/tmp/loncapa_updatequery.out');
541: print(OUT 'lonHostID'."\t".$choice."\n");
542: close(OUT);
543: $lonHostID=$choice;
544: $flag=1;
545: } elsif (length($choice)>45) {
546: print "Name too long\n";
547: } elsif (length($choice)<4) {
548: print "Name too short\n";
549: } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
550: open(OUT,'>>/tmp/loncapa_updatequery.out');
551: print(OUT 'lonHostID'."\t".$choice."\n");
552: close(OUT);
553: $lonHostID=$choice;
554: $flag=1;
555: } else {
556: print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
557: }
558: }
559:
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: }
569:
570: $flag=0;
571: while (!$flag) {
572: print(<<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
578: specific home library server will be stored (e.g., configurations that
579: apply to all nodes in the domain).
580: END
581: if (defined($primaryLibServer)) {
582: print(<<END);
583: ENTER DOMAIN'S PRIMARY LIBRARY SERVER ID [$primaryLibServer]:
584: END
585: } elsif (@libservers > 0) {
586: print(<<END);
587: ENTER DOMAIN'S PRIMARY LIBRARY SERVER ID [$libservers[0]]
588: END
589: } else {
590: print (<<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=<>;
596: chomp($choice);
597: if ($primaryLibServer and $choice=~/^\s*$/) {
598: $choice=$primaryLibServer;
599: open(OUT,'>>/tmp/loncapa_updatequery.out');
600: print(OUT 'primaryLibServer'."\t".$choice."\n");
601: close(OUT);
602: $flag=1;
603: } elsif (length($choice)>35) {
604: print "Name too long\n";
605: } elsif (length($choice)<4) {
606: print "Name too short\n";
607: } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
608: open(OUT,'>>/tmp/loncapa_updatequery.out');
609: print(OUT 'primaryLibServer'."\t".$choice."\n");
610: close(OUT);
611: $primaryLibServer=$choice;
612: $flag=1;
613: } else {
614: print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
615: }
616: }
617:
618:
619: # get admin e-mail address
620: # accept if valid, if not valid, tell user and repeat
621: $flag=0;
622: my $lonAdmEMail;
623: while (!$flag) {
624: print(<<END);
625:
626: **** Server Administrator's E-mail ****
627: E-mail address of the person who will manage this machine
628: [should be in the form somebody\@somewhere]
629: ENTER ADMIN E-MAIL ADDRESS:
630: END
631:
632: my $choice=<>;
633: chomp($choice);
634: if ($choice=~/\@/) {
635: open(OUT,'>>/tmp/loncapa_updatequery.out');
636: print(OUT 'lonAdmEMail'."\t".$choice."\n");
637: close(OUT);
638: $lonAdmEMail=$choice;
639: $flag=1;
640: }
641: else {
642: print "Invalid input (this needs to look like an e-mail address!).\n";
643: }
644: }
645:
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(<<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=<>;
665: chomp($choice);
666: $choice =~ s/\s//g;
667: if ( ($choice=~/\@/) || $choice eq '') {
668: open(OUT,'>>/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:
679: # get protocol
680: # accept if valid, if not valid, tell user and repeat
681: $flag=0;
682: while (!$flag) {
683: print(<<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.
688: ENTER WEB SERVER PROTOCOL [http]:
689: END
690:
691: my $choice=<>;
692: chomp($choice);
693: if ($choice =~ /^https?$/) {
694: open(OUT,'>>/tmp/loncapa_updatequery.out');
695: print(OUT 'protocol'."\t".$choice."\n");
696: close(OUT);
697: $protocol=$choice;
698: $flag=1;
699: } elsif ($choice eq '') {
700: open(OUT,'>>/tmp/loncapa_updatequery.out');
701: print(OUT 'protocol'."\t".'http'."\n");
702: close(OUT);
703: $protocol = 'http';
704: $flag = 1;
705: } else {
706: print "Invalid input (only http or https allowed).\n";
707: }
708: }
709:
710: # get internet domain
711: # accept if valid, if not valid, tell user and repeat
712: $flag=0;
713: while (!$flag) {
714: print(<<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
720: topcollege.ac.uk or myhostingcompany.com, i.e., the part of
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=<>;
728: chomp($choice);
729: if ($choice =~/[^.]+\.[^.]+/) {
730: open(OUT,'>>/tmp/loncapa_updatequery.out');
731: print(OUT 'internet domain'."\t".$choice."\n");
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:
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(<<END);
754:
755: ****** Hostname of the server/VM *****
756:
757: The hostname of the server/VM is required. This will be similar to:
758: somename.ustate.edu or somename.department.ustate.edu, and would be
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=<>;
771: chomp($choice);
772: if (($choice =~ /^[A-Za-z0-9\-]+\.[A-Za-z0-9\-]+/) &&
773: ($choice =~ /^[A-Za-z0-9.\-]+$/)) {
774: open(OUT,'>>/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,'>>/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: }
789:
790: # get Country
791: print(<<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=<>;
830: chomp($choice);
831: if ($choice ne '') {
832: if (&Locale::Country::code2country(lc($choice))) {
833: open(OUT,'>>/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,'>>/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(<<END);
856:
857: ENTER STATE OR PROVINCE NAME:
858: END
859:
860: my $choice=<>;
861: chomp($choice);
862: if ($choice ne '') {
863: open(OUT,'>>/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(<<END);
878:
879: ENTER CITY NAME:
880: END
881:
882: my $choice=<>;
883: chomp($choice);
884: if ($choice ne '') {
885: open(OUT,'>>/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(<<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=<>;
912: chomp($choice);
913: if ($choice == 1) {
914: print(<<END);
915: 1) Domain Description: $domainDescription
916: ENTER NEW VALUE
917: END
918: my $choice2=<>;
919: chomp($choice2);
920: $domainDescription=$choice2;
921: }
922: elsif ($choice == 2) {
923: print(<<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=<>;
928: chomp($choice2);
929: $country = uc($choice2);
930: }
931: elsif ($choice == 3) {
932: print(<<END);
933: 3) State or Province: $state
934: ENTER NEW VALUE:
935: END
936: my $choice2=<>;
937: chomp($choice2);
938: $state=$choice2;
939: }
940: elsif ($choice == 4) {
941: print(<<END);
942: 4) City: $city
943: ENTER NEW VALUE:
944: END
945: my $choice2=<>;
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);
961: $certsdir = $perlvarref->{'lonCertificateDirectory'};
962: $privkey = $perlvarref->{'lonnetPrivateKey'};
963: $connectcsr = $perlvarref->{'lonnetCertificate'};
964: $connectcsr =~ s/\.pem$/.csr/;
965: $replicatecsr = $perlvarref->{'lonnetHostnameCertificate'};
966: $replicatecsr =~ s/\.pem$/.csr/;
967:
968: print(<<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>&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') {
1030: $camail = $perlvarref->l{'SSLEmail'};
1031: } else {
1032: $flag=0;
1033: # get Certificate Authority E-mail
1034: while (!$flag) {
1035: print(<<END);
1036:
1037: ENTER EMAIL ADDRESS TO SEND CERTIFICATE SIGNING REQUESTS
1038: END
1039:
1040: my $choice=<>;
1041: chomp($choice);
1042: if ($choice ne '') {
1043: open(OUT,'>>/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:
1066: # update loncapa.conf
1067: my $confdir = '/etc/httpd/conf/';
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') {
1069: $confdir = '/etc/apache2/';
1070: }
1071: my $filename='loncapa.conf';
1072: my %perlvar;
1073: if (-e "$confdir$filename") {
1074: open(CONFIG,'<'.$confdir.$filename) or die("Can't read $confdir$filename");
1075: while (my $configline=<CONFIG>) {
1076: if ($configline =~ /^[^\#]*PerlSetVar/) {
1077: my ($unused,$varname,$varvalue)=split(/\s+/,$configline);
1078: chomp($varvalue);
1079: $perlvar{$varname}=$varvalue if $varvalue!~/^\{\[\[\[\[/;
1080: }
1081: }
1082: close(CONFIG);
1083: }
1084: $perlvar{'lonHostID'}=$lonHostID;
1085: $perlvar{'lonDefDomain'}=$lonDefDomain;
1086: $perlvar{'lonAdmEMail'}=$lonAdmEMail;
1087: $perlvar{'lonSupportEMail'}=$lonSupportEMail;
1088: $perlvar{'lonRole'}=$lonRole;
1089: unless ($perlvar{'lonLoadLim'} and $perlvar{'lonLoadLim'}!~/\{\[\[\[\[/) {
1090: $perlvar{'lonLoadLim'}='2.00';
1091: }
1092: unless ($perlvar{'lonUserLoadLim'} and $perlvar{'lonUserLoadLim'}!~/\{\[\[\[\[/) {
1093: $perlvar{'lonUserLoadLim'}='0';
1094: }
1095: unless ($perlvar{'lonExpire'} and $perlvar{'lonExpire'}!~/\{\[\[\[\[/) {
1096: $perlvar{'lonExpire'}='86400';
1097: }
1098: unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
1099: my $lonReceipt='';
1100: srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
1101: my @alnum=(0..9,"a".."z");
1102: foreach my $i (1..20) {
1103: $lonReceipt.=$alnum[int(rand(36))];
1104: }
1105: $perlvar{'lonReceipt'}=$lonReceipt;
1106: }
1107: open(OUT,">$confdir$filename") or
1108: die("Cannot output to $confdir$filename\n");
1109: foreach my $key (keys %perlvar) {
1110: my $value=$perlvar{$key};
1111: my $line = "PerlSetVar $key $value";
1112: if ($value eq '') {
1113: $line = '#'.$line;
1114: }
1115: print(OUT <<END);
1116: $line
1117: END
1118: }
1119: close(OUT);
1120: }
1121: </perlscript>
1122: </file>
1123: <file>
1124: <target dist='default'>/etc/httpd/conf/</target>
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>
1126: <perlscript mode='fg'>
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: }
1142: # read values from loncapa.conf
1143: my $confdir = "<TARGET />";
1144: my $filename='loncapa.conf';
1145: my %perlvar;
1146: my ($securestatus,$securenum);
1147: if (-e "$confdir$filename") {
1148: open(CONFIG,'<'.$confdir.$filename) or
1149: die("Can't read $confdir$filename");
1150: while (my $configline=<CONFIG>) {
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: }
1159: unless ($perlvar{'lonLoadLim'} and $perlvar{'lonLoadLim'}!~/\{\[\[\[\[/) {
1160: $perlvar{'lonLoadLim'}='2.00';
1161: }
1162: unless ($perlvar{'lonUserLoadLim'} and $perlvar{'lonUserLoadLim'}!~/\{\[\[\[\[/) {
1163: $perlvar{'lonUserLoadLim'}='0';
1164: }
1165: unless ($perlvar{'lonExpire'} and $perlvar{'lonExpire'}!~/\{\[\[\[\[/) {
1166: $perlvar{'lonExpire'}='86400';
1167: }
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);
1175: unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
1176: my $lonReceipt='';
1177: srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
1178: my @alnum=(0..9,"a".."z");
1179: foreach my $i (1..20) {
1180: $lonReceipt.=$alnum[int(rand(36))];
1181: }
1182: $perlvar{'lonReceipt'}=$lonReceipt;
1183: }
1184: my %perlvarstatic;
1185: if (-e "${confdir}loncapa_apache.conf") {
1186: open(CONFIG,'<'.$confdir.'loncapa_apache.conf') or
1187: die("Can't read ${confdir}loncapa_apache.conf");
1188: while (my $configline=<CONFIG>) {
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: }
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:
1210: my @poss_hosts_files = @hosts_files;
1211: if (!$domainDescription) {
1212: foreach my $file (@domain_files) {
1213: open(IN,'<'.$file);
1214: while(my $line = <IN>) {
1215: if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
1216: (undef,$domainDescription,$domainTabExtras)=split(/:/,$line,3);
1217: chomp($domainDescription);
1218: chomp($domainTabExtras);
1219: # the remaining field (primary lib server) is handled later
1220: $domainTabExtras = join(':',(split(/:/,$domainTabExtras))[0..5]);
1221: last;
1222: }
1223: }
1224: close(IN);
1225: last if ($domainDescription);
1226: }
1227: }
1228:
1229: if ((!$protocol) || (!$desiredhostname)) {
1230: foreach my $file (@hosts_files) {
1231: open(IN,'<'.$file);
1232: while(my $line = <IN>) {
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: }
1241: last;
1242: }
1243: }
1244: }
1245: }
1246:
1247: if (!$protocol) {
1248: $protocol = 'http';
1249: }
1250:
1251: if (!$intdom) {
1252: foreach my $file (@hosts_files) {
1253: open(IN,'<'.$file);
1254: while(my $line = <IN>) {
1255: if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:[^:]+\:https?\:([^:]+)/) {
1256: $intdom = $1;
1257: chomp($intdom);
1258: last;
1259: }
1260: }
1261: }
1262: }
1263:
1264: my (%hostnames,%protocols);
1265: while(!$primaryLibServer && (@hosts_files || @domain_files)) {
1266: my $file = shift(@domain_files);
1267: open(IN,'<'.$file);
1268: while(my $line = <IN>) {
1269: if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
1270: $primaryLibServer=(split(/:/,$line))[8];
1271: chomp($primaryLibServer);
1272: }
1273: }
1274: close(IN);
1275: last if ($primaryLibServer);
1276: $file = shift(@hosts_files);
1277: open(IN,'<'.$file);
1278: while(my $line = <IN>) {
1279: if ($line =~ /^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:([^\:]+)/) {
1280: push(@libservers,$1);
1281: $hostnames{$1} = $2;
1282: }
1283: }
1284: # make list unique
1285: @libservers = keys(%{{ map { $_ => 1 } (@libservers) }});
1286: close(IN);
1287: if (@libservers == 1) {
1288: $primaryLibServer = $libservers[0];
1289: }
1290: }
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,'<'.$file);
1301: while (my $line = <IN>) {
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: }
1315:
1316: # implement editing logic below, interactively
1317: # update loncapa.conf until 17 is entered
1318:
1319: my $flag=0;
1320:
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: }
1336: my $domconf = &get_domain_config($perlvar{'lonDefDomain'},$primaryLibServer,$isprimary,
1337: $url,\%perlvarstatic);
1338: if (ref($domconf)) {
1339: $gotdomconf = 1;
1340: if (ref($domconf->{'contacts'}) eq 'HASH') {
1341: if (exists($domconf->{'contacts'}->{'adminemail'})) {
1342: $adminmail = $domconf->{'contacts'}->{'adminemail'};
1343: }
1344: if (exists($domconf->{'contacts'}->{'supportemail'})) {
1345: $supportmail = $domconf->{'contacts'}->{'supportemail'};
1346: }
1347: }
1348: if (ref($domconf->{'ssl'}) eq 'HASH') {
1349: foreach my $connect ('connto','connfrom') {
1350: if (ref($domconf->{'ssl'}->{$connect}) eq 'HASH') {
1351: my ($sslreq,$sslnoreq,$currsetting);
1352: my %contypes;
1353: foreach my $type ('dom','intdom','other') {
1354: my $key;
1355: if ($domconf->{'ssl'}->{'connect'}->{$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: }
1367: }
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/,$//;
1377: }
1378: if ($currsetting ne '') {
1379: $connectssl = $sslname{$connect}.' -- '.$currsetting.' | ';
1380: }
1381: }
1382: }
1383: $connectssl =~ s/\s\|\s$//;
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);
1405: my $currcerts = &LONCAPA::SSL::print_certstatus({$perlvar{'lonHostID'} => 1,},'text','cgi');
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 = (
1420: key => 'lonnetPrivateKey',
1421: host => 'lonnetCertificate',
1422: hostname => 'lonnetHostnameCertificate',
1423: ca => 'lonnetCertificateAuthority',
1424: );
1425: my %ssldesc = (
1426: key => 'Private Key',
1427: host => 'Connections Certificate',
1428: hostname => 'Replication Certificate',
1429: ca => 'LON-CAPA CA Certificate',
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>&1 |");
1466: while(<PIPE>) {
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:
1496: while (!$flag) {
1497: print(<<END);
1498:
1499: ===============================================================================
1500: This is now the current configuration of your machine.
1501: 1) Domain Name: $perlvar{'lonDefDomain'}
1502: 2) Domain Description: $domainDescription
1503: 3) Machine Name: $perlvar{'lonHostID'}
1504: 4) ID of primary library server for domain: $primaryLibServer
1505: 5) Server Administrator's E-mail Address: $adminmail
1506: 6) Support E-mail Address: $supportmail
1507: 7) Web Server Protocol (http or https): $protocol
1508: 8) Internet Domain Name: $intdom
1509: 9) Hostname: $desiredhostname
1510: 10) Role: $perlvar{'lonRole'}
1511: 11) Cache Expiration Time: $perlvar{'lonExpire'} (seconds)
1512: 12) Server Load: $perlvar{'lonLoadLim'}
1513: 13) User Load: $perlvar{'lonUserLoadLim'}
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
1519: END
1520:
1521: my @error;
1522: foreach my $v ($perlvar{'lonDefDomain'},$perlvar{'lonHostID'}) {
1523: if (length($v)>35) { push(@error,"Name $v too long"); }
1524: if (length($v)<2) { push(@error,"Name $v too short"); }
1525: if ($v=~/capa/i) {
1526: if ($v!~/^oucapa\d+$/ &&
1527: ($v!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
1528: push(@error,"Name $v contains 'capa'");
1529: }
1530: }
1531: foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
1532: 'editupload') {
1533: push(@error,"\nName $v reserved.") if $v eq $bad;
1534: }
1535: if ($v=~/[^\w\-.]/) { push(@error,"Name $v contains special characters"); }
1536: }
1537: if ($domainDescription =~ /^\s*$/) {
1538: push(@error,"Domain Description is blank.");
1539: } elsif ($domainDescription!~/^[\(\)\-\w\s,]+$/) {
1540: push(@error,"Domain Description contains special characters.");
1541: }
1542: foreach my $v ($perlvar{'lonExpire'},$perlvar{'lonLoadLim'}) {
1543: unless ($v=~/^[\d+\.]+$/) { push(@error,"Number expected instead of $v"); }
1544: }
1545: unless (($perlvar{'lonRole'} eq 'library') || ($perlvar{'lonRole'} eq 'access')) {
1546: push(@error,"Invalid Role");
1547: }
1548:
1549: unless (($protocol eq 'http') || ($protocol eq 'https')) {
1550: push(@error,"Invalid Protocol (must be http or https");
1551: }
1552:
1553: if (!defined($intdom)) {
1554: push(@error,"No internet domain name designated. Enter something like ustate.edu");
1555: } elsif ($intdom !~ /[^.]+\.\w{2,6}$/) {
1556: push(@error,"Invalid Internet domain name (must be at least two levels separated by . - e.g., ustate.edu");
1557: }
1558:
1559: if (!defined($primaryLibServer)) {
1560: if (@libservers > 0) {
1561: push(@error,"No primary library server ID designated. Choose from: ".join(',',sort(@libservers)));
1562: } else {
1563: push(@error,"No library servers in this domain (including current server)");
1564: }
1565: } else {
1566: if (length($primaryLibServer)>35) { push(@error,"Primary Library Server ID: $primaryLibServer too long"); }
1567: if (length($primaryLibServer)<2) { push(@error,"Primary Library Server ID: $primaryLibServer too short"); }
1568: if ($primaryLibServer =~/capa/i) {
1569: if ($primaryLibServer!~/^oucapa\d+$/ &&
1570: ($primaryLibServer!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
1571: push(@error,"Primary library server ID $primaryLibServer contains 'capa'")
1572: }
1573: }
1574: foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
1575: 'editupload') {
1576: push(@error,"Primary library server ID $primaryLibServer reserved.") if $primaryLibServer eq $bad;
1577: }
1578: if ($primaryLibServer=~/[^\w\-.]/) { push(@error,"Primary library server ID $primaryLibServer contains special characters"); }
1579: }
1580:
1581:
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:
1590: if (@error) { print "\n*** ERRORS: \n\t".join("\n\t",@error)."\n"; }
1591: print(<<END);
1592: ENTER A CHOICE OF 1-17 TO CHANGE, otherwise ENTER 18:
1593: END
1594: my $choice=<>;
1595: chomp($choice);
1596: if ($choice==1) {
1597: print(<<END);
1598: 1) Domain Name: $perlvar{'lonDefDomain'}
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):
1603: END
1604: my $choice2=<>;
1605: chomp($choice2);
1606: $perlvar{'lonDefDomain'}=$choice2;
1607: }
1608: elsif ($choice==2) {
1609: print(<<END);
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=<>;
1615: chomp($choice2);
1616: $domainDescription=$choice2;
1617: }
1618: elsif ($choice==3) {
1619: print(<<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') :
1625: END
1626: my $choice2=<>;
1627: chomp($choice2);
1628: $perlvar{'lonHostID'}=$choice2;
1629: }
1630: elsif ($choice==4) {
1631: print(<<END);
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=<>;
1641: chomp($choice2);
1642: $primaryLibServer=$choice2;
1643: }
1644: elsif ($choice==5) {
1645: if ($setbygui{'lonAdmEMail'}) {
1646: print(<<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(<<END);
1652: 5) Server Administrator's E-mail Address: $perlvar{'lonAdmEMail'}
1653: ENTER NEW VALUE:
1654: END
1655: my $choice2=<>;
1656: chomp($choice2);
1657: $perlvar{'lonAdmEMail'}=$choice2;
1658: }
1659: }
1660: elsif ($choice==6) {
1661: if ($setbygui{'lonAdmEMail'}) {
1662: print(<<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(<<END);
1668: 6) Support E-mail Address: $perlvar{'lonSupportEMail'}
1669: ENTER NEW VALUE:
1670: END
1671: my $choice2=<>;
1672: chomp($choice2);
1673: $perlvar{'lonSupportEMail'}=$choice2;
1674: }
1675: }
1676: elsif ($choice==7) {
1677: print(<<END);
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=<>;
1683: chomp($choice2);
1684: $protocol=$choice2;
1685: }
1686: elsif ($choice==8) {
1687: print(<<END);
1688: 8) Internet Domain Name of Institution
1689: ENTER NEW VALUE:
1690:
1691: END
1692: my $choice2=<>;
1693: chomp($choice2);
1694: $intdom=$choice2;
1695: }
1696: elsif ($choice==9) {
1697: print(<<END);
1698: 9) Hostname of Server/VM
1699: ENTER NEW VALUE:
1700:
1701: END
1702: my $choice2=<>;
1703: chomp($choice2);
1704: $desiredhostname=$choice2;
1705: }
1706:
1707: elsif ($choice==10) {
1708: print(<<END);
1709: 10) Role: $perlvar{'lonRole'}
1710: ENTER NEW VALUE (this should be either 'access' or 'library'
1711: if in doubt select 'library'):
1712: END
1713: my $choice2=<>;
1714: chomp($choice2);
1715: $perlvar{'lonRole'}=$choice2;
1716: }
1717: elsif ($choice==11) {
1718: print(<<END);
1719: 11) Cache Expiration Time: $perlvar{'lonExpire'}
1720: ENTER NEW VALUE (in seconds, 86400 is a reasonable value):
1721: END
1722: my $choice2=<>;
1723: chomp($choice2);
1724: $perlvar{'lonExpire'}=$choice2;
1725: }
1726: elsif ($choice==12) {
1727: print(<<END);
1728: 12) Server Load: $perlvar{'lonLoadLim'}
1729: ENTER NEW VALUE:
1730: END
1731: my $choice2=<>;
1732: chomp($choice2);
1733: $perlvar{'lonLoadLim'}=$choice2;
1734: }
1735: elsif ($choice==13) {
1736: print(<<END);
1737: 13) User Load: $perlvar{'lonUserLoadLim'}
1738: Numer of users that can login before machine is 'overloaded'
1739: ENTER NEW VALUE (integer value, 0 means there is no limit):
1740: END
1741: my $choice2=<>;
1742: chomp($choice2);
1743: $perlvar{'lonUserLoadLim'}=$choice2;
1744: }
1745: elsif ($choice==14) {
1746: if ($setbygui{'securestatus'}) {
1747: print(<<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(<<END);
1753: 14) Allow only secure connections: $securestatus
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
1765: ENTER NEW VALUE (currently $securenum):
1766: END
1767: my $choice2=<>;
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);
1779: }
1780: } elsif ($choice==15) {
1781: if (($sslstatus{'key'} == 1) || ($sslstatus{'key'} == 2)) {
1782: print(<<END);
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
1791: } elsif ($sslstatus{'key'} == ) {
1792: my $choice2=<>;
1793: chomp($choice2);
1794: } elsif ($choice==16) {
1795: if ($sslstatus{'key'} == 1) || ($sslstatus{'key'} == 2)) {
1796: #$sslstatus{'host'};
1797: print(<<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=<>;
1808: chomp($choice2);
1809: } elsif ($choice==17) {
1810: #$sslstatus{'hostname'}
1811: print(<<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=<>;
1822: chomp($choice2);
1823: } elsif (($choice==18) && (!@error)) {
1824: $flag=1;
1825: } else {
1826: print "Invalid input.\n";
1827: }
1828: }
1829:
1830: open(OUT,">$confdir$filename") or
1831: die("Cannot output to $confdir$filename\n");
1832: foreach my $key (keys %perlvar) {
1833: my $value=$perlvar{$key};
1834: my $line = "PerlSetVar $key $value";
1835: if ($value eq '') {
1836: $line = '#'.$line;
1837: }
1838: print(OUT <<END) unless $perlvarstatic{$key};
1839: $line
1840: END
1841: }
1842: close(OUT);
1843: </perlscript>
1844: </file>
1845: <file>
1846: <target dist='default'>loncom/hosts.tab</target>
1847: <perlscript mode='fg'>
1848: unless (-l "<TARGET />") {
1849: if ($desiredhostname eq '') {
1850: my $hostname=`hostname -f`;chomp($hostname);
1851: $desiredhostname = $hostname;
1852: }
1853: my $date=`date -I`; chomp($date);
1854: my $lonHostID=$perlvar{'lonHostID'};
1855: $lonHostID=~s/[^\w\-.]//g;
1856: my $lineexistflag=0;
1857: my $hostidexistflag=0;
1858: my $line2insert=<<END;
1859: $perlvar{'lonHostID'}:$perlvar{'lonDefDomain'}:$perlvar{'lonRole'}:$desiredhostname:$protocol:$intdom
1860: END
1861: if (!$domainTabExtras) {
1862: $domainTabExtras=':::::';
1863: }
1864: my $domaininsert="$perlvar{'lonDefDomain'}:$domainDescription:$domainTabExtras:$primaryLibServer\n";
1865: if ($lonCluster eq 'standalone') {
1866: open(OUT,'>../'.$lonCluster.'_hosts.tab') or
1867: die('file generation error');
1868: print(OUT $line2insert);
1869: print OUT ("^$desiredhostname:$protocol\n");
1870: close(OUT);
1871: open(OUT,'>../'.$lonCluster.'_dns_hosts.tab') or
1872: die('file generation error');
1873: print(OUT $line2insert);
1874: close(OUT);
1875: open(OUT,'>../'.$lonCluster.'_domain.tab') or
1876: die('file generation error');
1877: print(OUT $domaininsert);
1878: close(OUT);
1879: open(OUT,'>../'.$lonCluster.'_dns_domain.tab') or
1880: die('file generation error');
1881: print(OUT $domaininsert);
1882: close(OUT);
1883: }
1884: if ($flag==1) {
1885: `rm -f ../hosts.tab`;
1886: `rm -f ../dns_hosts.tab`;
1887: `ln -s ${lonCluster}_dns_hosts.tab ../dns_hosts.tab`;
1888: open(IN,'<../'.$lonCluster.'_dns_hosts.tab');
1889: while(my $line = <IN>) {
1890: if ($line =~ /^\Q$line2insert\E$/) {
1891: $lineexistflag=1;
1892: }
1893: if ($line =~ /^\Q$lonHostID\E\:/) {
1894: $hostidexistflag=1;
1895: }
1896: }
1897: close(IN);
1898: if ($hostidexistflag and !$lineexistflag) {
1899: print <<END;
1900: WARNING: $lonHostID already exists inside
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
1904: with your new values.
1905: END
1906: `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab > ../new_${lonCluster}_hosts.tab`;
1907: open(OUT,'>>../new_'.$lonCluster.'_hosts.tab') or
1908: die("cannot open loncom/${lonCluster}_hosts.tab for output\n");
1909: print(OUT $line2insert);
1910: close(OUT);
1911: `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
1912: # email appropriate message
1913: `echo "REPLACE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "REPLACE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1914: }
1915: elsif ($hostidexistflag and $lineexistflag) {
1916: print <<END;
1917: Entry exists in ${lonCluster}_dns_hosts.tab. Making duplicate entry in ${lonCluster}_hosts.tab
1918: END
1919: `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab > ../new_${lonCluster}_hosts.tab`;
1920: open(OUT,'>>../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`;
1925: # email appropriate message
1926: `echo "STABLEUPDATE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "STABLEUPDATE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1927: }
1928: elsif (!$hostidexistflag and !$lineexistflag) {
1929: print <<END;
1930: New entry for $lonCluster.
1931: END
1932: `cat ../${lonCluster}_hosts.tab > ../new_${lonCluster}_hosts.tab`;
1933: open(OUT,'>>../new_'.$lonCluster.'_hosts.tab') or
1934: die("cannot open loncom/new_${lonCluster}_hosts.tab for output\n");
1935: print(OUT $line2insert);
1936: close(OUT);
1937: `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
1938: # email appropriate message
1939: `echo "INSERT:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "INSERT:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
1940: }
1941: }
1942: $lineexistflag=0;
1943: my $domainexistflag=0;
1944: if ($flag==1) {
1945: `rm -f ../domain.tab`;
1946: `rm -f ../dns_domain.tab`;
1947: `ln -s ${lonCluster}_dns_domain.tab ../dns_domain.tab`;
1948: open(IN,'<../'.$lonCluster.'_dns_domain.tab');
1949: while(my $line = <IN>) {
1950: if ($line =~/^\Q$domaininsert\E$/) {
1951: $lineexistflag=1;
1952: }
1953: if ($line =~/^\Q$perlvar{'lonDefDomain'}\E\:/) {
1954: $domainexistflag=1;
1955: }
1956: }
1957: close(IN);
1958: if ($domainexistflag and !$lineexistflag) {
1959: print <<END;
1960: WARNING: $perlvar{'lonDefDomain'} already exists inside
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
1964: with your new values.
1965: END
1966: `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab > ../new_${lonCluster}_domain.tab`;
1967: open(OUT,'>>../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
1973: `echo "REPLACEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "REPLACEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
1974: }
1975: elsif ($domainexistflag and $lineexistflag) {
1976: `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab > ../new_${lonCluster}_domain.tab`;
1977: open(OUT,'>>../new_'.$lonCluster.'_domain.tab') or
1978: die("cannot open loncom/${lonCluster}_domain.tab for output\n");
1979: print(OUT $domaininsert);
1980: close(OUT);
1981: print <<END;
1982: Entry exists in ${lonCluster}_dns_domain.tab. Making duplicate entry in ${lonCluster}_domain.tab
1983: END
1984: `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
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 <<END;
1990: New entry for $lonCluster.
1991: END
1992: `cat ../${lonCluster}_domain.tab > ../new_${lonCluster}_domain.tab`;
1993: open(OUT,'>>../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`;
2000: }
2001: }
2002: }
2003: </perlscript>
2004: </file>
2005: </files>
2006: </piml>
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to updatequery.piml CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / doc / loncapafiles