Diff for /loncom/lond between versions 1.555 and 1.557

version 1.555, 2018/12/11 13:05:40 version 1.557, 2019/02/11 17:01:34
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 7515  sub make_new_child { Line 7516  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 7616  sub make_new_child { Line 7617  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 7654  sub make_new_child { Line 7654  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 7714  sub make_new_child { Line 7687  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 7741  sub set_client_info { Line 7722  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 7761  sub set_client_info { Line 7742  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 8508  sub sethost { Line 8496  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 8584  sub get_prohibited { Line 8573  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;
 }  }

Removed from v.1.555  
changed lines
  Added in v.1.557


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