--- loncom/lond 2022/07/25 23:31:40 1.576 +++ loncom/lond 2024/12/27 02:32:56 1.583 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.576 2022/07/25 23:31:40 raeburn Exp $ +# $Id: lond,v 1.583 2024/12/27 02:32:56 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.576 $'; #' stupid emacs +my $VERSION='$Revision: 1.583 $'; #' stupid emacs my $remoteVERSION; my $currenthostid="default"; my $currentdomainid; @@ -223,6 +223,7 @@ my %trust = ( courseidputhash => {remote => 1, domroles => 1, enroll => 1}, courselastaccess => {remote => 1, domroles => 1, enroll => 1}, coursesessions => {institutiononly => 1}, + crsfilefrompriv => {remote => 1, enroll => 1}, currentauth => {remote => 1, domroles => 1, enroll => 1}, currentdump => {remote => 1, enroll => 1}, currentversion => {remote=> 1, content => 1}, @@ -306,6 +307,7 @@ my %trust = ( servertimezone => {remote => 1, enroll => 1}, setannounce => {remote => 1, domroles => 1}, sethost => {anywhere => 1}, + signlti => {remote => 1}, store => {remote => 1, enroll => 1, reqcrs => 1,}, studentphoto => {remote => 1, enroll => 1}, sub => {content => 1,}, @@ -1922,19 +1924,26 @@ sub ls3_handler { my $ulsout=''; my $ulsfn; - my ($crscheck,$toplevel,$currdom,$currnum,$skip); + my ($crscheck,$toplevel,$currdom,$currnum,$skip,$privdir_for_course); unless ($islocal) { my ($major,$minor) = split(/\./,$clientversion); if (($major < 2) || ($major == 2 && $minor < 12)) { $crscheck = 1; } + if ($ulsdir =~ m{^/home/httpd/html/priv/($LONCAPA::match_domain)/($LONCAPA::match_courseid)}) { + my ($currdom,$currnum) = ($1,$2); + if (&LONCAPA::Lond::is_course($currdom,$currnum)) { + $privdir_for_course = 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_name/userfiles}) || - (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal))) { + (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal)) || + ($privdir_for_course)) { &Failure($client,"refused\n",$userinput); return 1; } @@ -2816,6 +2825,92 @@ sub devalidate_meta_cache { } # +# Copy a file from /home/httpd/html/priv/domain/coursenum/ +# to /home/httpd/html/userfiles/domain/coursenum/priv +# +# Parameters: +# $cmd - The command that got us here. +# $tail - Tail of the command +# : separated list of escaped values for +# (a) relative path to a file in /priv/domain/coursenum +# (b) coursenum +# (c) domain +# $client - File descriptor connected to client. +# Returns +# 0 - Requested to exit, caller should shut down. +# 1 - Continue processing. +# + +sub crs_filefrompriv_handler { + my ($cmd, $tail, $client) = @_; + my $userinput = "$cmd:$tail"; + my ($path,$cnum,$cdom) = map { &unescape($_); } split(/:/,$tail); + $path =~ s/\.{2,}//g; + if (($path eq '') || ($path eq '.')) { + &Failure($client, "not_found\n", "$cmd:$tail"); + } else { + $cdom = &LONCAPA::clean_domain($cdom); + $cnum = &LONCAPA::clean_courseid($cnum); + if (&LONCAPA::Lond::is_course($cdom,$cnum)) { + my $toplevel = "/userfiles/$cdom/$cnum/priv"; + my $toppath = $perlvar{'lonDocRoot'}.$toplevel; + my $dest = $toppath.'/'.$path; + my $desturl = $toplevel.'/'.$path; + my $src = $perlvar{'lonDocRoot'}.'/priv/'.$cdom.'/'.$cnum.'/'.$path; + my ($dest_mtime, $src_mtime); + if (-e $dest) { + ($dest_mtime) = (stat($dest))[9]; + } + if (-e $src) { + my $protocol = $Apache::lonnet::protocol{$perlvar{'lonHostID'}}; + $protocol = 'http' if ($protocol ne 'https'); + my $url = $protocol.'://'.&Apache::lonnet::hostname($perlvar{'lonHostID'}).$desturl; + ($src_mtime) = (stat($src))[9]; + if ((-e $dest) && ($dest_mtime >= $src_mtime)) { + my $result = &escape($url); + &Reply($client,\$result,$userinput); + } else { + my $reldir = $toplevel; + my ($subdir,$fname) = ($path =~ m{^(.+)/([^/]+)$}); + if ($subdir eq '') { + $fname = $path; + } else { + $reldir .= '/'.$subdir; + } + my $targetdir = $perlvar{'lonDocRoot'}; + my $dirfail; + foreach my $part (split(/\//,$reldir)) { + $targetdir .= '/'.$part; + if ((-e $targetdir)!=1) { + unless (mkdir($targetdir,0755)) { + $dirfail = 1; + last; + } + } + } + if ($dirfail) { + &Failure($client,"error: mkdir_failed\n", $userinput); + } else { + if (File::Copy::copy($src,$dest)) { + my $result = &escape($url); + &Reply($client,\$result,$userinput); + } else { + &Failure($client,"error: copy_failed\n", $userinput); + } + } + } + } else { + &Failure($client,"error: not_found\n", $userinput); + } + } else { + &Failure($client, "error: not_course\n", $userinput); + } + } + return 1; +} +®ister_handler("crsfilefrompriv", \&crs_filefrompriv_handler, 0, 1, 0); + +# # Fetch a user file from a remote server to the user's home directory # userfiles subdir. # Parameters: @@ -5264,9 +5359,9 @@ sub encrypted_get_domain_handler { # 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 +# 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 { @@ -5307,6 +5402,81 @@ sub lti_handler { ®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); + +# # Puts an id to a domains id database. # # Parameters: @@ -6074,12 +6244,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); @@ -6112,8 +6283,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); @@ -6147,10 +6322,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); @@ -6173,12 +6352,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); @@ -6198,6 +6378,7 @@ sub get_sections_handler { # Returns: # 1 - Processing should continue. # + sub validate_course_owner_handler { my ($cmd, $tail, $client) = @_; my $userinput = "$cmd:$tail"; @@ -6205,11 +6386,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); @@ -6235,11 +6417,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); @@ -6273,7 +6456,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); @@ -6406,10 +6588,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); @@ -6645,12 +6828,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); @@ -6710,11 +6897,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)).':'; @@ -7449,7 +7640,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"); @@ -8804,6 +8995,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)