--- loncom/lonnet/perl/lonnet.pm 2018/12/05 21:36:18 1.1393 +++ loncom/lonnet/perl/lonnet.pm 2018/12/27 18:14:50 1.1397 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1393 2018/12/05 21:36:18 raeburn Exp $ +# $Id: lonnet.pm,v 1.1397 2018/12/27 18:14:50 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -311,9 +311,10 @@ sub get_server_loncaparev { $answer = &reply('serverloncaparev',$lonhost); if (($answer eq 'unknown_cmd') || ($answer eq 'con_lost')) { if ($caller eq 'loncron') { + my $hostname = &hostname($lonhost); my $protocol = $protocol{$lonhost}; $protocol = 'http' if ($protocol ne 'https'); - my $url = $protocol.'://'.&hostname($lonhost).'/adm/about.html'; + my $url = $protocol.'://'.$hostname.'/adm/about.html'; my $request=new HTTP::Request('GET',$url); my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,4,1); unless ($response->is_error()) { @@ -458,8 +459,26 @@ sub reply { unless (defined(&hostname($server))) { return 'no_such_host'; } my $answer=subreply($cmd,$server); if (($answer=~/^refused/) || ($answer=~/^rejected/)) { - &logthis("WARNING:". - " $cmd to $server returned $answer"); + my $logged = $cmd; + if ($cmd =~ /^encrypt:([^:]+):/) { + my $subcmd = $1; + if (($subcmd eq 'auth') || ($subcmd eq 'passwd') || + ($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || + ($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades')) { + (undef,undef,my @rest) = split(/:/,$cmd); + if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) { + splice(@rest,2,1,'Hidden'); + } elsif ($subcmd eq 'passwd') { + splice(@rest,2,2,('Hidden','Hidden')); + } elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') || + ($subcmd eq 'autoexportgrades')) { + splice(@rest,3,1,'Hidden'); + } + $logged = join(':',('encrypt:'.$subcmd,@rest)); + } + } + &logthis("WARNING:". + " $logged to $server returned $answer"); } return $answer; } @@ -711,6 +730,7 @@ sub check_for_valid_session { if (!defined($disk_env{'user.name'}) || !defined($disk_env{'user.domain'})) { + untie(%disk_env); return undef; } @@ -723,6 +743,7 @@ sub check_for_valid_session { $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'}; } } + untie(%disk_env); return $handle; } @@ -987,13 +1008,13 @@ sub spareserver { } if (!$want_server_name) { - my $protocol = 'http'; - if ($protocol{$spare_server} eq 'https') { - $protocol = $protocol{$spare_server}; - } if (defined($spare_server)) { my $hostname = &hostname($spare_server); if (defined($hostname)) { + my $protocol = 'http'; + if ($protocol{$spare_server} eq 'https') { + $protocol = $protocol{$spare_server}; + } $spare_server = $protocol.'://'.$hostname; } } @@ -1739,7 +1760,7 @@ sub trusted_domains { if (&domain($calldom) eq '') { return ($trusted,$untrusted); } - unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) { + unless ($cmdtype =~ /^(content|shared|enroll|coaurem|othcoau|domroles|catalog|reqcrs|msg)$/) { return ($trusted,$untrusted); } my $callprimary = &domain($calldom,'primary'); @@ -1761,6 +1782,7 @@ sub trusted_domains { map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; } if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') { + $possinc{$intcalldom} = 1; map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}}; } } @@ -1795,12 +1817,12 @@ sub trusted_domains { } foreach my $exc (@allexc) { if (ref($doms_by_intdom{$exc}) eq 'ARRAY') { - $untrusted = $doms_by_intdom{$exc}; + push(@{$untrusted},@{$doms_by_intdom{$exc}}); } } foreach my $inc (@allinc) { if (ref($doms_by_intdom{$inc}) eq 'ARRAY') { - $trusted = $doms_by_intdom{$inc}; + push(@{$trusted},@{$doms_by_intdom{$inc}}); } } } @@ -3355,10 +3377,10 @@ sub remove_stale_resfile { (grep { $_ eq $homeserver } ¤t_machine_ids())) { my $fname = &filelocation('',$url); if (-e $fname) { - my $protocol = $protocol{$homeserver}; - $protocol = 'http' if ($protocol ne 'https'); my $hostname = &hostname($homeserver); if ($hostname) { + my $protocol = $protocol{$homeserver}; + $protocol = 'http' if ($protocol ne 'https'); my $uri = &declutter($url); my $request=new HTTP::Request('HEAD',$protocol.'://'.$hostname.'/raw/'.$uri); my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,5,0,1); @@ -13336,9 +13358,10 @@ sub repcopy_userfile { my $request; $uri=~s/^\///; my $homeserver = &homeserver($cnum,$cdom); + my $hostname = &hostname($homeserver); my $protocol = $protocol{$homeserver}; $protocol = 'http' if ($protocol ne 'https'); - $request=new HTTP::Request('GET',$protocol.'://'.&hostname($homeserver).'/raw/'.$uri); + $request=new HTTP::Request('GET',$protocol.'://'.$hostname.'/raw/'.$uri); my $response = &LONCAPA::LWPReq::makerequest($homeserver,$request,$transferfile,\%perlvar,'',0,1); # did it work? if ($response->is_error()) { @@ -13362,9 +13385,10 @@ sub tokenwrapper { $file=~s|(\?\.*)*$||; &appenv({"userfile.$udom/$uname/$file" => $env{'request.course.id'}}); my $homeserver = &homeserver($uname,$udom); + my $hostname = &hostname($homeserver); my $protocol = $protocol{$homeserver}; $protocol = 'http' if ($protocol ne 'https'); - return $protocol.'://'.&hostname($homeserver).'/'.$uri. + return $protocol.'://'.$hostname.'/'.$uri. (($uri=~/\?/)?'&':'?').'token='.$token. '&tokenissued='.$perlvar{'lonHostID'}; } else { @@ -13380,9 +13404,10 @@ sub getuploaded { my ($reqtype,$uri,$cdom,$cnum,$info,$rtncode) = @_; $uri=~s/^\///; my $homeserver = &homeserver($cnum,$cdom); + my $hostname = &hostname($homeserver); my $protocol = $protocol{$homeserver}; $protocol = 'http' if ($protocol ne 'https'); - $uri = $protocol.'://'.&hostname($homeserver).'/raw/'.$uri; + $uri = $protocol.'://'.$hostname.'/raw/'.$uri; my $request=new HTTP::Request($reqtype,$uri); my $response=&LONCAPA::LWPReq::makerequest($homeserver,$request,'',\%perlvar,'',0,1); $$rtncode = $response->code;