--- loncom/lonnet/perl/lonnet.pm	2018/12/05 21:36:18	1.1393
+++ loncom/lonnet/perl/lonnet.pm	2018/12/27 20:10:56	1.1398
@@ -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.1398 2018/12/27 20:10:56 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("<font color=\"blue\">WARNING:".
-                " $cmd to $server returned $answer</font>");
+        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("<font color=\"blue\">WARNING:".
+                 " $logged to $server returned $answer</font>");
     }
     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 } &current_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;
@@ -13535,6 +13560,44 @@ sub default_login_domain {
     return $domain;
 }
 
+sub uses_sts {
+    my ($ignore_cache) = @_;
+    my $lonhost = $perlvar{'lonHostID'};
+    my $hostname = &hostname($lonhost);
+    my $sts_on;
+    if ($protocol{$lonhost} eq 'https') {
+        my $cachetime = 12*3600;
+        if (!$ignore_cache) {
+            ($sts_on,my $cached)=&is_cached_new('stspolicy',$lonhost);
+            if (defined($cached)) {
+                return $sts_on;
+            }
+        }
+        my $url = $protocol{$lonhost}.'://'.$hostname.'/index.html';
+        my $request=new HTTP::Request('HEAD',$url);
+        my $response=&LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,'','','',1);
+        if ($response->is_success) {
+            my $has_sts = $response->header('Strict-Transport-Security');
+            if ($has_sts eq '') {
+                $sts_on = 0;
+            } else {
+                if ($has_sts =~ /\Qmax-age=\E(\d+)/) {
+                    my $maxage = $1;
+                    if ($maxage) {
+                        $sts_on = 1;
+                    } else {
+                        $sts_on = 0;
+                    }
+                } else {
+                    $sts_on = 0;
+                }
+            }
+            return &do_cache_new('stspolicy',$lonhost,$sts_on,$cachetime);
+        }
+    }
+    return;
+}
+
 # ------------------------------------------------------------- Declutters URLs
 
 sub declutter {