--- loncom/lond 2017/05/09 03:04:21 1.536
+++ loncom/lond 2019/07/02 19:40:18 1.559
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.536 2017/05/09 03:04:21 raeburn Exp $
+# $Id: lond,v 1.559 2019/07/02 19:40:18 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.536 $'; #' stupid emacs
+my $VERSION='$Revision: 1.559 $'; #' 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;
@@ -108,6 +109,10 @@ my %perlvar; # Will have the apache co
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;
#
@@ -172,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")
@@ -220,6 +226,7 @@ my %trust = (
dcmaildump => {remote => 1, domroles => 1},
dcmailput => {remote => 1, domroles => 1},
del => {remote => 1, domroles => 1, enroll => 1, content => 1},
+ delbalcookie => {institutiononly => 1},
deldom => {remote => 1, domroles => 1}, # not currently used
devalidatecache => {institutiononly => 1},
domroleput => {remote => 1, enroll => 1},
@@ -230,7 +237,7 @@ my %trust = (
edit => {institutiononly => 1}, #not used currently
eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently
egetdom => {remote => 1, domroles => 1, enroll => 1, },
- ekey => {}, #not used currently
+ ekey => {anywhere => 1},
exit => {anywhere => 1},
fetchuserfile => {remote => 1, enroll => 1},
get => {remote => 1, domroles => 1, enroll => 1},
@@ -295,9 +302,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},
@@ -420,10 +427,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("<font color=\"red\"> CRITICAL "
@@ -779,10 +795,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;
}
@@ -806,12 +829,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
@@ -832,7 +856,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('<font color="red"> Pushfile: unable to install '
.$tablefile." - no data received from push. </font>");
@@ -843,8 +868,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()) {
@@ -1606,12 +1636,14 @@ sub du2_handler {
#
# 1. for a directory, and the path does not begin with one of:
# (a) /home/httpd/html/res/<domain>
-# (b) /home/httpd/html/res/userfiles/
+# (b) /home/httpd/html/userfiles/
# (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
# or is:
#
-# 2. for a file, and the path (after prepending) does not begin with:
-# /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
+# 2. for a file, and the path (after prepending) does not begin with one of:
+# (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
+# (b) /home/httpd/html/res/<domain>/<username>/
+# (c) /home/httpd/html/userfiles/<domain>/<username>/
#
# the response will be "refused".
#
@@ -1642,8 +1674,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;
}
@@ -1670,7 +1702,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;
}
@@ -1703,12 +1736,14 @@ sub ls_handler {
#
# 1. for a directory, and the path does not begin with one of:
# (a) /home/httpd/html/res/<domain>
-# (b) /home/httpd/html/res/userfiles/
+# (b) /home/httpd/html/userfiles/
# (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
# or is:
#
-# 2. for a file, and the path (after prepending) does not begin with:
-# /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
+# 2. for a file, and the path (after prepending) does not begin with one of:
+# (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
+# (b) /home/httpd/html/res/<domain>/<username>/
+# (c) /home/httpd/html/userfiles/<domain>/<username>/
#
# the response will be "refused".
#
@@ -1738,8 +1773,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;
}
@@ -1767,7 +1802,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;
}
@@ -1792,14 +1828,17 @@ sub ls2_handler {
#
# 1. for a directory, and the path does not begin with one of:
# (a) /home/httpd/html/res/<domain>
-# (b) /home/httpd/html/res/userfiles/
+# (b) /home/httpd/html/userfiles/
# (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
-# (d) /home/httpd/html/priv/<domain>/ and client is the homeserver
+# (d) /home/httpd/html/priv/<domain> and client is the homeserver
#
# or is:
#
-# 2. for a file, and the path (after prepending) does not begin with:
-# /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
+# 2. for a file, and the path (after prepending) does not begin with one of:
+# (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
+# (b) /home/httpd/html/res/<domain>/<username>/
+# (c) /home/httpd/html/userfiles/<domain>/<username>/
+# (d) /home/httpd/html/priv/<domain>/<username>/ and client is the homeserver
#
# the response will be "refused".
#
@@ -1873,17 +1912,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);
@@ -1907,7 +1972,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;
}
@@ -1963,7 +2030,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'};
@@ -2059,8 +2126,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;
}
@@ -2281,12 +2348,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";
@@ -2314,7 +2453,6 @@ sub change_password_handler {
#
&Failure( $client, "auth_mode_error\n", $userinput);
}
-
} else {
if ($failure eq '') {
$failure = 'non_authorized';
@@ -2591,32 +2729,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);
@@ -2686,17 +2818,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;
@@ -5467,6 +5595,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
@@ -5745,9 +5925,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.
@@ -5772,6 +5953,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
#
@@ -6805,8 +7036,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;
}
@@ -6940,10 +7171,10 @@ sub UpdateHosts {
my %oldconf = %secureconf;
my %connchange;
- if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {
- logthis('<font color="blue"> Reloaded SSL connection rules </font>');
+ if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
+ logthis('<font color="blue"> Reloaded SSL connection rules and cleared CRL checking history </font>');
} else {
- logthis('<font color="yellow"> Failed to reload SSL connection rules </font>');
+ logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>');
}
if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) {
foreach my $type ('dom','intdom','other') {
@@ -7222,7 +7453,7 @@ if ($arch eq 'unknown') {
chomp($arch);
}
-unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {
+unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
&logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>');
}
@@ -7311,7 +7542,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;
}
@@ -7356,7 +7587,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");
@@ -7457,7 +7688,6 @@ sub make_new_child {
}
} else {
- $clientinfoset = &set_client_info();
my $ok = InsecureConnection($client);
if($ok) {
$clientok = 1;
@@ -7495,34 +7725,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");
@@ -7555,22 +7758,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.
#
@@ -7582,7 +7793,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);
@@ -7602,6 +7813,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;
}
}
@@ -8317,6 +8535,14 @@ sub make_passwd_file {
$result = "pass_file_failed_error";
}
}
+ } elsif ($umode eq 'lti') {
+ my $pf = IO::File->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";
}
@@ -8341,6 +8567,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 ".
@@ -8417,6 +8644,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;
}
@@ -8742,7 +8995,6 @@ IO::File
Apache::File
POSIX
Crypt::IDEA
-LWP::UserAgent()
GDBM_File
Authen::Krb4
Authen::Krb5
@@ -8824,7 +9076,7 @@ is closed and the child exits.
=item Red CRITICAL Can't get key file <error>
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