--- loncom/lond 2016/09/24 19:44:15 1.489.2.24
+++ loncom/lond 2022/02/25 10:00:00 1.489.2.43.2.4
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.489.2.24 2016/09/24 19:44:15 raeburn Exp $
+# $Id: lond,v 1.489.2.43.2.4 2022/02/25 10:00:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -15,7 +15,6 @@
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
-
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
@@ -64,7 +63,7 @@ my $DEBUG = 0; # Non zero to ena
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.489.2.24 $'; #' stupid emacs
+my $VERSION='$Revision: 1.489.2.43.2.4 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -1429,13 +1428,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/<domain>/
-# (b) /home/httpd/html/res/userfiles/
+# (a) /home/httpd/html/res/<domain>
+# (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".
#
@@ -1466,8 +1467,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;
}
@@ -1494,7 +1495,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;
}
@@ -1526,13 +1528,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/<domain>/
-# (b) /home/httpd/html/res/userfiles/
+# (a) /home/httpd/html/res/<domain>
+# (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".
#
@@ -1562,8 +1566,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;
}
@@ -1591,7 +1595,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;
}
@@ -1615,15 +1620,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/<domain>/
-# (b) /home/httpd/html/res/userfiles/
+# (a) /home/httpd/html/res/<domain>
+# (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".
#
@@ -1700,9 +1708,9 @@ sub ls3_handler {
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;
}
@@ -1731,7 +1739,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;
}
@@ -1785,7 +1795,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|rocky|alma)/) {
my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');
if (ref($othervarref) eq 'HASH') {
$items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
@@ -2010,7 +2020,7 @@ sub authenticate_handler {
my ($remote,$hosted);
my $remotesession = &get_usersession_config($udom,'remotesession');
if (ref($remotesession) eq 'HASH') {
- $remote = $remotesession->{'remote'}
+ $remote = $remotesession->{'remote'};
}
my $hostedsession = &get_usersession_config($clienthomedom,'hostedsession');
if (ref($hostedsession) eq 'HASH') {
@@ -2097,12 +2107,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";
@@ -2130,7 +2212,6 @@ sub change_password_handler {
#
&Failure( $client, "auth_mode_error\n", $userinput);
}
-
} else {
if ($failure eq '') {
$failure = 'non_authorized';
@@ -2151,12 +2232,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 {
@@ -2422,8 +2499,12 @@ sub update_resource_handler {
}
alarm(0);
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 {
@@ -3212,7 +3293,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
@@ -3454,6 +3536,47 @@ sub dump_with_regexp {
}
®ister_handler("dump", \&dump_with_regexp, 0, 1, 0);
+#
+# Process the encrypted dump request. Original call should
+# be from lonnet::dump() with seventh arg ($encrypt) set to
+# 1, to ensure that both request and response are encrypted.
+#
+# Parameters:
+# $cmd - Command keyword of request (edump).
+# $tail - Tail of the command.
+# See &dump_with_regexp for more
+# information about this.
+# $client - File open on the client.
+# Returns:
+# 1 - Continue processing
+# 0 - server should exit.
+#
+
+sub encrypted_dump_with_regexp {
+ my ($cmd, $tail, $client) = @_;
+ my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientversion);
+
+ if ($res =~ /^error:/) {
+ Failure($client, \$res, "$cmd:$tail");
+ } else {
+ if ($cipher) {
+ my $cmdlength=length($res);
+ $res.=" ";
+ my $encres='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encres.= unpack("H16",
+ $cipher->encrypt(substr($res,
+ $encidx,
+ 8)));
+ }
+ &Reply( $client,"enc:$cmdlength:$encres\n","$cmd:$tail");
+ } else {
+ &Failure( $client, "error:no_key\n","$cmd:$tail");
+ }
+ }
+}
+®ister_handler("edump", \&encrypted_dump_with_regexp, 0, 1, 0);
+
# Store a set of key=value pairs associated with a versioned name.
#
# Parameters:
@@ -3794,6 +3917,37 @@ sub send_query_handler {
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);
@@ -4463,6 +4617,44 @@ sub course_lastaccess_handler {
}
®ister_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);
+sub course_sessions_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($cdom,$cnum,$lastactivity) = split(':',$tail);
+ my $dbsuffix = '_'.$cdom.'_'.$cnum.'.db';
+ my (%sessions,$qresult);
+ my $now=time;
+ if (opendir(DIR,$perlvar{'lonIDsDir'})) {
+ my $filename;
+ while ($filename=readdir(DIR)) {
+ next if ($filename=~/^\./);
+ next if ($filename=~/^publicuser_/);
+ next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/);
+ if ($filename =~ /^($LONCAPA::match_username)_\d+_($LONCAPA::match_domain)_/) {
+ my ($uname,$udom) = ($1,$2);
+ next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix");
+ my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9];
+ if ($lastactivity < 0) {
+ next if ($mtime-$now > $lastactivity);
+ } else {
+ next if ($now-$mtime > $lastactivity);
+ }
+ $sessions{$uname.':'.$udom} = $mtime;
+ }
+ }
+ closedir(DIR);
+ }
+ foreach my $user (keys(%sessions)) {
+ $qresult.=&escape($user).'='.$sessions{$user}.'&';
+ }
+ if ($qresult) {
+ chop($qresult);
+ }
+ &Reply($client, \$qresult, $userinput);
+ return 1;
+}
+®ister_handler("coursesessions",\&course_sessions_handler, 0, 1, 0);
+
#
# Puts an unencrypted entry in a namespace db file at the domain level
#
@@ -4511,7 +4703,7 @@ sub put_domain_handler {
# domain directory.
#
# Parameters:
-# $cmd - Command request keyword (get).
+# $cmd - Command request keyword (getdom).
# $tail - Tail of the command. This is a colon separated list
# consisting of the domain and the 'namespace'
# which selects the gdbm file to do the lookup in,
@@ -4528,34 +4720,122 @@ sub put_domain_handler {
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);
- 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);
+ if (($namespace =~ /^enc/) || ($namespace eq 'private')) {
+ &Failure( $client, "refused\n", $userinput);
+ } else {
+ my $res = LONCAPA::Lond::get_dom($userinput);
+ if ($res =~ /^error:/) {
+ &Failure($client, \$res, $userinput);
} else {
- &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".
- "while attempting getdom\n",$userinput);
+ &Reply($client, \$res, $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);
+ if ($namespace eq 'private') {
+ &Failure( $client, "refused\n", $userinput);
+ } else {
+ my $res = LONCAPA::Lond::get_dom($userinput);
+ if ($res =~ /^error:/) {
+ &Failure($client, \$res, $userinput);
+ } else {
+ if ($cipher) {
+ my $cmdlength=length($res);
+ $res.=" ";
+ my $encres='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encres.= unpack("H16",
+ $cipher->encrypt(substr($res,
+ $encidx,
+ 8)));
+ }
+ &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
+ } else {
+ &Failure( $client, "error:no_key\n",$userinput);
+ }
+ }
+ }
+ return 1;
+}
+®ister_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);
+
+#
+# Encrypted get from the namespace database file at the domain level.
+# This function retrieves a keyed item from a specific named database in the
+# domain directory.
+#
+# Parameters:
+# $cmd - Command request keyword (lti).
+# $tail - Tail of the command. This is a colon-separated list
+# consisting of the domain, coursenum, if for LTI-
+# enabled deep-linking to course content using
+# link protection configured within a course,
+# context (=deeplink) if for LTI-enabled deep-linking
+# to course content using LTI Provider settings
+# configured within a course's domain, the (escaped)
+# launch URL, the (escaped) method (typically POST),
+# and a frozen hash of the LTI launch parameters
+# from the LTI payload.
+# $client - File descriptor open on the client.
+# Returns:
+# 1 - Continue processing.
+# 0 - Exit.
+# Side effects:
+# The reply will contain an LTI itemID, if the signed LTI payload
+# could be verified using the consumer key and the shared secret
+# available for that key (for the itemID) for either the course or domain,
+# depending on values for cnum and context. The reply is encrypted before
+# being written to $client.
+#
+sub lti_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput = "$cmd:$tail";
+
+ my ($cdom,$cnum,$context,$escurl,$escmethod,$items) = split(/:/,$tail);
+ my $url = &unescape($escurl);
+ my $method = &unescape($escmethod);
+ my $params = &Apache::lonnet::thaw_unescape($items);
+ my $res;
+ if ($cnum ne '') {
+ $res = &LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
+ } else {
+ $res = &LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
+ }
+ if ($res =~ /^error:/) {
+ &Failure($client, \$res, $userinput);
+ } else {
+ if ($cipher) {
+ my $cmdlength=length($res);
+ $res.=" ";
+ my $encres='';
+ for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
+ $encres.= unpack("H16",
+ $cipher->encrypt(substr($res,
+ $encidx,
+ 8)));
+ }
+ &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
+ } else {
+ &Failure( $client, "error:no_key\n",$userinput);
+ }
+ }
+ return 1;
+}
+®ister_handler("lti", \<i_handler, 1, 1, 0);
+
#
# Puts an id to a domains id database.
#
@@ -4981,15 +5261,23 @@ sub tmp_put_handler {
}
my ($id,$store);
$tmpsnum++;
- if (($context eq 'resetpw') || ($context eq 'createaccount')) {
- $id = &md5_hex(&md5_hex(time.{}.rand().$$));
+ my $numtries = 0;
+ my $execdir=$perlvar{'lonDaemons'};
+ if (($context eq 'resetpw') || ($context eq 'createaccount') ||
+ ($context eq 'sso') || ($context eq 'link') || ($context eq 'retry')) {
+ $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum));
+ while ((-e "$execdir/tmp/$id.tmp") && ($numtries <10)) {
+ undef($id);
+ $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum));
+ $numtries ++;
+ }
} else {
$id = $$.'_'.$clientip.'_'.$tmpsnum;
}
$id=~s/\W/\_/g;
$record=~s/\n//g;
- my $execdir=$perlvar{'lonDaemons'};
- if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {
+ if (($id ne '') &&
+ ($store=IO::File->new(">$execdir/tmp/$id.tmp"))) {
print $store $record;
close $store;
&Reply($client, \$id, $userinput);
@@ -5072,6 +5360,116 @@ sub tmp_del_handler {
®ister_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
#
+# Process the updatebalcookie command. This command updates a
+# cookie in the lonBalancedir directory on a load balancer node.
+#
+# Parameters:
+# $cmd - Command that got us here.
+# $tail - Tail of the request (escaped cookie: escaped current entry)
+#
+# $client - socket open on the client process.
+#
+# Returns:
+# 1 - Indicating processing should continue.
+# Side Effects:
+# A cookie file is updated from the lonBalancedir directory
+# A reply is sent to the client.
+#
+sub update_balcookie_handler {
+ my ($cmd, $tail, $client) = @_;
+
+ my $userinput= "$cmd:$tail";
+ chomp($tail);
+ my ($cookie,$lastentry) = map { &unescape($_) } (split(/:/,$tail));
+
+ my $updatedone;
+ if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
+ my $execdir=$perlvar{'lonBalanceDir'};
+ if (-e "$execdir/$cookie.id") {
+ my $doupdate;
+ if (open(my $fh,'<',"$execdir/$cookie.id")) {
+ while (my $line = <$fh>) {
+ chomp($line);
+ if ($line eq $lastentry) {
+ $doupdate = 1;
+ last;
+ }
+ }
+ close($fh);
+ }
+ if ($doupdate) {
+ if (open(my $fh,'>',"$execdir/$cookie.id")) {
+ print $fh $clientname;
+ close($fh);
+ $updatedone = 1;
+ }
+ }
+ }
+ }
+ if ($updatedone) {
+ &Reply($client, "ok\n", $userinput);
+ } else {
+ &Failure( $client, "error: ".($!+0)."file update failed ".
+ "while attempting updatebalcookie\n", $userinput);
+ }
+ return 1;
+}
+®ister_handler("updatebalcookie", \&update_balcookie_handler, 0, 1, 0);
+
+#
+# Process the delbalcookie command. This command deletes a balancer
+# cookie in the lonBalancedir directory on a load balancer node.
+#
+# 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);
+ $cookie = &unescape($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
@@ -5254,6 +5652,39 @@ sub validate_instcode_handler {
}
®ister_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);
+#
+# Validate co-owner for cross-listed institutional code and
+# institutional course code itself used for a LON-CAPA course.
+#
+# Formal Parameters:
+# $cmd - The command request that got us dispatched.
+# $tail - The tail of the command. In this case,
+# this is a colon separated string containing:
+# $dom - Course's LON-CAPA domain
+# $instcode - Institutional course code for the course
+# $inst_xlist - Institutional course Id for the crosslisting
+# $coowner - Username of co-owner
+# (values for all but $dom have been escaped).
+#
+# $client - Socket open on the client.
+# Returns:
+# 1 - Indicating processing should continue.
+#
+sub validate_instcrosslist_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($dom,$instcode,$inst_xlist,$coowner) = split(/:/,$tail);
+ $instcode = &unescape($instcode);
+ $inst_xlist = &unescape($inst_xlist);
+ $coowner = &unescape($coowner);
+ my $outcome = &localenroll::validate_crosslist_access($dom,$instcode,
+ $inst_xlist,$coowner);
+ &Reply($client, \$outcome, $userinput);
+
+ return 1;
+}
+®ister_handler("autovalidateinstcrosslist", \&validate_instcrosslist_handler, 0, 1, 0);
+
# Get the official sections for which auto-enrollment is possible.
# Since the admin people won't know about 'unofficial sections'
# we cannot auto-enroll on them.
@@ -5350,9 +5781,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.
@@ -5377,6 +5809,112 @@ sub validate_class_access_handler {
®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
#
+# Modify institutional sections (using customized &instsec_reformat()
+# routine in localenroll.pm), to either clutter or declutter, for
+# purposes of ensuring an institutional course section (string) can
+# be unambiguously separated into institutional course and section.
+#
+# 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:
+# $cdom - The LON-CAPA domain of the course.
+# $action - Either: clutter or declutter
+# clutter adds character(s) to eliminate ambiguity
+# declutter removes the added characters (e.g., for
+# display of the institutional course section string.
+# $info - A frozen hash in which keys are:
+# LON-CAPA course number:Institutional course code
+# and values are a reference to an array of the
+# items to modify -- either institutional sections,
+# or institutional course sections (for crosslistings).
+# $client - The socket open on the client.
+# Returns:
+# 1 - continue processing.
+#
+
+sub instsec_reformat_handler {
+ my ($cmd, $tail, $client) = @_;
+ my $userinput = "$cmd:$tail";
+ my ($cdom,$action,$info) = split(/:/,$tail);
+ my $instsecref = &Apache::lonnet::thaw_unescape($info);
+ my ($outcome,$result);
+ eval {
+ local($SIG{__DIE__})='DEFAULT';
+ $outcome=&localenroll::instsec_reformat($cdom,$action,$instsecref);
+ if ($outcome eq 'ok') {
+ if (ref($instsecref) eq 'HASH') {
+ foreach my $key (keys(%{$instsecref})) {
+ $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($instsecref->{$key}).'&';
+ }
+ $result =~ s/\&$//;
+ }
+ }
+ };
+ if (!$@) {
+ if ($outcome eq 'ok') {
+ &Reply( $client, \$result, $userinput);
+ } else {
+ &Reply($client,\$outcome, $userinput);
+ }
+ } else {
+ &Failure($client,"unknown_cmd\n",$userinput);
+ }
+ return 1;
+}
+®ister_handler("autoinstsecreformat",\&instsec_reformat_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
#
@@ -5454,7 +5992,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.
@@ -6354,8 +6892,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;
}
@@ -6805,7 +7343,7 @@ sub make_new_child {
&Authen::Krb5::init_context();
my $no_ets;
- if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) {
+ if ($dist =~ /^(?:centos|rhes|scientific|oracle|rocky|alma)(\d+)/) {
if ($1 >= 7) {
$no_ets = 1;
}
@@ -6938,7 +7476,6 @@ sub make_new_child {
."Attempted insecure connection disallowed </font>");
close $client;
$clientok = 0;
-
}
}
} else {
@@ -6947,7 +7484,6 @@ sub make_new_child {
."$clientip failed to initialize: >$remotereq< </font>");
&status('No init '.$clientip);
}
-
} else {
&logthis(
"<font color='blue'>WARNING: Unknown client $clientip</font>");
@@ -6973,7 +7509,7 @@ sub make_new_child {
Debug("Main: Got $user_input\n");
$keep_going = &process_request($user_input);
alarm(0);
- &status('Listening to '.$clientname." ($keymode)");
+ &status('Listening to '.$clientname." ($keymode)");
}
# --------------------------------------------- client unknown or fishy, refuse
@@ -6989,8 +7525,8 @@ sub make_new_child {
&logthis("<font color='red'>CRITICAL: "
."Disconnect from $clientip ($clientname)</font>");
-
-
+
+
# this exit is VERY important, otherwise the child will become
# a producer of more and more children, forking yourself into
# process death.
@@ -7105,15 +7641,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";
@@ -7200,24 +7746,38 @@ sub validate_user {
} elsif ((($domdefaults{'auth_def'} eq 'krb4') ||
($domdefaults{'auth_def'} eq 'krb5')) &&
($domdefaults{'auth_arg_def'} ne '')) {
- $howpwd = $domdefaults{'auth_def'};
- $contentpwd = $domdefaults{'auth_arg_def'};
+ #
+ # Don't attempt authentication for username and password supplied
+ # for user without an account if username contains @ to avoid
+ # call to &Authen::Krb5::parse_name() which will result in con_lost
+ #
+ unless ($user =~ /\@/) {
+ $howpwd = $domdefaults{'auth_def'};
+ $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.
@@ -7287,24 +7847,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])<int($defaultcost)) {
+ if ($domdefaults{'intauth_check'} == 1) {
+ my $ncpass = &hash_passwd($domain,$plainpass);
+ if (&rewrite_password_file($domain,$user,"internal:$ncpass")) {
+ &update_passwd_history($user,$domain,'internal','update cost');
+ &logthis("Validated password hashed with bcrypt for $user:$domain");
+ }
+ return 1;
+ } elsif ($domdefaults{'intauth_check'} == 2) {
+ return 0;
+ }
+ }
+ } else {
+ return 1;
}
- return 1 unless($rest[0]<$defaultcost);
}
return 0;
}
@@ -7734,6 +8305,18 @@ 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'},3600);
+ return $domconfig{'directorysrch'};
+ }
+ return;
+}
sub distro_and_arch {
return $dist.':'.$arch;