--- loncom/lond 2023/07/05 21:55:22 1.489.2.43.2.7 +++ loncom/lond 2025/01/16 18:59:14 1.489.2.43.2.12 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.43.2.7 2023/07/05 21:55:22 raeburn Exp $ +# $Id: lond,v 1.489.2.43.2.12 2025/01/16 18:59:14 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -63,7 +63,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.489.2.43.2.7 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.43.2.12 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -2834,6 +2834,54 @@ sub user_has_session_handler { } ®ister_handler("userhassession", \&user_has_session_handler, 0,1,0); +sub del_usersession_handler { + my ($cmd, $tail, $client) = @_; + + my $result; + my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); + if (($udom =~ /^$LONCAPA::match_domain$/) && ($uname =~ /^$LONCAPA::match_username$/)) { + my $lonidsdir = $perlvar{'lonIDsDir'}; + if (-d $lonidsdir) { + if (opendir(DIR,$lonidsdir)) { + my $filename; + while ($filename=readdir(DIR)) { + if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/) { + if (tie(my %oldenv,'GDBM_File',"$lonidsdir/$filename", + &GDBM_READER(),0640)) { + my $linkedfile; + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; + } + untie(%oldenv); + $result = unlink("$lonidsdir/$filename"); + if ($result) { + if ($linkedfile =~ /^[a-f0-9]+_linked$/) { + if (-l "$lonidsdir/$linkedfile.id") { + unlink("$lonidsdir/$linkedfile.id"); + } + } + } + } else { + $result = unlink("$lonidsdir/$filename"); + } + last; + } + } + } + } + if ($result == 1) { + &Reply($client, "$result\n", "$cmd:$tail"); + } else { + &Reply($client, "not_found\n", "$cmd:$tail"); + } + } else { + &Failure($client, "invalid_user\n", "$cmd:$tail"); + } + return 1; +} + +®ister_handler("delusersession", \&del_usersession_handler, 0,1,0); + # # Authenticate access to a user file by checking that the token the user's # passed also exists in their session file @@ -4893,7 +4941,7 @@ sub lti_handler { # Side effects: # The reply will contain the LTI payload, as & separated key=value pairs, # where value is itself a frozen hash, if the required key and secret -# for the apecific tool ID are available. The payload data are retrieved from +# for the specific tool ID are available. The payload data are retrieved from # a call to Lond::sign_lti_payload(), and the reply is encrypted before being # written to $client. # @@ -5709,12 +5757,13 @@ sub enrollment_enabled_handler { my ($cmd, $tail, $client) = @_; my $userinput = $cmd.":".$tail; # For logging purposes. - my ($cdom) = split(/:/, $tail, 2); # Domain we're asking about. - - my $outcome = &localenroll::run($cdom); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::run($cdom); + }; &Reply($client, \$outcome, $userinput); - return 1; } ®ister_handler("autorun", \&enrollment_enabled_handler, 0, 1, 0); @@ -5747,8 +5796,12 @@ sub validate_instcode_handler { my ($dom,$instcode,$owner) = split(/:/, $tail); $instcode = &unescape($instcode); $owner = &unescape($owner); - my ($outcome,$description,$credits) = - &localenroll::validate_instcode($dom,$instcode,$owner); + my ($outcome,$description,$credits); + eval { + local($SIG{__DIE__})='DEFAULT'; + ($outcome,$description,$credits) = + &localenroll::validate_instcode($dom,$instcode,$owner); + }; my $result = &escape($outcome).'&'.&escape($description).'&'. &escape($credits); &Reply($client, \$result, $userinput); @@ -5782,10 +5835,14 @@ sub validate_instcrosslist_handler { $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); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $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); @@ -5808,12 +5865,13 @@ sub get_sections_handler { my $userinput = "$cmd:$tail"; my ($coursecode, $cdom) = split(/:/, $tail); - my @secs = &localenroll::get_sections($coursecode,$cdom); - my $seclist = &escape(join(':',@secs)); - + my $seclist; + eval { + local($SIG{__DIE__})='DEFAULT'; + my @secs = &localenroll::get_sections($coursecode,$cdom); + $seclist = &escape(join(':',@secs)); + }; &Reply($client, \$seclist, $userinput); - - return 1; } ®ister_handler("autogetsections", \&get_sections_handler, 0, 1, 0); @@ -5833,6 +5891,7 @@ sub get_sections_handler { # Returns: # 1 - Processing should continue. # + sub validate_course_owner_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; @@ -5840,11 +5899,12 @@ sub validate_course_owner_handler { $owner = &unescape($owner); $coowners = &unescape($coowners); - my $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome = &localenroll::new_course($inst_course_id,$owner,$cdom,$coowners); + }; &Reply($client, \$outcome, $userinput); - - - return 1; } ®ister_handler("autonewcourse", \&validate_course_owner_handler, 0, 1, 0); @@ -5870,11 +5930,12 @@ sub validate_course_section_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; my ($inst_course_id, $cdom) = split(/:/, $tail); - - my $outcome=&localenroll::validate_courseID($inst_course_id,$cdom); + my $outcome; + eval { + local($SIG{__DIE__})='DEFAULT'; + $outcome=&localenroll::validate_courseID($inst_course_id,$cdom); + }; &Reply($client, \$outcome, $userinput); - - return 1; } ®ister_handler("autovalidatecourse", \&validate_course_section_handler, 0, 1, 0); @@ -5908,7 +5969,6 @@ sub validate_class_access_handler { $outcome=&localenroll::check_section($inst_class,$owners,$cdom); }; &Reply($client,\$outcome, $userinput); - return 1; } ®ister_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0); @@ -6041,10 +6101,11 @@ sub create_auto_enroll_password_handler my ($authparam, $cdom) = split(/:/, $userinput); my ($create_passwd,$authchk); - ($authparam, - $create_passwd, - $authchk) = &localenroll::create_password($authparam,$cdom); - + eval { + local($SIG{__DIE__})='DEFAULT'; + ($authparam,$create_passwd,$create_passwd,$authchk) = + &localenroll::create_password($authparam,$cdom); + }; &Reply($client, &escape($authparam.':'.$create_passwd.':'.$authchk)."\n", $userinput); @@ -6280,12 +6341,16 @@ sub get_institutional_code_format_handle my ($key,$value) = split/=/,$_; $instcodes{&unescape($key)} = &unescape($value); } - my $formatreply = &localenroll::instcode_format($cdom, - \%instcodes, - \%codes, - \@codetitles, - \%cat_titles, - \%cat_order); + my $formatreply; + eval { + local($SIG{__DIE__})='DEFAULT'; + $formatreply = &localenroll::instcode_format($cdom, + \%instcodes, + \%codes, + \@codetitles, + \%cat_titles, + \%cat_order); + }; if ($formatreply eq 'ok') { my $codes_str = &Apache::lonnet::hash2str(%codes); my $codetitles_str = &Apache::lonnet::array2str(@codetitles); @@ -6345,11 +6410,15 @@ sub get_possible_instcodes_handler { my $reply; my $cdom = $tail; my (@codetitles,%cat_titles,%cat_order,@code_order); - my $formatreply = &localenroll::possible_instcodes($cdom, - \@codetitles, - \%cat_titles, - \%cat_order, - \@code_order); + my $formatreply; + eval { + local($SIG{__DIE__})='DEFAULT'; + $formatreply = &localenroll::possible_instcodes($cdom, + \@codetitles, + \%cat_titles, + \%cat_order, + \@code_order); + }; if ($formatreply eq 'ok') { my $result = join('&',map {&escape($_);} (@codetitles)).':'; $result .= join('&',map {&escape($_);} (@code_order)).':'; @@ -7028,7 +7097,7 @@ undef $perlvarref; # ----------------------------- Make sure this process is running from user=www my $wwwid=getpwnam('www'); if ($wwwid!=$<) { - my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; + 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.' |". " mail -s '$subj' $emailto > /dev/null"); @@ -8236,6 +8305,9 @@ sub currentversion { if (-e $ulsdir) { if(-d $ulsdir) { if (opendir(LSDIR,$ulsdir)) { + if (-e $fname) { + $version=0; + } my $ulsfn; while ($ulsfn=readdir(LSDIR)) { # see if this is a regular file (ignore links produced earlier)