Diff for /doc/loncapafiles/updatequery.piml between versions 1.45 and 1.82

version 1.45, 2006/01/07 14:29:16 version 1.82, 2016/07/29 16:44:36
Line 33  http://www.lon-capa.org/ Line 33  http://www.lon-capa.org/
 <target dist='default'>/</target>  <target dist='default'>/</target>
 <perlscript mode='fg'>  <perlscript mode='fg'>
 $|=1;  $|=1;
     use strict;
   print(&lt;&lt;END);    print(&lt;&lt;END);
   
   
Line 47  $|=1; Line 48  $|=1;
 *********************************************  *********************************************
   
 END  END
 sleep(3);  #sleep(3);
 </perlscript>  </perlscript>
 </file>  </file>
 <file>  <file>
 <target dist='default'>loncom/hosts.tab</target>  <target dist='default'>loncom/hosts.tab</target>
 <perlscript mode='fg'>  <perlscript mode='fg'>
   my $lonCluster;
 unless (-l "<TARGET />") {  unless (-l "<TARGET />") {
   print(&lt;&lt;END);    print(&lt;&lt;END);
   
Line 81  END Line 83  END
   
 # get input  # get input
 # if valid then process, otherwise loop  # if valid then process, otherwise loop
 $flag=0;  my $flag=0;
 while (!$flag) {  while (!$flag) {
   print "ENTER 1, 2, 3, or 4:\n";    print "ENTER 1, 2, 3, or 4:\n";
   my $choice=&lt;&gt;;    my $choice=&lt;&gt;;
Line 97  while (!$flag) { Line 99  while (!$flag) {
   }    }
   elsif ($choice==4) {    elsif ($choice==4) {
     $lonCluster='existing'; $flag=1;      $lonCluster='existing'; $flag=1;
     if (-e '/home/httpd/lonTabs/hosts.tab') {      foreach my $file ('hosts.tab','dns_hosts.tab',
       `cp /home/httpd/lonTabs/hosts.tab ../existing_hosts.tab`;                        'domain.tab','dns_domain.tab') {
     }          if (-e '/home/httpd/lonTabs/'.$file) {
     else {      `cp /home/httpd/lonTabs/$file ../existing_$file`;
       print &lt;&lt;END;          }
 There is no existing /home/httpd/lonTabs/hosts.tab          else {
 END      print &lt;&lt;END;
       die('');  There is no existing /home/httpd/lonTabs/$file
     }  
     if (-e '/home/httpd/lonTabs/domain.tab') {  
       `cp /home/httpd/lonTabs/domain.tab ../existing_domain.tab`;  
     }  
     else {  
       print &lt;&lt;END;  
 There is no existing /home/httpd/lonTabs/domain.tab  
 END  END
       die('');              die('');
           }
     }      }
   }    }
   elsif ($choice==26) {    elsif ($choice==26) {
Line 130  $|=1; Line 126  $|=1;
 my $domainDescription;  my $domainDescription;
 my $domainTabExtras;  my $domainTabExtras;
 my $primaryLibServer;  my $primaryLibServer;
   my $protocol;
   my $intdom;
 my @libservers = ();  my @libservers = ();
 unless (-e "<TARGET />") {  unless (-e "<TARGET />") {
   print(&lt;&lt;END);    print(&lt;&lt;END);
Line 139  If you have questions, please visit http Line 137  If you have questions, please visit http
 or contact helpdesk\@lon-capa.org.  or contact helpdesk\@lon-capa.org.
   
 ===============================================================================  ===============================================================================
 The following 4 values are needed to configure LON-CAPA:  The following 7 values are needed to configure LON-CAPA:
 * Machine Role  * Machine Role
 * LON-CAPA Domain Name  * LON-CAPA Domain Name
 * LON-CAPA Machine ID Name, and  * LON-CAPA Machine ID Name
 * System Administration E-mail Address.  * Server Administration E-mail Address
   * LON-CAPA Domain's Primary Library Server Machine ID
   * Web Server Protocol
   * Internet Domain Name of Your Institution
 ===============================================================================  ===============================================================================
   
 In addition, a Support E-mail Address can also be included. If  In addition, a Support E-mail Address can also be included. If
Line 221  if ($hostname=~/([^\.]*)\.([^\.]*)$/) { Line 222  if ($hostname=~/([^\.]*)\.([^\.]*)$/) {
  have to actually work together with your colleagues. You can still run   have to actually work together with your colleagues. You can still run
  multiple library servers within the same domain.   multiple library servers within the same domain.
  If this domain is eventually going to be part of the main production   If this domain is eventually going to be part of the main production
  cluster, you MUST contact the LON-CAPA group at MSU (loncapa@loncapa.org)   cluster, you MUST contact the LON-CAPA group at MSU (loncapa\@loncapa.org)
  to have a domain name assigned, and then use it exactly as given. This is   to have a domain name assigned, and then use it exactly as given. This is
  also true for test installs that might eventually turn into production setups.   also true for test installs that might eventually turn into production setups.
  Stop now if you didn't do so.]   Stop now if you didn't do so.]
Line 260  END Line 261  END
     close(OUT);      close(OUT);
     $lonDefDomain=$choice;      $lonDefDomain=$choice;
     $flag=1;      $flag=1;
   } elsif (length($choice)>12) {    } elsif (length($choice)>35) {
     print "Name too long\n";      print "Name too long\n";
   } elsif (length($choice)<2) {    } elsif (length($choice)<2) {
     print "Name too short\n";      print "Name too short\n";
   } elsif ($bad_domain_flag) {    } elsif ($bad_domain_flag) {
     print "Invalid input ('$choice' conflicts with LON-CAPA namespace).\n";      print "Invalid input ('$choice' conflicts with LON-CAPA namespace).\n";
     print "Please try something different than '$choice'\n";      print "Please try something different than '$choice'\n";
   } elsif ($choice!~/\_/ and $choice=~/^\w+$/) {    } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');      open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
     print(OUT 'lonDefDomain'."\t".$choice."\n");      print(OUT 'lonDefDomain'."\t".$choice."\n");
     close(OUT);      close(OUT);
Line 275  END Line 276  END
     $r='l';      $r='l';
     $flag=1;      $flag=1;
   } else {    } else {
     print "Invalid input (only alphanumeric characters supported).\n";      print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
   }    }
 }  }
   
Line 348  END Line 349  END
     close(OUT);      close(OUT);
     $lonHostID=$choice;      $lonHostID=$choice;
     $flag=1;      $flag=1;
   } elsif (length($choice)>15) {    } elsif (length($choice)>45) {
     print "Name too long\n";      print "Name too long\n";
   } elsif (length($choice)<4) {    } elsif (length($choice)<4) {
     print "Name too short\n";      print "Name too short\n";
   } elsif ($choice!~/\_/ and $choice=~/^\w+$/) {    } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
     open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');      open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
     print(OUT 'lonHostID'."\t".$choice."\n");      print(OUT 'lonHostID'."\t".$choice."\n");
     close(OUT);      close(OUT);
     $lonHostID=$choice;      $lonHostID=$choice;
     $flag=1;      $flag=1;
   } else {    } else {
     print "Invalid input (only alphanumeric characters supported).\n";      print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
   }    }
 }  }
   
