--- loncom/lonnet/perl/lonnet.pm	2021/01/04 13:41:25	1.1172.2.118.2.14
+++ loncom/lonnet/perl/lonnet.pm	2021/11/09 20:51:53	1.1172.2.140.2.2
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.118.2.14 2021/01/04 13:41:25 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.140.2.2 2021/11/09 20:51:53 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -125,7 +125,7 @@ our @EXPORT = qw(%env);
 	$logid ++;
         my $now = time();
 	my $id=$now.'00000'.$$.'00000'.$logid;
-        my $ip = &get_requestor_ip();
+        my $ip = &get_requestor_ip();  
         my $logentry = {
                          $id => {
                                   'exe_uname' => $env{'user.name'},
@@ -1376,6 +1376,15 @@ sub spare_can_host {
             $canhost = 0;
         }
     }
+    if ($canhost) {
+        if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') {
+            if ($defdomdefaults{'offloadoth'}{$try_server}) {
+                unless (&shared_institution($udom,$try_server)) {
+                    $canhost = 0;
+                }
+            }
+        }
+    }
     if (($canhost) && ($uint_dom)) {
         my @intdoms;
         my $internet_names = &get_internet_names($try_server);
@@ -1890,9 +1899,10 @@ sub get_dom {
     }
     if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep;
-        if ($namespace =~ /^enc/) {
-            $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
-        } else {
+        if (grep { $_ eq $uhome } &current_machine_ids()) {
+            # domain information is hosted on this machine
+            $rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items");
+        } else {        
             $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         }
         my %returnhash;
@@ -1938,11 +1948,7 @@ sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }
         $items=~s/\&$//;
-        if ($namespace =~ /^enc/) {
-            return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);
-        } else {
-            return &reply("putdom:$udom:$namespace:$items",$uhome);
-        }
+        return &reply("putdom:$udom:$namespace:$items",$uhome);
     } else {
         &logthis("put_dom failed - no homeserver and/or domain");
     }
@@ -2425,6 +2431,9 @@ sub get_domain_defaults {
         if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
             $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};
         }
+        if (ref($domconfig{'usersessions'}{'offloadoth'}) eq 'HASH') {
+            $domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'};
+        }
     }
     if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
         if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
@@ -2559,22 +2568,6 @@ sub get_passwdconf {
     return %passwdconf;
 }
 
-sub course_portal_url {
-    my ($cnum,$cdom) = @_;
-    my $chome = &homeserver($cnum,$cdom);
-    my $hostname = &hostname($chome);
-    my $protocol = $protocol{$chome};
-    $protocol = 'http' if ($protocol ne 'https');
-    my %domdefaults = &get_domain_defaults($cdom);
-    my $firsturl;
-    if ($domdefaults{'portal_def'}) {
-        $firsturl = $domdefaults{'portal_def'};
-    } else {
-        $firsturl = $protocol.'://'.$hostname;
-    }
-    return $firsturl;
-}
-
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -3462,14 +3455,6 @@ sub can_edit_resource {
                             $cfile =  '/adm/wrapper'.$resurl;
                         }
                     }
-                } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {
-                    $incourse = 1;
-                    if ($env{'form.forceedit'}) {
-                        $forceview = 1;
-                    } else {
-                        $forceedit = 1;
-                    }
-                    $cfile = $resurl;
                 } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;
                     if ($env{'form.forceedit'}) {
@@ -3494,14 +3479,6 @@ sub can_edit_resource {
                     $forceedit = 1;
                 }
                 $cfile = $resurl;
-            } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
-                $incourse = 1;
-                if ($env{'form.forceedit'}) {
-                    $forceview = 1;
-                } else {
-                    $forceedit = 1;
-                }
-                $cfile = $resurl;
             } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                 $incourse = 1;
                 $forceview = 1;
