--- loncom/lond 2018/12/03 19:32:51 1.554
+++ loncom/lond 2021/03/31 02:19:58 1.566
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.554 2018/12/03 19:32:51 raeburn Exp $
+# $Id: lond,v 1.566 2021/03/31 02:19:58 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.554 $'; #' stupid emacs
+my $VERSION='$Revision: 1.566 $'; #' 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;
@@ -212,6 +213,7 @@ my %trust = (
autovalidateclass_sec => {catalog => 1},
autovalidatecourse => {remote => 1, enroll => 1},
autovalidateinstcode => {domroles => 1, remote => 1, enroll => 1},
+ autovalidateinstcrosslist => {remote => 1, enroll => 1},
changeuserauth => {remote => 1, domroles => 1},
chatretr => {remote => 1, enroll => 1},
chatsend => {remote => 1, enroll => 1},
@@ -219,6 +221,7 @@ my %trust = (
courseidput => {remote => 1, domroles => 1, enroll => 1},
courseidputhash => {remote => 1, domroles => 1, enroll => 1},
courselastaccess => {remote => 1, domroles => 1, enroll => 1},
+ coursesessions => {institutiononly => 1},
currentauth => {remote => 1, domroles => 1, enroll => 1},
currentdump => {remote => 1, enroll => 1},
currentversion => {remote=> 1, content => 1},
@@ -226,6 +229,7 @@ my %trust = (
dcmailput => {remote => 1, domroles => 1},
del => {remote => 1, domroles => 1, enroll => 1, content => 1},
delbalcookie => {institutiononly => 1},
+ delusersession => {institutiononly => 1},
deldom => {remote => 1, domroles => 1}, # not currently used
devalidatecache => {institutiononly => 1},
domroleput => {remote => 1, enroll => 1},
@@ -307,6 +311,7 @@ my %trust = (
tokenauthuserfile => {anywhere => 1},
unsub => {content => 1,},
update => {shared => 1},
+ updatebalcookie => {institutiononly => 1},
updateclickers => {remote => 1},
userhassession => {anywhere => 1},
userload => {anywhere => 1},
@@ -2029,7 +2034,7 @@ sub read_lonnet_global {
}
if ($what eq 'perlvar') {
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');
if (ref($othervarref) eq 'HASH') {
$items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
@@ -2347,12 +2352,84 @@ sub change_password_handler {
}
if($validated) {
my $realpasswd = &get_auth_type($udom, $uname); # Defined since authd.
-
my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
+ my $notunique;
if ($howpwd eq 'internal') {
&Debug("internal auth");
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";
if ($lonhost) {
$msg .= " - request originated from: $lonhost";
@@ -2369,7 +2446,7 @@ sub change_password_handler {
my $result = &change_unix_password($uname, $npass);
if ($result eq 'ok') {
&update_passwd_history($uname,$udom,$howpwd,$context);
- }
+ }
&logthis("Result of password change for $uname: ".
$result);
&Reply($client, \$result, $userinput);
@@ -2380,7 +2457,6 @@ sub change_password_handler {
#
&Failure( $client, "auth_mode_error\n", $userinput);
}
-
} else {
if ($failure eq '') {
$failure = 'non_authorized';
@@ -2961,6 +3037,54 @@ sub user_has_session_handler {
}
®ister_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;
+}
+
+®ister_handler("delusersession", \&del_usersession_handler, 0,1,0);
+
#
# Authenticate access to a user file by checking that the token the user's
# passed also exists in their session file
@@ -4752,6 +4876,44 @@ sub course_lastaccess_handler {
}
®ister_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);
+sub course_sessions_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($cdom,$cnum,$lastactivity) = split(':',$tail);
+ my $dbsuffix = '_'.$cdom.'_'.$cnum.'.db';
+ my (%sessions,$qresult);
+ my $now=time;
+ if (opendir(DIR,$perlvar{'lonIDsDir'})) {
+ my $filename;
+ while ($filename=readdir(DIR)) {
+ next if ($filename=~/^\./);
+ next if ($filename=~/^publicuser_/);
+ next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/);
+ if ($filename =~ /^($LONCAPA::match_username)_\d+_($LONCAPA::match_domain)_/) {
+ my ($uname,$udom) = ($1,$2);
+ next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix");
+ my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9];
+ if ($lastactivity < 0) {
+ next if ($mtime-$now > $lastactivity);
+ } else {
+ next if ($now-$mtime > $lastactivity);
+ }
+ $sessions{$uname.':'.$udom} = $mtime;
+ }
+ }
+ closedir(DIR);
+ }
+ foreach my $user (keys(%sessions)) {
+ $qresult.=&escape($user).'='.$sessions{$user}.'&';
+ }
+ if ($qresult) {
+ chop($qresult);
+ }
+ &Reply($client, \$qresult, $userinput);
+ return 1;
+}
+®ister_handler("coursesessions",\&course_sessions_handler, 0, 1, 0);
+
#
# Puts an unencrypted entry in a namespace db file at the domain level
#
@@ -4916,7 +5078,7 @@ sub del_domain_handler {
# domain directory.
#
# Parameters:
-# $cmd - Command request keyword (get).
+# $cmd - Command request keyword (getdom).
# $tail - Tail of the command. This is a colon separated list
# consisting of the domain and the 'namespace'
# which selects the gdbm file to do the lookup in,
@@ -4933,31 +5095,17 @@ sub del_domain_handler {
sub get_domain_handler {
my ($cmd, $tail, $client) = @_;
-
my $userinput = "$cmd:$tail";
my ($udom,$namespace,$what)=split(/:/,$tail,3);
- chomp($what);
if ($namespace =~ /^enc/) {
&Failure( $client, "refused\n", $userinput);
} else {
- my @queries=split(/\&/,$what);
- my $qresult='';
- my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
- if ($hashref) {
- for (my $i=0;$i<=$#queries;$i++) {
- $qresult.="$hashref->{$queries[$i]}&";
- }
- if (&untie_domain_hash($hashref)) {
- $qresult=~s/\&$//;
- &Reply($client, \$qresult, $userinput);
- } else {
- &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting getdom\n",$userinput);
- }
+ my $res = LONCAPA::Lond::get_dom($userinput);
+ if ($res =~ /^error:/) {
+ &Failure($client, \$res, $userinput);
} else {
- &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting getdom\n",$userinput);
+ &Reply($client, \$res, $userinput);
}
}
@@ -4970,38 +5118,24 @@ sub encrypted_get_domain_handler {
my $userinput = "$cmd:$tail";
- my ($udom,$namespace,$what)=split(/:/,$tail,3);
- chomp($what);
- my @queries=split(/\&/,$what);
- my $qresult='';
- my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());
- if ($hashref) {
- for (my $i=0;$i<=$#queries;$i++) {
- $qresult.="$hashref->{$queries[$i]}&";
- }
- if (&untie_domain_hash($hashref)) {
- $qresult=~s/\&$//;
- if ($cipher) {
- my $cmdlength=length($qresult);
- $qresult.=" ";
- my $encqresult='';
- for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
- $encqresult.= unpack("H16",
- $cipher->encrypt(substr($qresult,
- $encidx,
- 8)));
- }
- &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);
- } else {
- &Failure( $client, "error:no_key\n", $userinput);
+ my $res = LONCAPA::Lond::get_dom($userinput);
+ if ($res =~ /^error:/) {
+ &Failure($client, \$res, $userinput);
+ } else {
+ if ($cipher) {
+ my $cmdlength=length($res);
+ $res.=" ";
+ my $encres='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encres.= unpack("H16",
+ $cipher->encrypt(substr($res,
+ $encidx,
+ 8)));
}
+ &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
} else {
- &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting egetdom\n",$userinput);
+ &Failure( $client, "error:no_key\n",$userinput);
}
- } else {
- &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting egetdom\n",$userinput);
}
return 1;
}
@@ -5523,8 +5657,65 @@ sub tmp_del_handler {
®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
#
+# Process the updatebalcookie command. This command updates a
+# cookie in the lonBalancedir directory on a load balancer node.
+#
+# Parameters:
+# $cmd - Command that got us here.
+# $tail - Tail of the request (escaped cookie: escaped current entry)
+#
+# $client - socket open on the client process.
+#
+# Returns:
+# 1 - Indicating processing should continue.
+# Side Effects:
+# A cookie file is updated from the lonBalancedir directory
+# A reply is sent to the client.
+#
+sub update_balcookie_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput= "$cmd:$tail";
+ chomp($tail);
+ my ($cookie,$lastentry) = map { &unescape($_) } (split(/:/,$tail));
+
+ my $updatedone;
+ if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
+ my $execdir=$perlvar{'lonBalanceDir'};
+ if (-e "$execdir/$cookie.id") {
+ my $doupdate;
+ if (open(my $fh,'<',"$execdir/$cookie.id")) {
+ while (my $line = <$fh>) {
+ chomp($line);
+ if ($line eq $lastentry) {
+ $doupdate = 1;
+ last;
+ }
+ }
+ close($fh);
+ }
+ if ($doupdate) {
+ if (open(my $fh,'>',"$execdir/$cookie.id")) {
+ print $fh $clientname;
+ close($fh);
+ $updatedone = 1;
+ }
+ }
+ }
+ }
+ if ($updatedone) {
+ &Reply($client, "ok\n", $userinput);
+ } else {
+ &Failure( $client, "error: ".($!+0)."file update failed ".
+ "while attempting updatebalcookie\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("updatebalcookie", \&update_balcookie_handler, 0, 1, 0);
+
+#
# Process the delbalcookie command. This command deletes a balancer
-# cookie in the lonBalancedir directory created by switchserver
+# cookie in the lonBalancedir directory on a load balancer node.
#
# Parameters:
# $cmd - Command that got us here.
@@ -5542,6 +5733,7 @@ sub del_balcookie_handler {
my $userinput= "$cmd:$cookie";
chomp($cookie);
+ $cookie = &unescape($cookie);
my $deleted = '';
if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
my $execdir=$perlvar{'lonBalanceDir'};
@@ -5757,6 +5949,39 @@ sub validate_instcode_handler {
}
®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);
+#
+# Validate co-owner for cross-listed institutional code and
+# institutional course code itself used for a LON-CAPA course.
+#
+# Formal Parameters:
+# $cmd - The command request that got us dispatched.
+# $tail - The tail of the command. In this case,
+# this is a colon separated string containing:
+# $dom - Course's LON-CAPA domain
+# $instcode - Institutional course code for the course
+# $inst_xlist - Institutional course Id for the crosslisting
+# $coowner - Username of co-owner
+# (values for all but $dom have been escaped).
+#
+# $client - Socket open on the client.
+# Returns:
+# 1 - Indicating processing should continue.
+#
+sub validate_instcrosslist_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($dom,$instcode,$inst_xlist,$coowner) = split(/:/,$tail);
+ $instcode = &unescape($instcode);
+ $inst_xlist = &unescape($inst_xlist);
+ $coowner = &unescape($coowner);
+ my $outcome = &localenroll::validate_crosslist_access($dom,$instcode,
+ $inst_xlist,$coowner);
+ &Reply($client, \$outcome, $userinput);
+
+ return 1;
+}
+®ister_handler("autovalidateinstcrosslist", \&validate_instcrosslist_handler, 0, 1, 0);
+
# Get the official sections for which auto-enrollment is possible.
# Since the admin people won't know about 'unofficial sections'
# we cannot auto-enroll on them.
@@ -7099,7 +7324,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 +7606,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');
}
@@ -7470,7 +7695,7 @@ sub make_new_child {
&Authen::Krb5::init_context();
my $no_ets;
- if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) {
+ if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) {
if ($1 >= 7) {
$no_ets = 1;
}
@@ -7515,7 +7740,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 +7841,6 @@ sub make_new_child {
}
} else {
- $clientinfoset = &set_client_info();
my $ok = InsecureConnection($client);
if($ok) {
$clientok = 1;
@@ -7654,34 +7878,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 +7911,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.
#
@@ -7741,7 +7946,7 @@ sub set_client_info {
my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);
my $samedom = 0;
- if ($perlvar{'lonDefDom'} eq $homedom) {
+ if ($perlvar{'lonDefDomain'} eq $homedom) {
$samedom = 1;
}
my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);
@@ -7761,6 +7966,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 +8720,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 +8797,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;
}