--- loncom/lond 2016/09/24 15:35:25 1.529
+++ loncom/lond 2019/07/18 18:28:40 1.560
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.529 2016/09/24 15:35:25 raeburn Exp $
+# $Id: lond,v 1.560 2019/07/18 18:28:40 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -35,6 +35,7 @@ use LONCAPA;
use LONCAPA::Configuration;
use LONCAPA::Lond;
+use Socket;
use IO::Socket;
use IO::File;
#use Apache::File;
@@ -64,7 +65,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.529 $'; #' stupid emacs
+my $VERSION='$Revision: 1.560 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -75,13 +76,16 @@ my $clientname; # LonCAPA name of clie
my $clientversion; # LonCAPA version running on client.
my $clienthomedom; # LonCAPA domain of homeID for client.
my $clientintdom; # LonCAPA "internet domain" for client.
+my $clientsamedom; # LonCAPA domain same for this host
+ # 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;
@@ -102,6 +106,13 @@ my %managers; # Ip -> manager names
my %perlvar; # Will have the apache conf defined perl vars.
+my %secureconf; # Will have requirements for security
+ # of lond connections
+
+my %crlchecked; # Will contain clients for which the client's SSL
+ # has been checked against the cluster's Certificate
+ # Revocation List.
+
my $dist;
#
@@ -166,6 +177,7 @@ my @installerrors = ("ok",
# shared ("Access to other domain's content by this domain")
# enroll ("Enrollment in this domain's courses by others")
# 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")
# catalog ("Course Catalog for this domain displayed elsewhere")
# reqcrs ("Requests for creation of courses in this domain by others")
@@ -214,6 +226,8 @@ my %trust = (
dcmaildump => {remote => 1, domroles => 1},
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},
@@ -223,7 +237,8 @@ my %trust = (
dump => {remote => 1, enroll => 1, domroles => 1},
edit => {institutiononly => 1}, #not used currently
eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently
- ekey => {}, #not used currently
+ egetdom => {remote => 1, domroles => 1, enroll => 1, },
+ ekey => {anywhere => 1},
exit => {anywhere => 1},
fetchuserfile => {remote => 1, enroll => 1},
get => {remote => 1, domroles => 1, enroll => 1},
@@ -259,6 +274,17 @@ my %trust = (
putstore => {remote => 1, enroll => 1},
queryreply => {anywhere => 1},
querysend => {anywhere => 1},
+ querysend_activitylog => {remote => 1},
+ querysend_allusers => {remote => 1, domroles => 1},
+ querysend_courselog => {remote => 1},
+ querysend_fetchenrollment => {remote => 1},
+ querysend_getinstuser => {remote => 1},
+ querysend_getmultinstusers => {remote => 1},
+ querysend_instdirsearch => {remote => 1, domroles => 1, coaurem => 1},
+ querysend_institutionalphotos => {remote => 1},
+ querysend_portfolio_metadata => {remote => 1, content => 1},
+ querysend_userlog => {remote => 1, domroles => 1},
+ querysend_usersearch => {remote => 1, enroll => 1, coaurem => 1},
quit => {anywhere => 1},
readlonnetglobal => {institutiononly => 1},
reinit => {manageronly => 1}, #not used currently
@@ -277,9 +303,9 @@ my %trust = (
store => {remote => 1, enroll => 1, reqcrs => 1,},
studentphoto => {remote => 1, enroll => 1},
sub => {content => 1,},
- tmpdel => {anywhere => 1},
- tmpget => {anywhere => 1},
- tmpput => {anywhere => 1},
+ tmpdel => {institutiononly => 1},
+ tmpget => {institutiononly => 1},
+ tmpput => {remote => 1, othcoau => 1},
tokenauthuserfile => {anywhere => 1},
unsub => {content => 1,},
update => {shared => 1},
@@ -402,10 +428,19 @@ sub SSLConnection {
Debug("Approving promotion -> ssl");
# And do so:
+ my $CRLFile;
+ unless ($crlchecked{$clientname}) {
+ $CRLFile = lonssl::CRLFile();
+ $crlchecked{$clientname} = 1;
+ }
+
my $SSLSocket = lonssl::PromoteServerSocket($Socket,
$CACertificate,
$Certificate,
- $KeyFile);
+ $KeyFile,
+ $clientname,
+ $CRLFile,
+ $clientversion);
if(! ($SSLSocket) ) { # SSL socket promotion failed.
my $err = lonssl::LastError();
&logthis(" CRITICAL "
@@ -445,8 +480,23 @@ sub InsecureConnection {
my $Socket = shift;
# Don't even start if insecure connections are not allowed.
-
- if(! $perlvar{londAllowInsecure}) { # Insecure connections not allowed.
+ # return 0 if Insecure connections not allowed.
+ #
+ if (ref($secureconf{'connfrom'}) eq 'HASH') {
+ if ($clientsamedom) {
+ if ($secureconf{'connfrom'}{'dom'} eq 'req') {
+ return 0;
+ }
+ } elsif ($clientsameinst) {
+ if ($secureconf{'connfrom'}{'intdom'} eq 'req') {
+ return 0;
+ }
+ } else {
+ if ($secureconf{'connfrom'}{'other'} eq 'req') {
+ return 0;
+ }
+ }
+ } elsif (!$perlvar{londAllowInsecure}) {
return 0;
}
@@ -746,10 +796,17 @@ sub ConfigFileFromSelector {
my $selector = shift;
my $tablefile;
- my $tabledir = $perlvar{'lonTabDir'}.'/';
- if (($selector eq "hosts") || ($selector eq "domain") ||
- ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {
- $tablefile = $tabledir.$selector.'.tab';
+ if ($selector eq 'loncapaCAcrl') {
+ my $tabledir = $perlvar{'lonCertificateDirectory'};
+ if (-d $tabledir) {
+ $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;
}
@@ -773,12 +830,13 @@ sub PushFile {
my ($command, $filename, $contents) = split(":", $request, 3);
&Debug("PushFile");
- # At this point in time, pushes for only the following tables are
- # supported:
+ # At this point in time, pushes for only the following tables and
+ # CRL file are supported:
# hosts.tab ($filename eq host).
# domain.tab ($filename eq domain).
# 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.
#
# lonManage is supposed to ensure this, however this session could be
@@ -799,7 +857,8 @@ sub PushFile {
if($filename eq "host") {
$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 '') {
&logthis(' Pushfile: unable to install '
.$tablefile." - no data received from push. ");
@@ -810,8 +869,13 @@ sub PushFile {
if ($managers{$clientip} eq $clientname) {
my $clientprotocol = $Apache::lonnet::protocol{$clientname};
$clientprotocol = 'http' if ($clientprotocol ne 'https');
- my $url = '/adm/'.$filename;
- $url =~ s{_}{/};
+ my $url;
+ if ($filename eq 'loncapaCAcrl') {
+ $url = '/adm/dns/loncapaCRL';
+ } else {
+ $url = '/adm/'.$filename;
+ $url =~ s{_}{/};
+ }
my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");
my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0);
if ($response->is_error()) {
@@ -1572,13 +1636,15 @@ sub du2_handler {
# If the requested path contains /../ or is:
#
# 1. for a directory, and the path does not begin with one of:
-# (a) /home/httpd/html/res//
-# (b) /home/httpd/html/res/userfiles/
+# (a) /home/httpd/html/res/
+# (b) /home/httpd/html/userfiles/
# (c) /home/httpd/lonUsers//<1>/<2>/<3>//userfiles
# or is:
#
-# 2. for a file, and the path (after prepending) does not begin with:
-# /home/httpd/lonUsers//<1>/<2>/<3>//
+# 2. for a file, and the path (after prepending) does not begin with one of:
+# (a) /home/httpd/lonUsers//<1>/<2>/<3>//
+# (b) /home/httpd/html/res///
+# (c) /home/httpd/html/userfiles///
#
# the response will be "refused".
#
@@ -1609,8 +1675,8 @@ sub ls_handler {
}
if (-e $ulsdir) {
if(-d $ulsdir) {
- unless (($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain|userfiles)/}) ||
- ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/})) {
+ unless (($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
+ ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles})) {
&Failure($client,"refused\n",$userinput);
return 1;
}
@@ -1637,7 +1703,8 @@ sub ls_handler {
closedir(LSDIR);
}
} else {
- unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) {
+ unless (($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
+ ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/})) {
&Failure($client,"refused\n",$userinput);
return 1;
}
@@ -1669,13 +1736,15 @@ sub ls_handler {
# If the requested path contains /../ or is:
#
# 1. for a directory, and the path does not begin with one of:
-# (a) /home/httpd/html/res//
-# (b) /home/httpd/html/res/userfiles/
+# (a) /home/httpd/html/res/
+# (b) /home/httpd/html/userfiles/
# (c) /home/httpd/lonUsers//<1>/<2>/<3>//userfiles
# or is:
#
-# 2. for a file, and the path (after prepending) does not begin with:
-# /home/httpd/lonUsers//<1>/<2>/<3>//
+# 2. for a file, and the path (after prepending) does not begin with one of:
+# (a) /home/httpd/lonUsers//<1>/<2>/<3>//
+# (b) /home/httpd/html/res///
+# (c) /home/httpd/html/userfiles///
#
# the response will be "refused".
#
@@ -1705,8 +1774,8 @@ sub ls2_handler {
}
if (-e $ulsdir) {
if(-d $ulsdir) {
- unless (($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain|userfiles)/}) ||
- ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/})) {
+ unless (($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
+ ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles})) {
&Failure($client,"refused\n","$userinput");
return 1;
}
@@ -1734,7 +1803,8 @@ sub ls2_handler {
closedir(LSDIR);
}
} else {
- unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) {
+ unless (($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
+ ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/})) {
&Failure($client,"refused\n",$userinput);
return 1;
}
@@ -1758,15 +1828,18 @@ sub ls2_handler {
# If the requested path (after prepending) contains /../ or is:
#
# 1. for a directory, and the path does not begin with one of:
-# (a) /home/httpd/html/res//
-# (b) /home/httpd/html/res/userfiles/
+# (a) /home/httpd/html/res/
+# (b) /home/httpd/html/userfiles/
# (c) /home/httpd/lonUsers//<1>/<2>/<3>//userfiles
-# (d) /home/httpd/html/priv// and client is the homeserver
+# (d) /home/httpd/html/priv/ and client is the homeserver
#
-# or is:
+# or is:
#
-# 2. for a file, and the path (after prepending) does not begin with:
-# /home/httpd/lonUsers//<1>/<2>/<3>//
+# 2. for a file, and the path (after prepending) does not begin with one of:
+# (a) /home/httpd/lonUsers//<1>/<2>/<3>//
+# (b) /home/httpd/html/res///
+# (c) /home/httpd/html/userfiles///
+# (d) /home/httpd/html/priv/// and client is the homeserver
#
# the response will be "refused".
#
@@ -1840,17 +1913,43 @@ sub ls3_handler {
my $rights;
my $ulsout='';
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(-d $ulsdir) {
unless (($getpropath) || ($getuserdir) ||
- ($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain|userfiles)/}) ||
- ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/}) ||
- (($ulsdir =~ m{/home/httpd/html/priv/$LONCAPA::match_domain/}) && ($islocal))) {
+ ($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
+ ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles}) ||
+ (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal))) {
&Failure($client,"refused\n",$userinput);
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)) {
+ if (($crscheck) && ($toplevel) && ($currdom ne '') &&
+ ($ulsfn =~ /^$LONCAPA::match_courseid$/) && (-d "$ulsdir/$ulsfn")) {
+ if (&LONCAPA::Lond::is_course($currdom,$ulsfn)) {
+ next;
+ }
+ }
undef($obs);
undef($rights);
my @ulsstats=stat($ulsdir.'/'.$ulsfn);
@@ -1874,7 +1973,9 @@ sub ls3_handler {
}
} else {
unless (($getpropath) || ($getuserdir) ||
- ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/})) {
+ ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
+ ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/}) ||
+ (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain/$LONCAPA::match_name/}) && ($islocal))) {
&Failure($client,"refused\n",$userinput);
return 1;
}
@@ -1901,15 +2002,17 @@ sub read_lonnet_global {
);
my %limit_to = (
perlvar => {
- lonOtherAuthen => 1,
- lonBalancer => 1,
- lonVersion => 1,
- lonSysEMail => 1,
- lonHostID => 1,
- lonRole => 1,
- lonDefDomain => 1,
- lonLoadLim => 1,
- lonUserLoadLim => 1,
+ lonOtherAuthen => 1,
+ lonBalancer => 1,
+ lonVersion => 1,
+ lonAdmEMail => 1,
+ lonSupportEMail => 1,
+ lonSysEMail => 1,
+ lonHostID => 1,
+ lonRole => 1,
+ lonDefDomain => 1,
+ lonLoadLim => 1,
+ lonUserLoadLim => 1,
}
);
if (ref($requested) eq 'HASH') {
@@ -1928,7 +2031,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'};
@@ -2024,8 +2127,8 @@ sub server_distarch_handler {
sub server_certs_handler {
my ($cmd,$tail,$client) = @_;
my $userinput = "$cmd:$tail";
- my $result;
- my $result = &LONCAPA::Lond::server_certs(\%perlvar);
+ my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'});
+ my $result = &LONCAPA::Lond::server_certs(\%perlvar,$perlvar{'lonHostID'},$hostname);
&Reply($client,\$result,$userinput);
return;
}
@@ -2246,12 +2349,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";
@@ -2279,7 +2454,6 @@ sub change_password_handler {
#
&Failure( $client, "auth_mode_error\n", $userinput);
}
-
} else {
if ($failure eq '') {
$failure = 'non_authorized';
@@ -2300,12 +2474,8 @@ sub hash_passwd {
my $plainsalt = substr($rest[1],0,22);
$salt = Crypt::Eksblowfish::Bcrypt::de_base64($plainsalt);
} else {
- my $defaultcost;
- my %domconfig =
- &Apache::lonnet::get_dom('configuration',['password'],$domain);
- if (ref($domconfig{'password'}) eq 'HASH') {
- $defaultcost = $domconfig{'password'}{'cost'};
- }
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
+ my $defaultcost = $domdefaults{'intauth_cost'};
if (($defaultcost eq '') || ($defaultcost =~ /D/)) {
$cost = 10;
} else {
@@ -2560,32 +2730,26 @@ sub update_resource_handler {
my $transname="$fname.in.transfer";
my $remoteurl=&Apache::lonnet::reply("sub:$fname","$clientname");
my $response;
-# FIXME: cannot replicate files that take more than two minutes to transfer?
-# alarm(120);
-# FIXME: this should use the LWP mechanism, not internal alarms.
- alarm(1200);
- {
- my $request=new HTTP::Request('GET',"$remoteurl");
- $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1);
- }
- alarm(0);
+# FIXME: cannot replicate files that take more than two minutes to transfer -- needs checking now 1200s timeout used
+# for LWP request.
+ my $request=new HTTP::Request('GET',"$remoteurl");
+ $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1);
if ($response->is_error()) {
-# FIXME: we should probably clean up here instead of just whine
- unlink($transname);
+ my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");
+ &devalidate_meta_cache($fname);
+ if (-e $transname) {
+ unlink($transname);
+ }
+ unlink($fname);
my $message=$response->status_line;
&logthis("LWP GET: $message for $fname ($remoteurl)");
} else {
if ($remoteurl!~/\.meta$/) {
-# FIXME: isn't there an internal LWP mechanism for this?
- alarm(120);
- {
- my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
- my $mresponse = &LONCAPA::LWPReq::makerequest($clientname,$mrequest,$fname.'.meta',\%perlvar,120,0,1);
- if ($mresponse->is_error()) {
- unlink($fname.'.meta');
- }
+ my $mrequest=new HTTP::Request('GET',$remoteurl.'.meta');
+ my $mresponse = &LONCAPA::LWPReq::makerequest($clientname,$mrequest,$fname.'.meta',\%perlvar,120,0,1);
+ if ($mresponse->is_error()) {
+ unlink($fname.'.meta');
}
- alarm(0);
}
# we successfully transfered, copy file over to real name
rename($transname,$fname);
@@ -2655,17 +2819,13 @@ sub fetch_user_file_handler {
my $remoteurl=$clientprotocol.'://'.$clienthost.'/userfiles/'.$fname;
my $response;
Debug("Remote URL : $remoteurl Transfername $transname Destname: $destname");
- alarm(1200);
- {
- my $request=new HTTP::Request('GET',"$remoteurl");
- my $verifycert = 1;
- my @machine_ids = &Apache::lonnet::current_machine_ids();
- if (grep(/^\Q$clientname\E$/,@machine_ids)) {
- $verifycert = 0;
- }
- $response = &LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,$verifycert);
- }
- alarm(0);
+ my $request=new HTTP::Request('GET',"$remoteurl");
+ my $verifycert = 1;
+ my @machine_ids = &Apache::lonnet::current_machine_ids();
+ if (grep(/^\Q$clientname\E$/,@machine_ids)) {
+ $verifycert = 0;
+ }
+ $response = &LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,$verifycert);
if ($response->is_error()) {
unlink($transname);
my $message=$response->status_line;
@@ -2874,6 +3034,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
@@ -3363,7 +3571,8 @@ sub get_profile_entry {
#
# Parameters:
# $cmd - Command keyword of request (eget).
-# $tail - Tail of the command. See GetProfileEntry
# for more information about this.
+# $tail - Tail of the command. See GetProfileEntry
+# for more information about this.
# $client - File open on the client.
# Returns:
# 1 - Continue processing
@@ -3935,7 +4144,7 @@ sub retrieve_chat_handler {
# serviced.
#
# Parameters:
-# $cmd - COmmand keyword that initiated the request.
+# $cmd - Command keyword that initiated the request.
# $tail - Remainder of the command after the keyword.
# For this function, this consists of a query and
# 3 arguments that are self-documentingly labelled
@@ -3949,11 +4158,41 @@ sub retrieve_chat_handler {
sub send_query_handler {
my ($cmd, $tail, $client) = @_;
-
my $userinput = "$cmd:$tail";
my ($query,$arg1,$arg2,$arg3)=split(/\:/,$tail);
$query=~s/\n*$//g;
+ if (($query eq 'usersearch') || ($query eq 'instdirsearch')) {
+ my $usersearchconf = &get_usersearch_config($currentdomainid,'directorysrch');
+ my $earlyout;
+ if (ref($usersearchconf) eq 'HASH') {
+ if ($currentdomainid eq $clienthomedom) {
+ if ($query eq 'usersearch') {
+ if ($usersearchconf->{'lcavailable'} eq '0') {
+ $earlyout = 1;
+ }
+ } else {
+ if ($usersearchconf->{'available'} eq '0') {
+ $earlyout = 1;
+ }
+ }
+ } else {
+ if ($query eq 'usersearch') {
+ if ($usersearchconf->{'lclocalonly'}) {
+ $earlyout = 1;
+ }
+ } else {
+ if ($usersearchconf->{'localonly'}) {
+ $earlyout = 1;
+ }
+ }
+ }
+ }
+ if ($earlyout) {
+ &Reply($client, "query_not_authorized\n");
+ return 1;
+ }
+ }
&Reply($client, "". &sql_reply("$clientname\&$query".
"\&$arg1"."\&$arg2"."\&$arg3")."\n",
$userinput);
@@ -4816,7 +5055,41 @@ sub get_domain_handler {
my ($cmd, $tail, $client) = @_;
- my $userinput = "$client:$tail";
+ 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);
+ }
+ } else {
+ &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
+ "while attempting getdom\n",$userinput);
+ }
+ }
+
+ return 1;
+}
+®ister_handler("getdom", \&get_domain_handler, 0, 1, 0);
+
+sub encrypted_get_domain_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
my ($udom,$namespace,$what)=split(/:/,$tail,3);
chomp($what);
@@ -4829,19 +5102,31 @@ sub get_domain_handler {
}
if (&untie_domain_hash($hashref)) {
$qresult=~s/\&$//;
- &Reply($client, \$qresult, $userinput);
+ 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);
+ }
} else {
&Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting getdom\n",$userinput);
+ "while attempting egetdom\n",$userinput);
}
} else {
&Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".
- "while attempting getdom\n",$userinput);
+ "while attempting egetdom\n",$userinput);
}
-
return 1;
}
-®ister_handler("getdom", \&get_domain_handler, 0, 1, 0);
+®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);
#
# Puts an id to a domains id database.
@@ -5359,6 +5644,58 @@ sub tmp_del_handler {
®ister_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;
+}
+®ister_handler("delbalcookie", \&del_balcookie_handler, 0, 1, 0);
+
+#
# Processes the setannounce command. This command
# creates a file named announce.txt in the top directory of
# the documentn root and sets its contents. The announce.txt file is
@@ -5637,9 +5974,10 @@ sub validate_course_section_handler {
# Formal Parameters:
# $cmd - The command request that got us dispatched.
# $tail - The tail of the command. In this case this is a colon separated
-# set of words that will be split into:
+# set of values that will be split into:
# $inst_class - Institutional code for the specific class section
-# $courseowner - The escaped username:domain of the course owner
+# $ownerlist - An escaped comma-separated list of username:domain
+# of the course owner, and co-owner(s).
# $cdom - The domain of the course from the institution's
# point of view.
# $client - The socket open on the client.
@@ -5664,6 +6002,56 @@ sub validate_class_access_handler {
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
#
+# Validate course owner or co-owners(s) access to enrollment data for all sections
+# and crosslistings for a particular 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
+# set of values that will be split into:
+# $ownerlist - An escaped comma-separated list of username:domain
+# of the course owner, and co-owner(s).
+# $cdom - The domain of the course from the institution's
+# point of view.
+# $classes - Frozen hash of institutional course sections and
+# crosslistings.
+# $client - The socket open on the client.
+# Returns:
+# 1 - continue processing.
+#
+
+sub validate_classes_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($ownerlist,$cdom,$classes) = split(/:/, $tail);
+ my $classesref = &Apache::lonnet::thaw_unescape($classes);
+ my $owners = &unescape($ownerlist);
+ my $result;
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ my %validations;
+ my $response = &localenroll::check_instclasses($owners,$cdom,$classesref,
+ \%validations);
+ if ($response eq 'ok') {
+ foreach my $key (keys(%validations)) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ } else {
+ $result = 'error';
+ }
+ };
+ if (!$@) {
+ &Reply($client, \$result, $userinput);
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+ return 1;
+}
+®ister_handler("autovalidateinstclasses", \&validate_classes_handler, 0, 1, 0);
+
+#
# Create a password for a new LON-CAPA user added by auto-enrollment.
# Only used for case where authentication method for new user is localauth
#
@@ -5741,7 +6129,7 @@ sub auto_export_grades_handler {
return 1;
}
®ister_handler("autoexportgrades", \&auto_export_grades_handler,
- 0, 1, 0);
+ 1, 1, 0);
# Retrieve and remove temporary files created by/during autoenrollment.
#
@@ -6492,6 +6880,18 @@ sub process_request {
$ok = 0;
}
if ($ok) {
+ my $realcommand = $command;
+ if ($command eq 'querysend') {
+ my ($query,$rest)=split(/\:/,$tail,2);
+ $query=~s/\n*$//g;
+ my @possqueries =
+ qw(userlog courselog fetchenrollment institutionalphotos usersearch instdirsearch getinstuser getmultinstusers);
+ if (grep(/^\Q$query\E$/,@possqueries)) {
+ $command .= '_'.$query;
+ } elsif ($query eq 'prepare activity log') {
+ $command .= '_activitylog';
+ }
+ }
if (ref($trust{$command}) eq 'HASH') {
my $donechecks;
if ($trust{$command}{'anywhere'}) {
@@ -6533,6 +6933,7 @@ sub process_request {
}
}
}
+ $command = $realcommand;
}
if($ok) {
@@ -6684,8 +7085,8 @@ my $wwwid=getpwnam('www');
if ($wwwid!=$<) {
my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
my $subj="LON: $currenthostid User ID mismatch";
- system("echo 'User ID mismatch. lond must be run as user www.' |\
- mailto $emailto -s '$subj' > /dev/null");
+ system("echo 'User ID mismatch. lond must be run as user www.' |".
+ " mail -s '$subj' $emailto > /dev/null");
exit 1;
}
@@ -6801,6 +7202,7 @@ sub UpdateHosts {
# will take care of new and changed hosts as connections come into being.
&Apache::lonnet::reset_hosts_info();
+ my %active;
foreach my $child (keys(%children)) {
my $childip = $children{$child};
@@ -6810,15 +7212,62 @@ sub UpdateHosts {
." $child for ip $childip ");
kill('INT', $child);
} else {
+ $active{$child} = $childip;
logthis(' keeping child for ip '
." $childip (pid=$child) ");
}
}
+
+ my %oldconf = %secureconf;
+ my %connchange;
+ 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 ');
+ }
+ if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) {
+ foreach my $type ('dom','intdom','other') {
+ if ((($oldconf{'connfrom'}{$type} eq 'no') && ($secureconf{'connfrom'}{$type} eq 'req')) ||
+ (($oldconf{'connfrom'}{$type} eq 'req') && ($secureconf{'connfrom'}{$type} eq 'no'))) {
+ $connchange{$type} = 1;
+ }
+ }
+ }
+ if (keys(%connchange)) {
+ foreach my $child (keys(%active)) {
+ my $childip = $active{$child};
+ if ($childip ne '127.0.0.1') {
+ my $childhostname = gethostbyaddr(Socket::inet_aton($childip),AF_INET);
+ if ($childhostname ne '') {
+ my $childlonhost = &Apache::lonnet::get_server_homeID($childhostname);
+ my ($samedom,$sameinst) = &set_client_info($childlonhost);
+ if ($samedom) {
+ if ($connchange{'dom'}) {
+ logthis(' UpdateHosts killing child '
+ ." $child for ip $childip ");
+ kill('INT', $child);
+ }
+ } elsif ($sameinst) {
+ if ($connchange{'intdom'}) {
+ logthis(' UpdateHosts killing child '
+ ." $child for ip $childip ");
+ kill('INT', $child);
+ }
+ } else {
+ if ($connchange{'other'}) {
+ logthis(' UpdateHosts killing child '
+ ." $child for ip $childip ");
+ kill('INT', $child);
+ }
+ }
+ }
+ }
+ }
+ }
ReloadApache;
&status("Finished reloading hosts.tab");
}
-
sub checkchildren {
&status("Checking on the children (sending signals)");
&initnewstatus();
@@ -7053,6 +7502,10 @@ if ($arch eq 'unknown') {
chomp($arch);
}
+unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
+ &logthis('No connectionrules table. Will fallback to loncapa.conf');
+}
+
# --------------------------------------------------------------
# Accept connections. When a connection comes in, it is validated
# and if good, a child process is created to process transactions
@@ -7138,7 +7591,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;
}
@@ -7211,7 +7664,32 @@ sub make_new_child {
# If the connection type is ssl, but I didn't get my
# certificate files yet, then I'll drop back to
# insecure (if allowed).
-
+
+ if ($inittype eq "ssl") {
+ my $context;
+ if ($clientsamedom) {
+ $context = 'dom';
+ if ($secureconf{'connfrom'}{'dom'} eq 'no') {
+ $inittype = "";
+ }
+ } elsif ($clientsameinst) {
+ $context = 'intdom';
+ if ($secureconf{'connfrom'}{'intdom'} eq 'no') {
+ $inittype = "";
+ }
+ } else {
+ $context = 'other';
+ if ($secureconf{'connfrom'}{'other'} eq 'no') {
+ $inittype = "";
+ }
+ }
+ if ($inittype eq '') {
+ &logthis(" Domain config set "
+ ."to no ssl for $clientname (context: $context)"
+ ." -- trying insecure auth");
+ }
+ }
+
if($inittype eq "ssl") {
my ($ca, $cert) = lonssl::CertificateFile;
my $kfile = lonssl::KeyFile;
@@ -7244,7 +7722,7 @@ sub make_new_child {
close $client;
}
} elsif ($inittype eq "ssl") {
- my $key = SSLConnection($client);
+ my $key = SSLConnection($client,$clientname);
if ($key) {
$clientok = 1;
my $cipherkey = pack("H32", $key);
@@ -7271,7 +7749,6 @@ sub make_new_child {
."Attempted insecure connection disallowed ");
close $client;
$clientok = 0;
-
}
}
} else {
@@ -7280,7 +7757,6 @@ sub make_new_child {
."$clientip failed to initialize: >$remotereq< ");
&status('No init '.$clientip);
}
-
} else {
&logthis(
"WARNING: Unknown client $clientip");
@@ -7298,44 +7774,7 @@ sub make_new_child {
# ------------------------------------------------------------ Process requests
my $keep_going = 1;
my $user_input;
- my $clienthost = &Apache::lonnet::hostname($clientname);
- my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
- $clienthomedom = &Apache::lonnet::host_domain($clientserverhomeID);
- $clientintdom = &Apache::lonnet::internet_dom($clientserverhomeID);
- $clientsameinst = 0;
- if ($clientintdom ne '') {
- my $internet_names = &Apache::lonnet::get_internet_names($currenthostid);
- if (ref($internet_names) eq 'ARRAY') {
- if (grep(/^\Q$clientintdom\E$/,@{$internet_names})) {
- $clientsameinst = 1;
- }
- }
- }
- $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");
@@ -7365,6 +7804,75 @@ sub make_new_child {
exit;
}
+
+#
+# Used to determine if a particular client is from the same 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.
+#
+# 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.
+# $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.
+#
+
+sub set_client_info {
+ my ($lonhost) = @_;
+ $lonhost ||= $clientname;
+ my $clienthost = &Apache::lonnet::hostname($lonhost);
+ my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
+ my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);
+ my $samedom = 0;
+ if ($perlvar{'lonDefDomain'} eq $homedom) {
+ $samedom = 1;
+ }
+ my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);
+ my $sameinst = 0;
+ if ($intdom ne '') {
+ my $internet_names = &Apache::lonnet::get_internet_names($currenthostid);
+ if (ref($internet_names) eq 'ARRAY') {
+ if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
+ $sameinst = 1;
+ }
+ }
+ }
+ if (wantarray) {
+ return ($samedom,$sameinst);
+ } else {
+ $clienthomedom = $homedom;
+ $clientsamedom = $samedom;
+ $clientintdom = $intdom;
+ $clientsameinst = $sameinst;
+ if ($clientsameinst) {
+ undef($clientremoteok);
+ undef(%clientprohibited);
+ } else {
+ $clientremoteok = &get_remote_hostable($currentdomainid);
+ %clientprohibited = &get_prohibited($currentdomainid);
+ }
+ return 1;
+ }
+}
+
#
# Determine if a user is an author for the indicated domain.
#
@@ -7473,15 +7981,25 @@ sub password_filename {
# domain - domain of the user.
# name - User's name.
# contents - New contents of the file.
+# saveold - (optional). If true save old file in a passwd.bak file.
# Returns:
# 0 - Failed.
# 1 - Success.
#
sub rewrite_password_file {
- my ($domain, $user, $contents) = @_;
+ my ($domain, $user, $contents, $saveold) = @_;
my $file = &password_filename($domain, $user);
if (defined $file) {
+ if ($saveold) {
+ my $bakfile = $file.'.bak';
+ if (CopyFile($file,$bakfile)) {
+ chmod(0400,$bakfile);
+ &logthis("Old password saved in passwd.bak for internally authenticated user: $user:$domain");
+ } else {
+ &logthis("Failed to save old password in passwd.bak for internally authenticated user: $user:$domain");
+ }
+ }
my $pf = IO::File->new(">$file");
if($pf) {
print $pf "$contents\n";
@@ -7572,20 +8090,27 @@ sub validate_user {
$contentpwd = $domdefaults{'auth_arg_def'};
}
}
- }
+ }
if ($howpwd ne 'nouser') {
if($howpwd eq "internal") { # Encrypted is in local password file.
if (length($contentpwd) == 13) {
$validated = (crypt($password,$contentpwd) eq $contentpwd);
if ($validated) {
- my $ncpass = &hash_passwd($domain,$password);
- if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass")) {
- &update_passwd_history($user,$domain,$howpwd,'conversion');
- &logthis("Validated password hashed with bcrypt for $user:$domain");
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
+ if ($domdefaults{'intauth_switch'}) {
+ my $ncpass = &hash_passwd($domain,$password);
+ my $saveold;
+ if ($domdefaults{'intauth_switch'} == 2) {
+ $saveold = 1;
+ }
+ if (&rewrite_password_file($domain,$user,"$howpwd:$ncpass",$saveold)) {
+ &update_passwd_history($user,$domain,$howpwd,'conversion');
+ &logthis("Validated password hashed with bcrypt for $user:$domain");
+ }
}
}
} else {
- $validated = &check_internal_passwd($password,$contentpwd,$domain);
+ $validated = &check_internal_passwd($password,$contentpwd,$domain,$user);
}
}
elsif ($howpwd eq "unix") { # User is a normal unix user.
@@ -7655,24 +8180,35 @@ sub validate_user {
}
sub check_internal_passwd {
- my ($plainpass,$stored,$domain) = @_;
+ my ($plainpass,$stored,$domain,$user) = @_;
my (undef,$method,@rest) = split(/!/,$stored);
- if ($method eq "bcrypt") {
+ if ($method eq 'bcrypt') {
my $result = &hash_passwd($domain,$plainpass,@rest);
if ($result ne $stored) {
return 0;
}
- # Upgrade to a larger number of rounds if necessary
- my $defaultcost;
- my %domconfig =
- &Apache::lonnet::get_dom('configuration',['password'],$domain);
- if (ref($domconfig{'password'}) eq 'HASH') {
- $defaultcost = $domconfig{'password'}{'cost'};
- }
- if (($defaultcost eq '') || ($defaultcost =~ /D/)) {
- $defaultcost = 10;
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
+ if ($domdefaults{'intauth_check'}) {
+ # Upgrade to a larger number of rounds if necessary
+ my $defaultcost = $domdefaults{'intauth_cost'};
+ if (($defaultcost eq '') || ($defaultcost =~ /D/)) {
+ $defaultcost = 10;
+ }
+ if (int($rest[0])new(">$passfilename");
+ if($pf) {
+ print $pf "lti:\n";
+ &update_passwd_history($uname,$udom,$umode,$action);
+ } else {
+ $result = "pass_file_failed_error";
+ }
} else {
$result="auth_mode_error";
}
@@ -8072,6 +8616,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 ".
@@ -8100,6 +8645,19 @@ sub get_usersession_config {
return;
}
+sub get_usersearch_config {
+ my ($dom,$name) = @_;
+ my ($usersearchconf,$cached)=&Apache::lonnet::is_cached_new($name,$dom);
+ if (defined($cached)) {
+ return $usersearchconf;
+ } else {
+ my %domconfig = &Apache::lonnet::get_dom('configuration',['directorysrch'],$dom);
+ &Apache::lonnet::do_cache_new($name,$dom,$domconfig{'directorysrch'},600);
+ return $domconfig{'directorysrch'};
+ }
+ return;
+}
+
sub get_prohibited {
my ($dom) = @_;
my $name = 'trust';
@@ -8135,6 +8693,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;
}
@@ -8460,7 +9044,6 @@ IO::File
Apache::File
POSIX
Crypt::IDEA
-LWP::UserAgent()
GDBM_File
Authen::Krb4
Authen::Krb5
@@ -8542,7 +9125,7 @@ is closed and the child exits.
=item Red CRITICAL Can't get key file
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
the directories/files lonCertificateDirectory or
lonnetPrivateKey