--- loncom/lond 2018/12/03 13:20:21 1.553
+++ 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.553 2018/12/03 13:20:21 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.553 $'; #' 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;
@@ -833,8 +834,8 @@ sub PushFile {
# hosts.tab ($filename eq host).
# domain.tab ($filename eq domain).
# dns_hosts.tab ($filename eq dns_host).
- # dns_domain.tab ($filename eq dns_domain).
- # loncapaCAcrl.pem ($filename eq loncapaCAcrl);
+ # dns_domain.tab ($filename eq dns_domain).
+ # loncapaCAcrl.pem ($filename eq loncapaCAcrl).
# Construct the destination filename or reject the request.
#
# lonManage is supposed to ensure this, however this session could be
@@ -5552,10 +5553,10 @@ sub del_balcookie_handler {
chomp($line);
if ($line eq $clientname) {
$dodelete = 1;
- last;
+ last;
}
}
- close($fh);
+ close($fh);
if ($dodelete) {
if (unlink("$execdir/$cookie.id")) {
$deleted = 1;
@@ -7099,7 +7100,7 @@ sub UpdateHosts {
my %oldconf = %secureconf;
my %connchange;
- if (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') {
+ if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
logthis(' Reloaded SSL connection rules and cleared CRL checking history ');
} else {
logthis(' Failed to reload SSL connection rules and clear CRL checking history ');
@@ -7381,7 +7382,7 @@ if ($arch eq 'unknown') {
chomp($arch);
}
-unless (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') {
+unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
&logthis('No connectionrules table. Will fallback to loncapa.conf');
}
@@ -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;
}