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