Line 372  if ($lonRole eq 'library') { Line 373  if ($lonRole eq 'library') {
         $primaryLibServer = $libservers[0];          $primaryLibServer = $libservers[0];
     }      }
 }  }
   
   $flag=0;
 while (!$flag) {  while (!$flag) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 **** Domain's Primary Library Server ID ****  **** Domain's Primary Library Server ID ****
Line 404  END Line 407  END
         print(OUT 'primaryLibServer'."\t".$choice."\n");          print(OUT 'primaryLibServer'."\t".$choice."\n");
         close(OUT);          close(OUT);
         $flag=1;          $flag=1;
     } elsif (length($choice)>15) {      } elsif (length($choice)>35) {
         print "Name too long\n";          print "Name too long\n";
     } elsif (length($choice)<4) {      } elsif (length($choice)<4) {
         print "Name too short\n";          print "Name too short\n";
     } elsif ($choice!~/\_/ and $choice=~/^\w+$/) {      } elsif ($choice!~/\_/ and $choice=~/^[\w\-.]+$/) {
         open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');          open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
         print(OUT 'primaryLibServer'."\t".$choice."\n");          print(OUT 'primaryLibServer'."\t".$choice."\n");
         close(OUT);          close(OUT);
         $primaryLibServer=$choice;          $primaryLibServer=$choice;
         $flag=1;          $flag=1;
     } else {      } else {
         print "Invalid input (only alphanumeric characters supported).\n";          print "Invalid input (only alphanumeric characters, '-', and '.' supported).\n";
     }      }
 }  }
   
