--- loncom/lond 2019/07/26 20:19:35 1.489.2.31 +++ loncom/lond 2021/02/10 16:07:28 1.489.2.35.2.4 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.31 2019/07/26 20:19:35 raeburn Exp $ +# $Id: lond,v 1.489.2.35.2.4 2021/02/10 16:07:28 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.31 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.35.2.4 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -2021,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') { @@ -2108,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"; @@ -2141,7 +2212,6 @@ sub change_password_handler { # &Failure( $client, "auth_mode_error\n", $userinput); } - } else { if ($failure eq '') { $failure = 'non_authorized'; @@ -3223,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 @@ -4505,6 +4576,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 # @@ -4553,7 +4662,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, @@ -4570,34 +4679,52 @@ 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/) { + &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 $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); + # # Puts an id to a domains id database. # @@ -5114,6 +5241,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 @@ -5547,7 +5784,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.