--- loncom/lond 2023/12/29 20:10:17 1.489.2.43.2.10 +++ loncom/lond 2024/12/29 16:44:03 1.489.2.47 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.489.2.43.2.10 2023/12/29 20:10:17 raeburn Exp $ +# $Id: lond,v 1.489.2.47 2024/12/29 16:44:03 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.10 $'; #' stupid emacs +my $VERSION='$Revision: 1.489.2.47 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -653,7 +653,7 @@ sub PushFile { if($filename eq "host") { $contents = AdjustHostContents($contents); - } elsif (($filename eq 'dns_hosts') || ($filename eq 'dns_domain')) { + } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') { if ($contents eq '') { &logthis(' Pushfile: unable to install ' .$tablefile." - no data received from push. "); @@ -2834,54 +2834,6 @@ 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 @@ -3614,47 +3566,6 @@ 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: @@ -4801,193 +4712,16 @@ sub get_domain_handler { my $userinput = "$cmd:$tail"; my ($udom,$namespace,$what)=split(/:/,$tail,3); - 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 { - &Reply($client, \$res, $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'}); - } + 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); - } + &Reply($client, \$res, $userinput); } - return 1; -} -®ister_handler("lti", \<i_handler, 1, 1, 0); -# -# Data for LTI payload (received encrypted) are unencrypted and -# then signed with the appropriate key and secret, before re-encrypting -# the signed payload which is sent to the client for unencryption by -# the caller: lonnet::sign_lti()) before dispatch either to a web browser -# (launch) or to a remote web service (roster, logout, or grade). -# -# Parameters: -# $cmd - Command request keyword (signlti). -# $tail - Tail of the command. This is a colon-separated list -# consisting of the domain, coursenum (if for an External -# Tool defined in a course), crsdef (true if defined in -# a course), type (linkprot or lti), -# context (launch, roster, logout, or grade), -# escaped launch URL, numeric ID of external tool, -# version number for encryption key (if tool's LTI secret was -# encrypted before storing), a frozen hash of LTI launch -# parameters, and a frozen hash of LTI information, -# (e.g., method => 'HMAC-SHA1', -# respfmt => 'to_authorization_header'). -# $client - File descriptor open on the client. -# Returns: -# 1 - Continue processing. -# 0 - Exit. -# 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 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. -# -sub sign_lti_handler { - my ($cmd, $tail, $client) = @_; - - my $userinput = "$cmd:$tail"; - - my ($cdom,$cnum,$crsdef,$type,$context,$escurl, - $ltinum,$keynum,$paramsref,$inforef) = split(/:/,$tail); - my $url = &unescape($escurl); - my $params = &Apache::lonnet::thaw_unescape($paramsref); - my $info = &Apache::lonnet::thaw_unescape($inforef); - my $res = - &LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum, - $keynum,$perlvar{'lonVersion'},$params,$info); - my $result; - if (ref($res) eq 'HASH') { - foreach my $key (keys(%{$res})) { - $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($res->{$key}).'&'; - } - $result =~ s/\&$//; - } else { - $result = $res; - } - if ($result =~ /^error:/) { - &Failure($client, \$result, $userinput); - } else { - if ($cipher) { - my $cmdlength=length($result); - $result.=" "; - my $encres=''; - for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) { - $encres.= unpack("H16", - $cipher->encrypt(substr($result, - $encidx, - 8))); - } - &Reply( $client,"enc:$cmdlength:$encres\n",$userinput); - } else { - &Failure( $client, "error:no_key\n",$userinput); - } - } return 1; } -®ister_handler("signlti", \&sign_lti_handler, 1, 1, 0); +®ister_handler("getdom", \&get_domain_handler, 0, 1, 0); # # Puts an id to a domains id database. @@ -5757,12 +5491,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); @@ -5795,8 +5530,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); @@ -5830,10 +5569,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); @@ -5856,12 +5599,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); @@ -5881,6 +5625,7 @@ sub get_sections_handler { # Returns: # 1 - Processing should continue. # + sub validate_course_owner_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; @@ -5888,11 +5633,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); @@ -5918,11 +5664,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); @@ -6089,10 +5836,12 @@ 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, + $authchk) = &localenroll::create_password($authparam,$cdom); + }; &Reply($client, &escape($authparam.':'.$create_passwd.':'.$authchk)."\n", $userinput); @@ -6328,12 +6077,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); @@ -6393,11 +6146,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)).':'; @@ -7076,7 +6833,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"); @@ -7934,7 +7691,7 @@ sub validate_user { ($domdefaults{'auth_arg_def'} ne '')) { # # Don't attempt authentication for username and password supplied - # for user without an account if username contains @ to avoid + # for user without an account if uername contains @ to avoid # call to &Authen::Krb5::parse_name() which will result in con_lost # unless ($user =~ /\@/) {