Line 427  my $lonAdmEMail; Line 430  my $lonAdmEMail;
 while (!$flag) {  while (!$flag) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
   
 **** System Administrator's E-mail ****  **** Server Administrators E-mail ****
 E-mail address of the person who will manage this machine  E-mail address of the person who will manage this machine
 [should be in the form somebody\@somewhere]  [should be in the form somebody\@somewhere]
 ENTER ADMIN E-MAIL ADDRESS:  ENTER ADMIN E-MAIL ADDRESS:
Line 480  END Line 483  END
   }    }
 }  }
   
   # get protocol
   # accept if valid, if not valid, tell user and repeat
   $flag=0;
   while (!$flag) {
     print(&lt;&lt;END);
   
   ****  Web Server Protocol ****
   If you plan to run the Apache server with SSL enabled, 
   the protocol should be: https; otherwise it should be http.
   ENTER WEB SERVER PROTOCOL [http]:
   END
   
     my $choice=&lt;&gt;;
     chomp($choice);
     if ($choice =~ /^https?$/) {
       open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
       print(OUT 'protocol'."\t".$choice."\n");
       close(OUT);
       $protocol=$choice;
       $flag=1;
     } elsif ($choice eq '') {
       open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
       print(OUT 'protocol'."\t".'http'."\n");
       close(OUT);
       $protocol = 'http';
       $flag = 1;
     } else {
       print "Invalid input (only http or https allowed).\n";
     }
   }
   
   # get internet domain
   # accept if valid, if not valid, tell user and repeat
   $flag=0;
   while (!$flag) {
     print(&lt;&lt;END);
   
   ****  Internet Domain Name of Your Institution ****
   
   The internet domain name used for servers at your institution 
   should be provided.  This will be similar to: ustate.edu or
   topcollege.ac.uk or my.hostingcompany.com, i.e., the part of
   a server hostname which indicates to which organization the 
   server belongs.
   
   ENTER INTERNET DOMAIN NAME:
   END
   
     my $choice=&lt;&gt;;
     chomp($choice);
     if ($choice =~/[^.]+\.[^.]+/) {
       open(OUT,'&gt;&gt;/tmp/loncapa_updatequery.out');
       print(OUT 'internet domain'."\t".$choice."\n");
       close(OUT);
       $intdom=$choice;
       $flag=1;
     }
     else {
       print "Invalid input (must be at least two levels separated by .  - e.g., ustate.edu).\n";
     }
   }
   
   
 # update loncapa.conf  # update loncapa.conf
 my $confdir='/etc/httpd/conf/';  my $confdir = '/etc/httpd/conf/';
 #my $confdir='';  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') {
        $confdir = '/etc/apache2/';
   }   
 my $filename='loncapa.conf';  my $filename='loncapa.conf';
 my %perlvar;  my %perlvar;
     if (-e "$confdir$filename") {      if (-e "$confdir$filename") {
Line 514  my %perlvar; Line 581  my %perlvar;
     unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {      unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
        my $lonReceipt='';         my $lonReceipt='';
        srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);         srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
        my @alnum=(0..9,a..z);         my @alnum=(0..9,"a".."z");
        foreach my $i (1..20) {         foreach my $i (1..20) {
  $lonReceipt.=$alnum[int(rand(36))];   $lonReceipt.=$alnum[int(rand(36))];
        }         }
Line 524  my %perlvar; Line 591  my %perlvar;
       die("Cannot output to $confdir$filename\n");        die("Cannot output to $confdir$filename\n");
     foreach my $key (keys %perlvar) {      foreach my $key (keys %perlvar) {
       my $value=$perlvar{$key};        my $value=$perlvar{$key};
         my $line = "PerlSetVar     $key      $value"; 
         if ($value eq '') {
             $line = '#'.$line;
         }
       print(OUT &lt;&lt;END);        print(OUT &lt;&lt;END);
 PerlSetVar     $key      $value  $line
 END  END
     }      }
     close(OUT);      close(OUT);
Line 533  END Line 604  END
 </perlscript>  </perlscript>
 </file>  </file>
 <file>  <file>
 <target dist='default'>/</target>  <target dist='default'>/etc/httpd/conf/</target>
   <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>
 <perlscript mode='fg'>  <perlscript mode='fg'>
 sub securesetting {  sub securesetting {
     my (%perlvar)=@_;      my (%perlvar)=@_;
Line 551  sub securesetting { Line 623  sub securesetting {
     return ($securestatus,$securenum);      return ($securestatus,$securenum);
 }  }
 # read values from loncapa.conf  # read values from loncapa.conf
 my $confdir='/etc/httpd/conf/';  my $confdir = "<TARGET />";
 my $filename='loncapa.conf';  my $filename='loncapa.conf';
 my %perlvar;  my %perlvar;
 my ($securestatus,$securenum);  my ($securestatus,$securenum);
Line 586  my ($securestatus,$securenum); Line 658  my ($securestatus,$securenum);
     unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {      unless ($perlvar{'lonReceipt'} and $perlvar{'lonReceipt'}!~/\{\[\[\[\[/) {
        my $lonReceipt='';         my $lonReceipt='';
        srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);         srand(time ^ $$ ^ unpack "%L*", `ps axww | gzip`);
        my @alnum=(0..9,a..z);         my @alnum=(0..9,"a".."z");
        foreach my $i (1..20) {         foreach my $i (1..20) {
  $lonReceipt.=$alnum[int(rand(36))];   $lonReceipt.=$alnum[int(rand(36))];
        }         }
Line 605  my %perlvarstatic; Line 677  my %perlvarstatic;
  }   }
  close(CONFIG);   close(CONFIG);
     }      }
     if (!$domainDescription && $lonCluster ne 'existing') {  
        open(IN,'&lt;../'.$lonCluster.'_domain.tab');      my (@hosts_files, @domain_files);
        while(&lt;IN&gt;) {      if ( $lonCluster ne 'existing') {
           if (/^$perlvar{'lonDefDomain'}\:/) {   push(@domain_files,'../'.$lonCluster.'_domain.tab',
      (undef,$domainDescription,$domainTabExtras)=split(/:/,$_,3);       '../'.$lonCluster.'_dns_domain.tab');
      chomp($domainDescription);   push(@hosts_files,'../'.$lonCluster.'_hosts.tab',
      chomp($domainTabExtras);       '../'.$lonCluster.'_dns_hosts.tab');
              last;      }
           }      push(@domain_files,'/home/httpd/lonTabs/domain.tab',
        }           '/home/httpd/lonTabs/dns_domain.tab');
        close(IN);      push(@hosts_files,'/home/httpd/lonTabs/hosts.tab',
     }           '/home/httpd/lonTabs/dns_hosts.tab');
   
     if (!$domainDescription) {      if (!$domainDescription) {
        open(IN,'&lt;/home/httpd/lonTabs/domain.tab');   foreach my $file (@domain_files) {
        while(&lt;IN&gt;) {      open(IN,'&lt;'.$file);
           if (/^$perlvar{'lonDefDomain'}\:/) {      while(my $line = &lt;IN&gt;) {
      (undef,$domainDescription,$domainTabExtras)=split(/:/,$_,3);   if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
      chomp($domainDescription);      (undef,$domainDescription,$domainTabExtras)=split(/:/,$line,3);
      chomp($domainTabExtras);      chomp($domainDescription);
              last;      chomp($domainTabExtras);
           }      # the remaining field (primary lib server) is handled later
        }      $domainTabExtras = join(':',(split(/:/,$domainTabExtras))[0..5]);
        close(IN);      last;
    }
       }
       close(IN);
       last if ($domainDescription);
    }
     }      }
     if (!$primaryLibServer and $lonCluster ne 'existing') {  
         open(IN,'&lt;../'.$lonCluster.'_domain.tab');      if (!$protocol) {
         while(&lt;IN&gt;) {          foreach my $file (@hosts_files) {
             if (/^$perlvar{'lonDefDomain'}\:/) {              open(IN,'&lt;'.$file);
                 (undef,undef,undef,undef,undef,undef,undef,undef,              while(my $line = &lt;IN&gt;) {
                                               $primaryLibServer)=split(/:/,$_);                  if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:[^:]+\:(https?)/) {
                 chomp($primaryLibServer);                      $protocol = $1;
                       chomp($protocol);
                       last;
                   }
             }              }
         }          }
         close(IN);      }
         if (!$primaryLibServer) {  
             open(IN,'&lt;../'.$lonCluster.'_hosts.tab');      if (!$protocol) {
             while(&lt;IN&gt;) {          $protocol = 'http';
                 if (/^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:/) {      }
                     push(@libservers,$1);  
       if (!$intdom) {
           foreach my $file (@hosts_files) {
               open(IN,'&lt;'.$file);
               while(my $line = &lt;IN&gt;) {
                   if ($line =~ /^\Q$perlvar{'lonHostID'}\E:\Q$perlvar{'lonDefDomain'}\E\:(?:access|library)\:[^:]+\:https?\:([^:]+)/) {
                       $intdom = $1;
                       chomp($intdom);
                       last;
                 }                  }
             }              }
             close(IN);  
             if (@libservers == 1) {  
                 $primaryLibServer = $libservers[0];  
             }  
         }          }
     }      }
     if (!$primaryLibServer) {  
         open(IN,'&lt;/home/httpd/lonTabs/domain.tab');      while(!$primaryLibServer && (@hosts_files || @domain_files)) {
         while(&lt;IN&gt;) {   my $file = shift(@domain_files);
             if (/^$perlvar{'lonDefDomain'}\:/) {          open(IN,'&lt;'.$file);
                 (undef,undef,undef,undef,undef,undef,undef,undef,          while(my $line = &lt;IN&gt;) {
                                               $primaryLibServer)=split(/:/,$_);              if ($line =~ /^\Q$perlvar{'lonDefDomain'}\E\:/) {
    $primaryLibServer=(split(/:/,$line))[8];
                 chomp($primaryLibServer);                  chomp($primaryLibServer);
             }              }
             close(IN);  
         }  
         if (!$primaryLibServer) {  
             open(IN,'&lt;/home/httpd/lonTabs/hosts.tab');  
             while(&lt;IN&gt;) {  
                 if (/^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:/) {  
                     push(@libservers,$1);  
                 }  
             }  
             close(IN);  
             if (@libservers == 1) {  
                 $primaryLibServer = $libservers[0];  
             }  
         }          }
           close(IN);
    last if ($primaryLibServer);
    $file = shift(@hosts_files);
    open(IN,'&lt;'.$file);
    while(my $line = &lt;IN&gt;) {
       if ($line =~ /^([^\:]+)\:\Q$perlvar{'lonDefDomain'}\E\:library\:/) {
    push(@libservers,$1);
       }
    }
    # make list unique
    @libservers = keys(%{{ map { $_ => 1 } (@libservers) }});
    close(IN);
    if (@libservers == 1) {
       $primaryLibServer = $libservers[0];
    }
     }      }
         
 # implement editing logic below, interactively  # implement editing logic below, interactively
 # update loncapa.conf until 8 is entered  # update loncapa.conf until 14 is entered
   
 $flag=0;  my $flag=0;
   
 while (!$flag) {  while (!$flag) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
Line 690  This is now the current configuration of Line 778  This is now the current configuration of
  2) Domain Description: $domainDescription   2) Domain Description: $domainDescription
  3) Machine Name: $perlvar{'lonHostID'}   3) Machine Name: $perlvar{'lonHostID'}
  4) ID of primary library server for domain: $primaryLibServer   4) ID of primary library server for domain: $primaryLibServer
  5) System Administrator's E-mail Address: $perlvar{'lonAdmEMail'}   5) Server Administrator's E-mail Address: $perlvar{'lonAdmEMail'}
  6) Support E-mail Address: $perlvar{'lonSupportEMail'}   6) Support E-mail Address: $perlvar{'lonSupportEMail'}
  7) Role: $perlvar{'lonRole'}   7) Web Server Protocol (http or https): $protocol 
  8) Cache Expiration Time: $perlvar{'lonExpire'}   8) Internet Domain Name: $intdom 
  9) Server Load: $perlvar{'lonLoadLim'}   9) Role: $perlvar{'lonRole'}
 10) User Load: $perlvar{'lonUserLoadLim'}  10) Cache Expiration Time: $perlvar{'lonExpire'}
 11) Allow only secure connections: $securestatus   11) Server Load: $perlvar{'lonLoadLim'}
 12) Everything is correct up above  12) User Load: $perlvar{'lonUserLoadLim'}
   13) Allow only secure connections: $securestatus 
   14) Everything is correct up above
 END  END
   
 my $error='';  my @error;
 foreach my $v ($perlvar{'lonDefDomain'},$perlvar{'lonHostID'}) {  foreach my $v ($perlvar{'lonDefDomain'},$perlvar{'lonHostID'}) {
    if (length($v)>16) { $error.="\nName $v too long"; }     if (length($v)>35) { push(@error,"Name $v too long"); }
    if (length($v)<2) { $error.="\nName $v too short"; }     if (length($v)<2) { push(@error,"Name $v too short"); }
    if ($v=~/capa/i) {     if ($v=~/capa/i) {
  if ($v!~/^oucapa\d+$/ &&    if ($v!~/^oucapa\d+$/ && 
     ($v!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {      ($v!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
  $error.="\nName $v contains 'capa'";    push(@error,"Name $v contains 'capa'");
  }   }
    }     }
    foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',     foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
  'editupload') {   'editupload') {
       $error.="\nName $v reserved." if $v eq $bad;        push(@error,"\nName $v reserved.") if $v eq $bad;
    }     }
    if ($v=~/\W/) { $error.="\nName $v contains special characters"; }     if ($v=~/[^\w\-.]/) { push(@error,"Name $v contains special characters"); }
 }  }
 if ($domainDescription!~/^[\(\)\-\w\s,]+$/) {  if ($domainDescription =~ /^\s*$/) {
    $error.="\nDomain Description contains special characters";     push(@error,"Domain Description is blank.");
   } elsif ($domainDescription!~/^[\(\)\-\w\s,]+$/) {
      push(@error,"Domain Description contains special characters.");
 }   } 
 foreach my $v ($perlvar{'lonExpire'},$perlvar{'lonLoadLim'}) {  foreach my $v ($perlvar{'lonExpire'},$perlvar{'lonLoadLim'}) {
    unless ($v=~/^[\d+\.]+$/) { $error.="\nNumber expected instead of $v"; }     unless ($v=~/^[\d+\.]+$/) { push(@error,"Number expected instead of $v"); }
 }  }
 unless (($perlvar{'lonRole'} eq 'library') || ($perlvar{'lonRole'} eq 'access')) {  unless (($perlvar{'lonRole'} eq 'library') || ($perlvar{'lonRole'} eq 'access')) {
    $error.="\nInvalid Role";     push(@error,"Invalid Role");
   }
   
   unless (($protocol eq 'http') || ($protocol eq 'https')) {
      push(@error,"Invalid Protocol (must be http or https");
   }
   
   if (!defined($intdom)) { 
      push(@error,"No internet domain name designated. Enter something like ustate.edu"); 
   } elsif ($intdom !~ /[^.]+\.\w{2,6}$/) {
      push(@error,"Invalid Internet domain name (must be at least two levels separated by .  - e.g., ustate.edu");
 }  }
   
 if (!defined($primaryLibServer)) {  if (!defined($primaryLibServer)) {
    if (@libservers > 0) {     if (@libservers > 0) {
        $error .= "No primary library server ID designated. Choose from: ".join(',',sort(@libservers));         push(@error,"No primary library server ID designated. Choose from: ".join(',',sort(@libservers)));
    } else {     } else {
        $error .= "No library servers in this domain (including current server)";         push(@error,"No library servers in this domain (including current server)");
    }     }
 } else {  } else {
    if (length($primaryLibServer)>16) { $error.="\nPrimary Library Server ID:  $primaryLibServer too long"; }     if (length($primaryLibServer)>35) { push(@error,"Primary Library Server ID:  $primaryLibServer too long"); }
    if (length($primaryLibServer)<2) { $error.="\nPrimary Library Server ID:  $primaryLibServer too short"; }     if (length($primaryLibServer)<2) { push(@error,"Primary Library Server ID:  $primaryLibServer too short"); }
    if ($primaryLibServer =~/capa/i) {     if ($primaryLibServer =~/capa/i) {
         if ($primaryLibServer!~/^oucapa\d+$/ &&          if ($primaryLibServer!~/^oucapa\d+$/ &&
             ($primaryLibServer!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {              ($primaryLibServer!~/^capa\d+$/ && $perlvar{'lonDefDomain'} eq 'uwsp')) {
                  $error.="\nPrimary library server ID $primaryLibServer contains 'capa'";                   push(@error,"Primary library server ID $primaryLibServer contains 'capa'")
         }          }
    }     }
    foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',     foreach my $bad ('res','raw','userfiles','priv','adm','uploaded',
         'editupload') {          'editupload') {
       $error.="\nPrimary library server ID $primaryLibServer reserved." if $primaryLibServer eq $bad;        push(@error,"Primary library server ID $primaryLibServer reserved.") if $primaryLibServer eq $bad;
    }     }
    if ($primaryLibServer=~/\W/) { $error.="\nPrimary library server ID $primaryLibServer contains special characters"; }     if ($primaryLibServer=~/[^\w\-.]/) { push(@error,"Primary library server ID $primaryLibServer contains special characters"); }
 }  }
   
   
 if ($error) { print "\n*** ERRORS: $error\n"; }  if (@error) { print "\n*** ERRORS: \n\t".join("\n\t",@error)."\n"; }
   print(&lt;&lt;END);    print(&lt;&lt;END);
 ENTER A CHOICE OF 1-11 TO CHANGE, otherwise ENTER 12:  ENTER A CHOICE OF 1-13 TO CHANGE, otherwise ENTER 14:
 END  END
 my $choice=&lt;&gt;;  my $choice=&lt;&gt;;
 chomp($choice);  chomp($choice);
Line 805  END Line 907  END
   }    }
   elsif ($choice==5) {    elsif ($choice==5) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 5) System Administrator's E-mail Address: $perlvar{'lonAdmEMail'}  5) Server Administrator's E-mail Address: $perlvar{'lonAdmEMail'}
 ENTER NEW VALUE:  ENTER NEW VALUE:
 END  END
     my $choice2=&lt;&gt;;      my $choice2=&lt;&gt;;
