Diff for /loncom/lond between versions 1.545 and 1.560

version 1.545, 2018/08/07 17:12:09 version 1.560, 2019/07/18 18:28:40
Line 80  my $clientsamedom;              # LonCAP Line 80  my $clientsamedom;              # LonCAP
                                 # and client.                                  # and client.
 my $clientsameinst;             # LonCAPA "internet domain" same for   my $clientsameinst;             # LonCAPA "internet domain" same for 
                                 # this host and client.                                  # this host and client.
 my $clientremoteok;             # Client allowed to host domain's users.  my $clientremoteok;             # Current domain permits hosting on client
                                 # (version constraints ignored), not set                                  # (not set if host and client share "internet domain").
                                 # if this host and client share "internet domain".                                   # Values are 0 or 1; 1 if allowed.
 my %clientprohibited;           # Actions prohibited on client;  my %clientprohibited;           # Commands from client prohibited for domain's
                                    # users.
   
 my $server;  my $server;
   
 my $keymode;  my $keymode;
Line 176  my @installerrors = ("ok", Line 177  my @installerrors = ("ok",
 # shared    ("Access to other domain's content by this domain")  # shared    ("Access to other domain's content by this domain")
 # enroll    ("Enrollment in this domain's courses by others")  # enroll    ("Enrollment in this domain's courses by others")
 # coaurem   ("Co-author roles for this domain's users elsewhere")  # coaurem   ("Co-author roles for this domain's users elsewhere")
   # othcoau   ("Co-author roles in this domain for others")
 # domroles  ("Domain roles in this domain assignable to others")  # domroles  ("Domain roles in this domain assignable to others")
 # catalog   ("Course Catalog for this domain displayed elsewhere")  # catalog   ("Course Catalog for this domain displayed elsewhere")
 # reqcrs    ("Requests for creation of courses in this domain by others")  # reqcrs    ("Requests for creation of courses in this domain by others")
Line 224  my %trust = ( Line 226  my %trust = (
                dcmaildump => {remote => 1, domroles => 1},                 dcmaildump => {remote => 1, domroles => 1},
                dcmailput => {remote => 1, domroles => 1},                 dcmailput => {remote => 1, domroles => 1},
                del => {remote => 1, domroles => 1, enroll => 1, content => 1},                 del => {remote => 1, domroles => 1, enroll => 1, content => 1},
                  delbalcookie => {institutiononly => 1},
                  delusersession => {institutiononly => 1},
                deldom => {remote => 1, domroles => 1}, # not currently used                 deldom => {remote => 1, domroles => 1}, # not currently used
                devalidatecache => {institutiononly => 1},                 devalidatecache => {institutiononly => 1},
                domroleput => {remote => 1, enroll => 1},                 domroleput => {remote => 1, enroll => 1},
Line 234  my %trust = ( Line 238  my %trust = (
                edit => {institutiononly => 1},  #not used currently                 edit => {institutiononly => 1},  #not used currently
                eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently                 eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently
                egetdom => {remote => 1, domroles => 1, enroll => 1, },                 egetdom => {remote => 1, domroles => 1, enroll => 1, },
                ekey => {}, #not used currently                 ekey => {anywhere => 1},
                exit => {anywhere => 1},                 exit => {anywhere => 1},
                fetchuserfile => {remote => 1, enroll => 1},                 fetchuserfile => {remote => 1, enroll => 1},
                get => {remote => 1, domroles => 1, enroll => 1},                 get => {remote => 1, domroles => 1, enroll => 1},
Line 299  my %trust = ( Line 303  my %trust = (
                store => {remote => 1, enroll => 1, reqcrs => 1,},                 store => {remote => 1, enroll => 1, reqcrs => 1,},
                studentphoto => {remote => 1, enroll => 1},                 studentphoto => {remote => 1, enroll => 1},
                sub => {content => 1,},                 sub => {content => 1,},
                tmpdel => {anywhere => 1},                 tmpdel => {institutiononly => 1},
                tmpget => {anywhere => 1},                 tmpget => {institutiononly => 1},
                tmpput => {anywhere => 1},                 tmpput => {remote => 1, othcoau => 1},
                tokenauthuserfile => {anywhere => 1},                 tokenauthuserfile => {anywhere => 1},
                unsub => {content => 1,},                 unsub => {content => 1,},
                update => {shared => 1},                 update => {shared => 1},
Line 435  sub SSLConnection { Line 439  sub SSLConnection {
  $Certificate,   $Certificate,
  $KeyFile,   $KeyFile,
  $clientname,   $clientname,
                                                 $CRLFile);                                                  $CRLFile,
                                                   $clientversion);
     if(! ($SSLSocket) ) { # SSL socket promotion failed.      if(! ($SSLSocket) ) { # SSL socket promotion failed.
  my $err = lonssl::LastError();   my $err = lonssl::LastError();
  &logthis("<font color=\"red\"> CRITICAL "   &logthis("<font color=\"red\"> CRITICAL "
Line 791  sub ConfigFileFromSelector { Line 796  sub ConfigFileFromSelector {
     my $selector   = shift;      my $selector   = shift;
     my $tablefile;      my $tablefile;
   
     my $tabledir = $perlvar{'lonTabDir'}.'/';      if ($selector eq 'loncapaCAcrl') {
     if (($selector eq "hosts") || ($selector eq "domain") ||           my $tabledir = $perlvar{'lonCertificateDirectory'};
         ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {          if (-d $tabledir) {
  $tablefile =  $tabledir.$selector.'.tab';              $tablefile =  $tabledir.'/'.$selector.'.pem';
           }
       } else {
           my $tabledir = $perlvar{'lonTabDir'}.'/';
           if (($selector eq "hosts") || ($selector eq "domain") || 
               ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {
       $tablefile =  $tabledir.$selector.'.tab';
           }
     }      }
     return $tablefile;      return $tablefile;
 }  }
Line 818  sub PushFile { Line 830  sub PushFile {
     my ($command, $filename, $contents) = split(":", $request, 3);      my ($command, $filename, $contents) = split(":", $request, 3);
     &Debug("PushFile");      &Debug("PushFile");
           
     #  At this point in time, pushes for only the following tables are      #  At this point in time, pushes for only the following tables and
     #  supported:      #  CRL file are supported:
     #   hosts.tab  ($filename eq host).      #   hosts.tab  ($filename eq host).
     #   domain.tab ($filename eq domain).      #   domain.tab ($filename eq domain).
     #   dns_hosts.tab ($filename eq dns_host).      #   dns_hosts.tab ($filename eq dns_host).
     #   dns_domain.tab ($filename eq dns_domain).       #   dns_domain.tab ($filename eq dns_domain).
       #   loncapaCAcrl.pem ($filename eq loncapaCAcrl).
     # Construct the destination filename or reject the request.      # Construct the destination filename or reject the request.
     #      #
     # lonManage is supposed to ensure this, however this session could be      # lonManage is supposed to ensure this, however this session could be
Line 844  sub PushFile { Line 857  sub PushFile {
   
     if($filename eq "host") {      if($filename eq "host") {
  $contents = AdjustHostContents($contents);   $contents = AdjustHostContents($contents);
     } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') {      } elsif (($filename eq 'dns_host') || ($filename eq 'dns_domain') ||
                ($filename eq 'loncapaCAcrl')) {
         if ($contents eq '') {          if ($contents eq '') {
             &logthis('<font color="red"> Pushfile: unable to install '              &logthis('<font color="red"> Pushfile: unable to install '
                     .$tablefile." - no data received from push. </font>");                      .$tablefile." - no data received from push. </font>");
Line 855  sub PushFile { Line 869  sub PushFile {
             if ($managers{$clientip} eq $clientname) {              if ($managers{$clientip} eq $clientname) {
                 my $clientprotocol = $Apache::lonnet::protocol{$clientname};                  my $clientprotocol = $Apache::lonnet::protocol{$clientname};
                 $clientprotocol = 'http' if ($clientprotocol ne 'https');                  $clientprotocol = 'http' if ($clientprotocol ne 'https');
                 my $url = '/adm/'.$filename;                  my $url;
                 $url =~ s{_}{/};                  if ($filename eq 'loncapaCAcrl') {
                       $url = '/adm/dns/loncapaCRL';
                   } else {
                       $url = '/adm/'.$filename;
                       $url =~ s{_}{/};
                   }
                 my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");                  my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");
                 my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0);                  my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0);
                 if ($response->is_error()) {                  if ($response->is_error()) {
Line 1894  sub ls3_handler { Line 1913  sub ls3_handler {
     my $rights;      my $rights;
     my $ulsout='';      my $ulsout='';
     my $ulsfn;      my $ulsfn;
   
       my ($crscheck,$toplevel,$currdom,$currnum,$skip);
       unless ($islocal) {
           my ($major,$minor) = split(/\./,$clientversion);
           if (($major < 2) || ($major == 2 && $minor < 12)) {
               $crscheck = 1;
           }
       }
     if (-e $ulsdir) {      if (-e $ulsdir) {
         if(-d $ulsdir) {          if(-d $ulsdir) {
             unless (($getpropath) || ($getuserdir) ||              unless (($getpropath) || ($getuserdir) ||
Line 1903  sub ls3_handler { Line 1930  sub ls3_handler {
                 &Failure($client,"refused\n",$userinput);                  &Failure($client,"refused\n",$userinput);
                 return 1;                  return 1;
             }              }
             if (opendir(LSDIR,$ulsdir)) {              if (($crscheck) &&
                   ($ulsdir =~ m{^/home/httpd/html/res/($LONCAPA::match_domain)(/?$|/$LONCAPA::match_courseid)})) {
                   ($currdom,my $posscnum) = ($1,$2);
                   if (($posscnum eq '') || ($posscnum eq '/')) {
                       $toplevel = 1;
                   } else {
                       $posscnum =~ s{^/+}{};
                       if (&LONCAPA::Lond::is_course($currdom,$posscnum)) {
                           $skip = 1;
                       }
                   }
               }
               if ((!$skip) && (opendir(LSDIR,$ulsdir))) {
                 while ($ulsfn=readdir(LSDIR)) {                  while ($ulsfn=readdir(LSDIR)) {
                       if (($crscheck) && ($toplevel) && ($currdom ne '') &&
                           ($ulsfn =~ /^$LONCAPA::match_courseid$/) && (-d "$ulsdir/$ulsfn")) {
                           if (&LONCAPA::Lond::is_course($currdom,$ulsfn)) {
                               next;
                           }
                       }
                     undef($obs);                      undef($obs);
                     undef($rights);                      undef($rights);
                     my @ulsstats=stat($ulsdir.'/'.$ulsfn);                      my @ulsstats=stat($ulsdir.'/'.$ulsfn);
Line 1986  sub read_lonnet_global { Line 2031  sub read_lonnet_global {
                 }                  }
                 if ($what eq 'perlvar') {                  if ($what eq 'perlvar') {
                     if (!exists($packagevars{$what}{'lonBalancer'})) {                      if (!exists($packagevars{$what}{'lonBalancer'})) {
                         if ($dist =~ /^(centos|rhes|fedora|scientific)/) {                          if ($dist =~ /^(centos|rhes|fedora|scientific|oracle)/) {
                             my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');                              my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');
                             if (ref($othervarref) eq 'HASH') {                              if (ref($othervarref) eq 'HASH') {
                                 $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};                                  $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
Line 2082  sub server_distarch_handler { Line 2127  sub server_distarch_handler {
 sub server_certs_handler {  sub server_certs_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my $result;      my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'});
     my $result = &LONCAPA::Lond::server_certs(\%perlvar);      my $result = &LONCAPA::Lond::server_certs(\%perlvar,$perlvar{'lonHostID'},$hostname);
     &Reply($client,\$result,$userinput);      &Reply($client,\$result,$userinput);
     return;      return;
 }  }
Line 2304  sub change_password_handler { Line 2349  sub change_password_handler {
     }      }
     if($validated) {      if($validated) {
  my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.   my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.
   
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
           my $notunique;
  if ($howpwd eq 'internal') {   if ($howpwd eq 'internal') {
     &Debug("internal auth");      &Debug("internal auth");
             my $ncpass = &hash_passwd($udom,$npass);              my $ncpass = &hash_passwd($udom,$npass);
     if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {              my (undef,$method,@rest) = split(/!/,$contentpwd);
               if ($method eq 'bcrypt') {
                   my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
                   if (($passwdconf{'numsaved'}) && ($passwdconf{'numsaved'} =~ /^\d+$/)) {
                       my @oldpasswds;
                       my $userpath = &propath($udom,$uname);
                       my $fullpath = $userpath.'/oldpasswds';
                       if (-d $userpath) {
                           my @oldfiles;
                           if (-e $fullpath) {
                               if (opendir(my $dir,$fullpath)) {
                                   (@oldfiles) = grep(/^\d+$/,readdir($dir));
                                   closedir($dir);
                               }
                               if (@oldfiles) {
                                   @oldfiles = sort { $b <=> $a } (@oldfiles);
                                   my $numremoved = 0;
                                   for (my $i=0; $i<@oldfiles; $i++) {
                                       if ($i>=$passwdconf{'numsaved'}) {
                                           if (-f "$fullpath/$oldfiles[$i]") {
                                               if (unlink("$fullpath/$oldfiles[$i]")) {
                                                   $numremoved ++;
                                               }
                                           }
                                       } elsif (open(my $fh,'<',"$fullpath/$oldfiles[$i]")) {
                                           while (my $line = <$fh>) {
                                               push(@oldpasswds,$line);
                                           }
                                           close($fh);
                                       }
                                   }
                                   if ($numremoved) {
                                       &logthis("unlinked $numremoved old password files for $uname:$udom");
                                   }
                               }
                           }
                           push(@oldpasswds,$contentpwd);
                           foreach my $item (@oldpasswds) {
                               my (undef,$method,@rest) = split(/!/,$item);
                               if ($method eq 'bcrypt') {
                                   my $result = &hash_passwd($udom,$npass,@rest);
                                   if ($result eq $item) {
                                       $notunique = 1;
                                       last;
                                   }
                               }
                           }
                           unless ($notunique) {
                               unless (-e $fullpath) {
                                   if (&mkpath("$fullpath/")) {
                                       chmod(0700,$fullpath);
                                   }
                               }
                               if (-d $fullpath) {
                                   my $now = time;
                                   if (open(my $fh,'>',"$fullpath/$now")) {
                                       print $fh $contentpwd;
                                       close($fh);
                                       chmod(0400,"$fullpath/$now");
                                   }
                               }
                           }
                       }
                   }
               }
               if ($notunique) {
                   my $msg="Result of password change for $uname:$udom - password matches one used before";
                   if ($lonhost) {
                       $msg .= " - request originated from: $lonhost";
                   }
                   &logthis($msg);
                   &Reply($client, "prioruse\n", $userinput);
       } elsif (&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
  my $msg="Result of password change for $uname: pwchange_success";   my $msg="Result of password change for $uname: pwchange_success";
                 if ($lonhost) {                  if ($lonhost) {
                     $msg .= " - request originated from: $lonhost";                      $msg .= " - request originated from: $lonhost";
Line 2337  sub change_password_handler { Line 2454  sub change_password_handler {
     #      #
     &Failure( $client, "auth_mode_error\n", $userinput);      &Failure( $client, "auth_mode_error\n", $userinput);
  }     }  
   
     } else {      } else {
  if ($failure eq '') {   if ($failure eq '') {
     $failure = 'non_authorized';      $failure = 'non_authorized';
Line 2918  sub user_has_session_handler { Line 3034  sub user_has_session_handler {
 }  }
 &register_handler("userhassession", \&user_has_session_handler, 0,1,0);  &register_handler("userhassession", \&user_has_session_handler, 0,1,0);
   
   sub del_usersession_handler {
       my ($cmd, $tail, $client) = @_;
   
       my $result;
       my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
       if (($udom =~ /^$LONCAPA::match_domain$/) && ($uname =~ /^$LONCAPA::match_username$/)) {
           my $lonidsdir = $perlvar{'lonIDsDir'};
           if (-d $lonidsdir) {
               if (opendir(DIR,$lonidsdir)) {
                   my $filename;
                   while ($filename=readdir(DIR)) {
                       if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/) {
                           if (tie(my %oldenv,'GDBM_File',"$lonidsdir/$filename",
                                   &GDBM_READER(),0640)) {
                               my $linkedfile;
                               if (exists($oldenv{'user.linkedenv'})) {
                                   $linkedfile = $oldenv{'user.linkedenv'};
                               }
                               untie(%oldenv);
                               $result = unlink("$lonidsdir/$filename");
                               if ($result) {
                                   if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                                       if (-l "$lonidsdir/$linkedfile.id") {
                                           unlink("$lonidsdir/$linkedfile.id");
                                       }
                                   }
                               }
                           } else {
                               $result = unlink("$lonidsdir/$filename");
                           }
                           last;
                       }
                   }
               }
           }
           if ($result == 1) {
               &Reply($client, "$result\n", "$cmd:$tail");
           } else {
               &Reply($client, "not_found\n", "$cmd:$tail");
           }
       } else {
           &Failure($client, "invalid_user\n", "$cmd:$tail");
       }
       return 1;
   }
   
   &register_handler("delusersession", \&del_usersession_handler, 0,1,0);
   
 #  #
 #  Authenticate access to a user file by checking that the token the user's   #  Authenticate access to a user file by checking that the token the user's 
 #  passed also exists in their session file  #  passed also exists in their session file
Line 5480  sub tmp_del_handler { Line 5644  sub tmp_del_handler {
 &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);  &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
   
 #  #
   #  Process the delbalcookie command. This command deletes a balancer
   #  cookie in the lonBalancedir directory created by switchserver
   #
   # Parameters:
   #   $cmd      - Command that got us here.
   #   $cookie   - Cookie to be deleted.
   #   $client   - socket open on the client process.
   #
   # Returns:
   #   1     - Indicating processing should continue.
   # Side Effects:
   #   A cookie file is deleted from the lonBalancedir directory
   #   A reply is sent to the client.
   sub del_balcookie_handler {
       my ($cmd, $cookie, $client) = @_;
   
       my $userinput= "$cmd:$cookie";
   
       chomp($cookie);
       my $deleted = '';
       if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
           my $execdir=$perlvar{'lonBalanceDir'};
           if (-e "$execdir/$cookie.id") {
               if (open(my $fh,'<',"$execdir/$cookie.id")) {
                   my $dodelete;
                   while (my $line = <$fh>) {
                       chomp($line);
                       if ($line eq $clientname) {
                           $dodelete = 1;
                           last;
                       }
                   }
                   close($fh);
                   if ($dodelete) {
                       if (unlink("$execdir/$cookie.id")) {
                           $deleted = 1;
                       }
                   }
               }
           }
       }
       if ($deleted) {
           &Reply($client, "ok\n", $userinput);
       } else {
           &Failure( $client, "error: ".($!+0)."Unlinking cookie file Failed ".
                     "while attempting delbalcookie\n", $userinput);
       }
       return 1;
   }
   &register_handler("delbalcookie", \&del_balcookie_handler, 0, 1, 0);
   
   #
 #   Processes the setannounce command.  This command  #   Processes the setannounce command.  This command
 #   creates a file named announce.txt in the top directory of  #   creates a file named announce.txt in the top directory of
 #   the documentn root and sets its contents.  The announce.txt file is  #   the documentn root and sets its contents.  The announce.txt file is
Line 6869  my $wwwid=getpwnam('www'); Line 7085  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
    my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    my $subj="LON: $currenthostid User ID mismatch";     my $subj="LON: $currenthostid User ID mismatch";
    system("echo 'User ID mismatch.  lond must be run as user www.' |\     system("echo 'User ID mismatch.  lond must be run as user www.' |".
  mailto $emailto -s '$subj' > /dev/null");            " mail -s '$subj' $emailto > /dev/null");
    exit 1;     exit 1;
 }  }
   
Line 7004  sub UpdateHosts { Line 7220  sub UpdateHosts {
   
     my %oldconf = %secureconf;      my %oldconf = %secureconf;
     my %connchange;      my %connchange;
     if (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') {      if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
         logthis('<font color="blue"> Reloaded SSL connection rules and cleared CRL checking history </font>');          logthis('<font color="blue"> Reloaded SSL connection rules and cleared CRL checking history </font>');
     } else {      } else {
         logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>');          logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>');
Line 7286  if ($arch eq 'unknown') { Line 7502  if ($arch eq 'unknown') {
     chomp($arch);      chomp($arch);
 }  }
   
 unless (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') {  unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
     &logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>');      &logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>');
 }  }
   
Line 7375  sub make_new_child { Line 7591  sub make_new_child {
         &Authen::Krb5::init_context();          &Authen::Krb5::init_context();
   
         my $no_ets;          my $no_ets;
         if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) {          if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) {
             if ($1 >= 7) {              if ($1 >= 7) {
                 $no_ets = 1;                  $no_ets = 1;
             }              }
Line 7420  sub make_new_child { Line 7636  sub make_new_child {
     $ConnectionType = "manager";      $ConnectionType = "manager";
     $clientname = $managers{$outsideip};      $clientname = $managers{$outsideip};
  }   }
  my ($clientok,$clientinfoset);   my $clientok;
   
  if ($clientrec || $ismanager) {   if ($clientrec || $ismanager) {
     &status("Waiting for init from $clientip $clientname");      &status("Waiting for init from $clientip $clientname");
Line 7521  sub make_new_child { Line 7737  sub make_new_child {
     }      }
         
  } else {   } else {
                     $clientinfoset = &set_client_info();  
     my $ok = InsecureConnection($client);      my $ok = InsecureConnection($client);
     if($ok) {      if($ok) {
  $clientok = 1;   $clientok = 1;
Line 7559  sub make_new_child { Line 7774  sub make_new_child {
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
     my $keep_going = 1;      my $keep_going = 1;
     my $user_input;      my $user_input;
             unless ($clientinfoset) {  
                 $clientinfoset = &set_client_info();  
             }  
             $clientremoteok = 0;  
             unless ($clientsameinst) {  
                 $clientremoteok = 1;  
                 my $defdom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});  
                 %clientprohibited = &get_prohibited($defdom);  
                 if ($clientintdom) {  
                     my $remsessconf = &get_usersession_config($defdom,'remotesession');  
                     if (ref($remsessconf) eq 'HASH') {  
                         if (ref($remsessconf->{'remote'}) eq 'HASH') {  
                             if (ref($remsessconf->{'remote'}->{'excludedomain'}) eq 'ARRAY') {  
                                 if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'excludedomain'}})) {  
                                     $clientremoteok = 0;  
                                 }  
                             }  
                             if (ref($remsessconf->{'remote'}->{'includedomain'}) eq 'ARRAY') {  
                                 if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'includedomain'}})) {  
                                     $clientremoteok = 1;  
                                 } else {  
                                     $clientremoteok = 0;  
                                 }  
                             }  
                         }  
                     }  
                 }  
             }  
     while(($user_input = get_request) && $keep_going) {      while(($user_input = get_request) && $keep_going) {
  alarm(120);   alarm(120);
  Debug("Main: Got $user_input\n");   Debug("Main: Got $user_input\n");
Line 7619  sub make_new_child { Line 7807  sub make_new_child {
   
 #  #
 #  Used to determine if a particular client is from the same domain  #  Used to determine if a particular client is from the same domain
 #  as the current server, or from the same internet domain.  #  as the current server, or from the same internet domain, and
   #  also if the client can host sessions for the domain's users.
   #  A hash is populated with keys set to commands sent by the client
   #  which may not be executed for this domain.
 #  #
 #  Optional input -- the client to check for domain and internet domain.  #  Optional input -- the client to check for domain and internet domain.
 #  If not specified, defaults to the package variable: $clientname  #  If not specified, defaults to the package variable: $clientname
 #  #
 #  If called in array context will not set package variables, but will  #  If called in array context will not set package variables, but will
 #  instead return an array of two values - (a) true if client is in the  #  instead return an array of two values - (a) true if client is in the
 #  same domain as the server, and (b) true if client is in the same internet  #  same domain as the server, and (b) true if client is in the same 
 #  domain.  #  internet domain.
 #  #
 #  If called in scalar context, sets package variables for current client:  #  If called in scalar context, sets package variables for current client:
 #  #
 #  $clienthomedom  - LonCAPA domain of homeID for client.  #  $clienthomedom    - LonCAPA domain of homeID for client.
 #  $clientsamedom  - LonCAPA domain same for this host and client.  #  $clientsamedom    - LonCAPA domain same for this host and client.
 #  $clientintdom   - LonCAPA "internet domain" for client.  #  $clientintdom     - LonCAPA "internet domain" for client.
 #  $clientsameinst - LonCAPA "internet domain" same for this host & client.  #  $clientsameinst   - LonCAPA "internet domain" same for this host & client.
   #  $clientremoteok   - If current domain permits hosting on this client: 1
   #  %clientprohibited - Commands prohibited for domain's users for this client.
   #
   #  if the host and client have the same "internet domain", then the value
   #  of $clientremoteok is not used, and no commands are prohibited.
 #  #
 #  returns 1 to indicate package variables have been set for current client.  #  returns 1 to indicate package variables have been set for current client.
 #  #
Line 7646  sub set_client_info { Line 7842  sub set_client_info {
     my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);      my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
     my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);      my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);
     my $samedom = 0;      my $samedom = 0;
     if ($perlvar{'lonDefDom'} eq $homedom) {      if ($perlvar{'lonDefDomain'} eq $homedom) {
         $samedom = 1;          $samedom = 1;
     }      }
     my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);      my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);
Line 7666  sub set_client_info { Line 7862  sub set_client_info {
         $clientsamedom = $samedom;          $clientsamedom = $samedom;
         $clientintdom = $intdom;          $clientintdom = $intdom;
         $clientsameinst = $sameinst;          $clientsameinst = $sameinst;
           if ($clientsameinst) {
               undef($clientremoteok);
               undef(%clientprohibited);
           } else {
               $clientremoteok = &get_remote_hostable($currentdomainid);
               %clientprohibited = &get_prohibited($currentdomainid);
           }
         return 1;          return 1;
     }      }
 }  }
Line 8413  sub sethost { Line 8616  sub sethost {
  eq &Apache::lonnet::get_host_ip($hostid)) {   eq &Apache::lonnet::get_host_ip($hostid)) {
  $currenthostid  =$hostid;   $currenthostid  =$hostid;
  $currentdomainid=&Apache::lonnet::host_domain($hostid);   $currentdomainid=&Apache::lonnet::host_domain($hostid);
           &set_client_info();
 # &logthis("Setting hostid to $hostid, and domain to $currentdomainid");  # &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {      } else {
  &logthis("Requested host id $hostid not an alias of ".   &logthis("Requested host id $hostid not an alias of ".
Line 8489  sub get_prohibited { Line 8693  sub get_prohibited {
     return %prohibited;      return %prohibited;
 }  }
   
   sub get_remote_hostable {
       my ($dom) = @_;
       my $result;
       if ($clientintdom) {
           $result = 1;
           my $remsessconf = &get_usersession_config($dom,'remotesession');
           if (ref($remsessconf) eq 'HASH') {
               if (ref($remsessconf->{'remote'}) eq 'HASH') {
                   if (ref($remsessconf->{'remote'}->{'excludedomain'}) eq 'ARRAY') {
                       if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'excludedomain'}})) {
                           $result = 0;
                       }
                   }
                   if (ref($remsessconf->{'remote'}->{'includedomain'}) eq 'ARRAY') {
                       if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'includedomain'}})) {
                           $result = 1;
                       } else {
                           $result = 0;
                       }
                   }
               }
           }
       }
       return $result;
   }
   
 sub distro_and_arch {  sub distro_and_arch {
     return $dist.':'.$arch;      return $dist.':'.$arch;
 }  }
Line 8895  is closed and the child exits. Line 9125  is closed and the child exits.
 =item Red CRITICAL Can't get key file <error>          =item Red CRITICAL Can't get key file <error>        
   
 SSL key negotiation is being attempted but the call to  SSL key negotiation is being attempted but the call to
 lonssl::KeyFile  failed.  This usually means that the  lonssl::KeyFile failed.  This usually means that the
 configuration file is not correctly defining or protecting  configuration file is not correctly defining or protecting
 the directories/files lonCertificateDirectory or  the directories/files lonCertificateDirectory or
 lonnetPrivateKey  lonnetPrivateKey

Removed from v.1.545  
changed lines
  Added in v.1.560


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