@@ -3511,13 +3488,8 @@ sub can_edit_resource {
                     $cfile = &clutter($res);
                 } else {
                     $cfile = $env{'form.suppurl'};
-                    my $escfile = &unescape($cfile);
-                    if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
-                        $cfile = '/adm/wrapper'.$escfile;
-                    } else {
-                        $escfile =~ s{^http://}{};
-                        $cfile = &escape("/adm/wrapper/ext/$escfile");
-                    }
+                    $cfile =~ s{^http://}{};
+                    $cfile = '/adm/wrapper/ext/'.$cfile;
                 }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {
@@ -3764,6 +3736,10 @@ sub clean_filename {
 # Replace all .\d. sequences with _\d. so they no longer look like version
 # numbers
     $fname=~s/\.(\d+)(?=\.)/_$1/g;
+# Replace three or more adjacent underscores with one for consistency
+# with loncfile::filename_check() so complete url can be extracted by
+# lonnet::decode_symb()
+    $fname=~s/_{3,}/_/g;
     return $fname;
 }
 
@@ -5907,7 +5883,7 @@ sub tmpreset {
   if (!$domain) { $domain=$env{'user.domain'}; }
   if (!$stuname) { $stuname=$env{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {
-      $stuname=$ENV{'REMOTE_ADDR'};
+      $stuname=&get_requestor_ip();
   }
   my $path=LONCAPA::tempdir();
   my %hash;
@@ -5944,7 +5920,7 @@ sub tmpstore {
   if (!$domain) { $domain=$env{'user.domain'}; }
   if (!$stuname) { $stuname=$env{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {
-      $stuname=$ENV{'REMOTE_ADDR'};
+      $stuname=&get_requestor_ip();
   }
   my $now=time;
   my %hash;
@@ -5988,7 +5964,7 @@ sub tmprestore {
   if (!$domain) { $domain=$env{'user.domain'}; }
   if (!$stuname) { $stuname=$env{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {
-      $stuname=$ENV{'REMOTE_ADDR'};
+      $stuname=&get_requestor_ip();
   }
   my %returnhash;
   $namespace=~s/\//\_/g;
@@ -6044,7 +6020,7 @@ sub store {
     }
     if (!$home) { $home=$env{'user.home'}; }
 
-    $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
+    $$storehash{'ip'}=&get_requestor_ip();
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
@@ -6080,7 +6056,7 @@ sub cstore {
     }
     if (!$home) { $home=$env{'user.home'}; }
 
-    $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
+    $$storehash{'ip'}=&get_requestor_ip();
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
@@ -6937,7 +6913,7 @@ sub currentdump {
    #
    my %returnhash=();
    #
-   if ($rep eq 'unknown_cmd') {
+   if ($rep eq "unknown_cmd") { 
        # an old lond will not know currentdump
        # Do a dump and make it look like a currentdump
        my @tmp = &dumpstore($courseid,$sdom,$sname,'.');
@@ -7871,7 +7847,7 @@ sub allowed {
 
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
-    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme|ext\.tool)$})) 
+    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme)$})) 
 	 || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
 	&& ($priv eq 'bre')) {
 	return 'F';
@@ -8118,7 +8094,7 @@ sub allowed {
 	&& &is_portfolio_url($uri)) {
 	$thisallowed = &portfolio_access($uri,$clientip);
     }
-
+    
 # Full access at system, domain or course-wide level? Exit.
     if ($thisallowed=~/F/) {
 	return 'F';
@@ -8505,7 +8481,11 @@ sub get_commblock_resources {
     my ($blocks) = @_;
     my %blockers = ();
     return %blockers unless ($env{'request.course.id'});
-    return %blockers if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
+    my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
+    if ($env{'request.course.sec'}) {
+        $courseurl .= '/'.$env{'request.course.sec'};
+    }
+    return %blockers if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
     my %commblocks;
     if (ref($blocks) eq 'HASH') {
         %commblocks = %{$blocks};
@@ -8583,7 +8563,7 @@ sub get_commblock_resources {
                         }
                     }
                     if ($interval[0] =~ /^(\d+)/) {
-                        my $timelimit = $1; 
+                        my $timelimit = $1;
                         my $first_access;
                         if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);
@@ -8629,8 +8609,12 @@ sub has_comm_blocking {
     my @blockers;
     return unless ($env{'request.course.id'});
     return unless ($priv eq 'bre');
-    return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
     return if ($env{'request.state'} eq 'construct');
+    my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
+    if ($env{'request.course.sec'}) {
+        $courseurl .= '/'.$env{'request.course.sec'};
+    }
+    return if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
     my %blockinfo;
     if (ref($blocks) eq 'HASH') {
         %blockinfo = &get_commblock_resources($blocks);
@@ -10330,19 +10314,14 @@ sub writecoursepref {
 
 sub createcourse {
     my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
-        $course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_;
+        $course_owner,$crstype,$cnum,$context,$category)=@_;
     $url=&declutter($url);
     my $cid='';
     if ($context eq 'requestcourses') {
         my $can_create = 0;
         my ($ownername,$ownerdom) = split(':',$course_owner);
         if ($udom eq $ownerdom) {
-            my $reload;
-            if (($callercontext eq 'auto') &&
-               ($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) {
-                $reload = 'reload';
-            }
-            if (&usertools_access($ownername,$ownerdom,$category,$reload,
+            if (&usertools_access($ownername,$ownerdom,$category,undef,
                                   $context)) {
                 $can_create = 1;
             }
@@ -11351,7 +11330,7 @@ sub get_userresdata {
 #  Parameters:
 #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.
-#     $type      - Type of thing $name is (must be 'course' or 'user')
+#     $type      - Type of thing $name is (must be 'course' or 'user'
 #     @which     - Array of names of resources desired.
 #  Returns:
 #     The value of the first reasource in @which that is found in the
@@ -11372,47 +11351,11 @@ sub resdata {
     foreach my $item (@which) {
 	if (defined($result->{$item->[0]})) {
 	    return [$result->{$item->[0]},$item->[1]];
-        }
+	}
     }
     return undef;
 }
 
-sub get_domain_lti {
-    my ($cdom,$context) = @_;
-    my ($name,%lti);
-    if ($context eq 'consumer') {
-        $name = 'ltitools';
-    } elsif ($context eq 'provider') {
-        $name = 'lti';
-    } else {
-        return %lti;
-    }
-    my ($result,$cached)=&is_cached_new($name,$cdom);
-    if (defined($cached)) {
-        if (ref($result) eq 'HASH') {
-            %lti = %{$result};
-        }
-    } else {
-        my %domconfig = &get_dom('configuration',[$name],$cdom);
-        if (ref($domconfig{$name}) eq 'HASH') {
-            %lti = %{$domconfig{$name}};
-            my %encdomconfig = &get_dom('encconfig',[$name],$cdom);
-            if (ref($encdomconfig{$name}) eq 'HASH') {
-                foreach my $id (keys(%lti)) {
-                    if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
-                        foreach my $item ('key','secret') {
-                            $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
-                        }
-                    }
-                }
-            }
-        }
-        my $cachetime = 24*60*60;
-        &do_cache_new($name,$cdom,\%lti,$cachetime);
-    }
-    return %lti;
-}
-
 sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;
@@ -11868,7 +11811,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -13436,9 +13379,12 @@ sub default_login_domain {
 }
 
 sub shared_institution {
-    my ($dom) = @_;
+    my ($dom,$lonhost) = @_;
+    if ($lonhost eq '') {
+        $lonhost = $perlvar{'lonHostID'};
+    }
     my $same_intdom;
-    my $hostintdom = &internet_dom($perlvar{'lonHostID'});
+    my $hostintdom = &internet_dom($lonhost);
     if ($hostintdom ne '') {
         my %iphost = &get_iphost();
         my $primary_id = &domain($dom,'primary');
@@ -13556,8 +13502,6 @@ sub clutter {
 #		&logthis("Got a blank emb style");
 	    }
 	}
-    } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
-        $thisfn='/adm/wrapper'.$thisfn;
     }
     return $thisfn;
 }