Line 823  END Line 925  END
   }    }
   elsif ($choice==7) {    elsif ($choice==7) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 7) Role: $perlvar{'lonRole'}  7) Server Protocol (http or https): 
   ENTER NEW VALUE: (this should be either 'http' or 'https'
                    if in doubt set to 'http'):
   END
       my $choice2=&lt;&gt;;
       chomp($choice2);
       $protocol=$choice2;
     }
     elsif ($choice==8) {
     print(&lt;&lt;END);
   8) Internet Domain Name of Institution
   ENTER NEW VALUE: 
   
   END
       my $choice2=&lt;&gt;;
       chomp($choice2);
       $intdom=$choice2;
     }
     elsif ($choice==9) {
     print(&lt;&lt;END);
   9) Role: $perlvar{'lonRole'}
 ENTER NEW VALUE (this should be either 'access' or 'library'   ENTER NEW VALUE (this should be either 'access' or 'library' 
                  if in doubt select 'library'):                   if in doubt select 'library'):
 END  END
Line 831  END Line 953  END
     chomp($choice2);      chomp($choice2);
     $perlvar{'lonRole'}=$choice2;      $perlvar{'lonRole'}=$choice2;
   }    }
   elsif ($choice==8) {    elsif ($choice==10) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 8) Cache Expiration Time: $perlvar{'lonExpire'}  10) Cache Expiration Time: $perlvar{'lonExpire'}
 ENTER NEW VALUE (in seconds, 86400 is a reasonable value):  ENTER NEW VALUE (in seconds, 86400 is a reasonable value):
 END  END
     my $choice2=&lt;&gt;;      my $choice2=&lt;&gt;;
     chomp($choice2);      chomp($choice2);
     $perlvar{'lonExpire'}=$choice2;      $perlvar{'lonExpire'}=$choice2;
   }    }
   elsif ($choice==9) {    elsif ($choice==11) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 9) Server Load: $perlvar{'lonLoadLim'}  11) Server Load: $perlvar{'lonLoadLim'}
 ENTER NEW VALUE:  ENTER NEW VALUE:
 END  END
     my $choice2=&lt;&gt;;      my $choice2=&lt;&gt;;
     chomp($choice2);      chomp($choice2);
     $perlvar{'lonLoadLim'}=$choice2;      $perlvar{'lonLoadLim'}=$choice2;
   }    }
   elsif ($choice==10) {    elsif ($choice==12) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 10) User Load: $perlvar{'lonUserLoadLim'}  12) User Load: $perlvar{'lonUserLoadLim'}
 Numer of users that can login before machine is 'overloaded'  Numer of users that can login before machine is 'overloaded'
 ENTER NEW VALUE (integer value, 0 means there is no limit):  ENTER NEW VALUE (integer value, 0 means there is no limit):
 END  END
