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