--- loncom/lond 2017/05/23 01:31:03 1.537
+++ loncom/lond 2018/12/11 13:05:40 1.555
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.537 2017/05/23 01:31:03 raeburn Exp $
+# $Id: lond,v 1.555 2018/12/11 13:05:40 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.537 $'; #' stupid emacs
+my $VERSION='$Revision: 1.555 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -108,6 +108,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 +176,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 +225,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 +236,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 +301,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 +426,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 +794,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 +828,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 +855,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 +867,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 +1635,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 +1673,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 +1701,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 +1735,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 +1772,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 +1801,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 +1827,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 +1911,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 +1971,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;
}
@@ -2059,8 +2125,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;
}
@@ -2596,8 +2662,12 @@ sub update_resource_handler {
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 {
@@ -5453,6 +5523,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
@@ -5731,9 +5853,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.
@@ -5758,6 +5881,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
#
@@ -6791,8 +6964,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;
}
@@ -6926,10 +7099,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') {
@@ -7208,7 +7381,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>');
}
@@ -8303,6 +8476,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";
}
@@ -8809,7 +8990,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