Line 859  END Line 981  END
     chomp($choice2);      chomp($choice2);
     $perlvar{'lonUserLoadLim'}=$choice2;      $perlvar{'lonUserLoadLim'}=$choice2;
   }    }
   elsif ($choice==11) {    elsif ($choice==13) {
   print(&lt;&lt;END);    print(&lt;&lt;END);
 11) Allow only secure connections: $securestatus   13) Allow only secure connections: $securestatus 
 The Lon-CAPA communication daemons lonc and lond can be configured to  The Lon-CAPA communication daemons lonc and lond can be configured to
 allow only secure connections by default.  allow only secure connections by default.
   
Line 888  END Line 1010  END
     }      }
     ($securestatus,$securenum)=&securesetting(%perlvar);      ($securestatus,$securenum)=&securesetting(%perlvar);
   }    }
   elsif (($choice==12) && (!$error)) {    elsif (($choice==14) && (!@error)) {
     $flag=1;      $flag=1;
   }    }
   else {    else {
Line 899  END Line 1021  END
       die("Cannot output to $confdir$filename\n");        die("Cannot output to $confdir$filename\n");
     foreach my $key (keys %perlvar) {      foreach my $key (keys %perlvar) {
       my $value=$perlvar{$key};        my $value=$perlvar{$key};
         my $line = "PerlSetVar     $key      $value";
         if ($value eq '') {
             $line = '#'.$line;
         }
       print(OUT &lt;&lt;END) unless $perlvarstatic{$key};        print(OUT &lt;&lt;END) unless $perlvarstatic{$key};
 PerlSetVar     $key      $value  $line
 END  END
     }      }
     close(OUT);      close(OUT);
Line 911  END Line 1037  END
 <perlscript mode='fg'>  <perlscript mode='fg'>
 unless (-l "<TARGET />") {  unless (-l "<TARGET />") {
   my $hostname=`hostname -f`;chomp($hostname);    my $hostname=`hostname -f`;chomp($hostname);
   $date=`date -I`; chomp($date);    my $date=`date -I`; chomp($date);
   $lonHostID=$perlvar{'lonHostID'};    my $lonHostID=$perlvar{'lonHostID'};
   $lonHostID=~s/\W//g;    $lonHostID=~s/[^\w\-.]//g;
   $lineexistflag=0;    my $lineexistflag=0;
   $hostidexistflag=0;    my $hostidexistflag=0;
   $line2insert=&lt;&lt;END;    my $line2insert=&lt;&lt;END;
 $perlvar{'lonHostID'}:$perlvar{'lonDefDomain'}:$perlvar{'lonRole'}:$hostname  $perlvar{'lonHostID'}:$perlvar{'lonDefDomain'}:$perlvar{'lonRole'}:$hostname:$protocol:$intdom
 END  END
   $domaininsert="$perlvar{'lonDefDomain'}:$domainDescription:$domainTabExtras:$primaryLibServer\n";    if (!$domainTabExtras) {
    $domainTabExtras=':::::';
     }
     my $domaininsert="$perlvar{'lonDefDomain'}:$domainDescription:$domainTabExtras:$primaryLibServer\n";
   if ($lonCluster eq 'standalone') {    if ($lonCluster eq 'standalone') {
     open(OUT,'&gt;../'.$lonCluster.'_hosts.tab') or      open(OUT,'&gt;../'.$lonCluster.'_hosts.tab') or
       die('file generation error');        die('file generation error');
       print(OUT $line2insert);        print(OUT $line2insert);
         print OUT ("^$hostname:$protocol\n");
       close(OUT);
       open(OUT,'&gt;../'.$lonCluster.'_dns_hosts.tab') or
         die('file generation error');
         print(OUT $line2insert);
     close(OUT);      close(OUT);
     open(OUT,'&gt;../'.$lonCluster.'_domain.tab') or      open(OUT,'&gt;../'.$lonCluster.'_domain.tab') or
       die('file generation error');        die('file generation error');
       print(OUT $domaininsert);        print(OUT $domaininsert);
     close(OUT);      close(OUT);
       open(OUT,'&gt;../'.$lonCluster.'_dns_domain.tab') or
         die('file generation error');
         print(OUT $domaininsert);
       close(OUT);
   }    }
   if ($flag==1) {    if ($flag==1) {
     `rm -f ../hosts.tab`;      `rm -f ../hosts.tab`;
     open(IN,'&lt;../'.$lonCluster.'_hosts.tab');      `rm -f ../dns_hosts.tab`;
     while(&lt;IN&gt;) {      `ln -s ${lonCluster}_dns_hosts.tab ../dns_hosts.tab`;
       if (/^$line2insert$/) {      open(IN,'&lt;../'.$lonCluster.'_dns_hosts.tab');
       while(my $line = &lt;IN&gt;) {
         if ($line =~ /^\Q$line2insert\E$/) {
         $lineexistflag=1;          $lineexistflag=1;
       }        }
       if (/^$lonHostID\:/) {        if ($line =~ /^\Q$lonHostID\E\:/) {
         $hostidexistflag=1;          $hostidexistflag=1;
       }        }
     }      }
Line 945  END Line 1085  END
     if ($hostidexistflag and !$lineexistflag) {      if ($hostidexistflag and !$lineexistflag) {
       print &lt;&lt;END;        print &lt;&lt;END;
 WARNING: $lonHostID already exists inside  WARNING: $lonHostID already exists inside
 loncapa/loncom/${lonCluster}_hosts.tab.  The entry inside  loncapa/loncom/${lonCluster}_dns_hosts.tab.  The entry inside
 ${lonCluster}_hosts.tab does not match your settings.  ${lonCluster}_dns_hosts.tab does not match your settings.
 The entry inside ${lonCluster}_hosts.tab is being replaced  An entry inside ${lonCluster}_hosts.tab will be made
 with your new values.  with your new values.
 END  END
       `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;        `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
Line 957  END Line 1097  END
        close(OUT);         close(OUT);
       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;        `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
       # email appropriate message        # email appropriate message
       `echo "REPLACE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "REPLACE:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;        `echo "REPLACE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "REPLACE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
     }      }
     elsif ($hostidexistflag and $lineexistflag) {      elsif ($hostidexistflag and $lineexistflag) {
       print &lt;&lt;END;        print &lt;&lt;END;
 Entry exists in ${lonCluster}_hosts.tab.  Entry exists in ${lonCluster}_dns_hosts.tab. Making duplicate entry in ${lonCluster}_hosts.tab
 END  END
       `ln -s ${lonCluster}_hosts.tab ../hosts.tab`;        `grep -v "$lonHostID:" ../${lonCluster}_hosts.tab &gt; ../new_${lonCluster}_hosts.tab`;
          open(OUT,'&gt;&gt;../new_'.$lonCluster.'_hosts.tab') or
            die("cannot open loncom/${lonCluster}_hosts.tab for output\n");
            print(OUT $line2insert);
          close(OUT);
         `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
       # email appropriate message        # email appropriate message
       `echo "STABLEUPDATE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "STABLEUPDATE:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;        `echo "STABLEUPDATE:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "STABLEUPDATE:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
     }      }
     elsif (!$hostidexistflag and !$lineexistflag) {      elsif (!$hostidexistflag and !$lineexistflag) {
       print &lt;&lt;END;        print &lt;&lt;END;
Line 978  END Line 1123  END
        close(OUT);         close(OUT);
       `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;        `ln -s new_${lonCluster}_hosts.tab ../hosts.tab`;
       # email appropriate message        # email appropriate message
       `echo "INSERT:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "INSERT:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;        `echo "INSERT:$lonCluster:$lonHostID:$date:$line2insert" | mail -s "INSERT:$lonCluster:$lonHostID:$protocol:$intdom:$date" installrecord\@mail.lon-capa.org`;
     }      }
   }    }
   $lineexistflag=0;    $lineexistflag=0;
     my $domainexistflag=0;
   if ($flag==1) {    if ($flag==1) {
     `rm -f ../domain.tab`;      `rm -f ../domain.tab`;
     open(IN,'&lt;../'.$lonCluster.'_domain.tab');      `rm -f ../dns_domain.tab`;
     while(&lt;IN&gt;) {      `ln -s ${lonCluster}_dns_domain.tab ../dns_domain.tab`;
       if (/^$domaininsert$/) {      open(IN,'&lt;../'.$lonCluster.'_dns_domain.tab');
       while(my $line = &lt;IN&gt;) {
         if ($line =~/^\Q$domaininsert\E$/) {
         $lineexistflag=1;          $lineexistflag=1;
       }        }
       if (/^$perlvar{'lonDefDomain'}\:/) {        if ($line =~/^\Q$perlvar{'lonDefDomain'}\E\:/) {
         $domainexistflag=1;          $domainexistflag=1;
       }        }
     }      }
Line 997  END Line 1145  END
     if ($domainexistflag and !$lineexistflag) {      if ($domainexistflag and !$lineexistflag) {
       print &lt;&lt;END;        print &lt;&lt;END;
 WARNING: $perlvar{'lonDefDomain'} already exists inside  WARNING: $perlvar{'lonDefDomain'} already exists inside
 loncapa/loncom/${lonCluster}_domain.tab.  The entry inside  loncapa/loncom/${lonCluster}_dns_domain.tab.  The entry inside
 ${lonCluster}_domain.tab does not match your settings.  ${lonCluster}_dns_domain.tab does not match your settings.
 The entry inside ${lonCluster}_domain.tab is being replaced  An entry will be made in inside ${lonCluster}_domain.tab
 with your new values.  with your new values.
 END  END
       `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;        `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
Line 1009  END Line 1157  END
        close(OUT);         close(OUT);
       `ln -s new_${lonCluster}_domain.tab ../domain.tab`;        `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
       # email appropriate message        # email appropriate message
       `echo "REPLACEdom:$lonCluster:$lonHostID:$date:$domaninsert" | mail -s "REPLACEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;        `echo "REPLACEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "REPLACEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
     }      }
     elsif ($domainexistflag and $lineexistflag) {      elsif ($domainexistflag and $lineexistflag) {
         `grep -v "$perlvar{'lonDefDomain'}:" ../${lonCluster}_domain.tab &gt; ../new_${lonCluster}_domain.tab`;
          open(OUT,'&gt;&gt;../new_'.$lonCluster.'_domain.tab') or
            die("cannot open loncom/${lonCluster}_domain.tab for output\n");
            print(OUT $domaininsert);
          close(OUT);
       print &lt;&lt;END;        print &lt;&lt;END;
 Entry exists in ${lonCluster}_domain.tab.  Entry exists in ${lonCluster}_dns_domain.tab. Making duplicate entry in ${lonCluster}_domain.tab
 END  END
       `ln -s ${lonCluster}_domain.tab ../domain.tab`;        `ln -s new_${lonCluster}_domain.tab ../domain.tab`;
       # email appropriate message        # email appropriate message
       `echo "STABLEUPDATEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "STABLEUPDATEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;        `echo "STABLEUPDATEdom:$lonCluster:$lonHostID:$date:$domaininsert" | mail -s "STABLEUPDATEdom:$lonCluster:$lonHostID:$date" installrecord\@mail.lon-capa.org`;
     }      }

Removed from v.1.45  
changed lines
  Added in v.1.82


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