--- loncom/lond 2018/12/11 13:05:40 1.555 +++ loncom/lond 2018/12/13 03:23:05 1.556 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.555 2018/12/11 13:05:40 raeburn Exp $ +# $Id: lond,v 1.556 2018/12/13 03:23:05 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -65,7 +65,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.555 $'; #' stupid emacs +my $VERSION='$Revision: 1.556 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -80,11 +80,12 @@ my $clientsamedom; # LonCAP # and client. my $clientsameinst; # LonCAPA "internet domain" same for # this host and client. -my $clientremoteok; # Client allowed to host domain's users. - # (version constraints ignored), not set - # if this host and client share "internet domain". -my %clientprohibited; # Actions prohibited on client; - +my $clientremoteok; # Current domain permits hosting on client + # (not set if host and client share "internet domain"). + # Values are 0 or 1; 1 if allowed. +my %clientprohibited; # Commands from client prohibited for domain's + # users. + my $server; my $keymode; @@ -7515,7 +7516,7 @@ sub make_new_child { $ConnectionType = "manager"; $clientname = $managers{$outsideip}; } - my ($clientok,$clientinfoset); + my $clientok; if ($clientrec || $ismanager) { &status("Waiting for init from $clientip $clientname"); @@ -7616,7 +7617,6 @@ sub make_new_child { } } else { - $clientinfoset = &set_client_info(); my $ok = InsecureConnection($client); if($ok) { $clientok = 1; @@ -7654,34 +7654,7 @@ sub make_new_child { # ------------------------------------------------------------ Process requests my $keep_going = 1; 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) { alarm(120); Debug("Main: Got $user_input\n"); @@ -7714,22 +7687,30 @@ sub make_new_child { # # 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. # If not specified, defaults to the package variable: $clientname # # 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 -# same domain as the server, and (b) true if client is in the same internet -# domain. +# same domain as the server, and (b) true if client is in the same +# internet domain. # # If called in scalar context, sets package variables for current client: # -# $clienthomedom - LonCAPA domain of homeID for client. -# $clientsamedom - LonCAPA domain same for this host and client. -# $clientintdom - LonCAPA "internet domain" for client. -# $clientsameinst - LonCAPA "internet domain" same for this host & client. +# $clienthomedom - LonCAPA domain of homeID for client. +# $clientsamedom - LonCAPA domain same for this host and client. +# $clientintdom - LonCAPA "internet domain" for 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. # @@ -7761,6 +7742,13 @@ sub set_client_info { $clientsamedom = $samedom; $clientintdom = $intdom; $clientsameinst = $sameinst; + if ($clientsameinst) { + undef($clientremoteok); + undef(%clientprohibited); + } else { + $clientremoteok = &get_remote_hostable($currentdomainid); + %clientprohibited = &get_prohibited($currentdomainid); + } return 1; } } @@ -8508,6 +8496,7 @@ sub sethost { eq &Apache::lonnet::get_host_ip($hostid)) { $currenthostid =$hostid; $currentdomainid=&Apache::lonnet::host_domain($hostid); + &set_client_info(); # &logthis("Setting hostid to $hostid, and domain to $currentdomainid"); } else { &logthis("Requested host id $hostid not an alias of ". @@ -8584,6 +8573,32 @@ sub get_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 { return $dist.':'.$arch; }