Annotation of doc/loncapafiles/updatequery.piml, revision 1.98
1.2 harris41 1: <!-- updatequery.piml -->
1.1 harris41 2:
1.98 ! raeburn 3: <!-- $Id: updatequery.piml,v 1.97 2024/06/20 04:04:55 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.98 ! 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' || '<DIST />' eq 'debian10' || '<DIST />' eq 'debian11' || '<DIST />' eq 'debian12') {
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.98 ! 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' || '<DIST />' eq 'debian10' || '<DIST />' eq 'debian11' || '<DIST />' eq 'debian12') {
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.97 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 debian10 debian11 debian12 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