--- loncom/lonnet/perl/lonnet.pm	2018/04/29 00:56:53	1.1172.2.93.4.10
+++ loncom/lonnet/perl/lonnet.pm	2018/09/04 20:22:43	1.1172.2.97
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.93.4.10 2018/04/29 00:56:53 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.97 2018/09/04 20:22:43 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -695,16 +695,19 @@ sub appenv {
                 $env{$key}=$newenv->{$key};
             }
         }
-        my $opened = open(my $env_file,'+<',$env{'user.environment'});
-        if ($opened
-	    && &timed_flock($env_file,LOCK_EX)
-	    &&
-	    tie(my %disk_env,'GDBM_File',$env{'user.environment'},
-	        (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
-	    while (my ($key,$value) = each(%{$newenv})) {
-	        $disk_env{$key} = $value;
-	    }
-	    untie(%disk_env);
+        my $lonids = $perlvar{'lonIDsDir'};
+        if ($env{'user.environment'} =~ m{^\Q$lonids/\E$match_username\_\d+\_$match_domain\_[\w\-.]+\.id$}) {
+            my $opened = open(my $env_file,'+<',$env{'user.environment'});
+            if ($opened
+	        && &timed_flock($env_file,LOCK_EX)
+	        &&
+	        tie(my %disk_env,'GDBM_File',$env{'user.environment'},
+	            (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
+	        while (my ($key,$value) = each(%{$newenv})) {
+	            $disk_env{$key} = $value;
+	        }
+	        untie(%disk_env);
+            }
         }
     }
     return 'ok';
@@ -1697,12 +1700,7 @@ sub get_dom {
         }
     }
     if ($udom && $uhome && ($uhome ne 'no_host')) {
-        my $rep;
-        if ($namespace =~ /^enc/) {
-            $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
-        } else {
-            $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
-        }
+        my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         my %returnhash;
         if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;
@@ -1746,11 +1744,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");
     }
@@ -1841,17 +1835,6 @@ sub inst_directory_query {
     my $homeserver = &domain($udom,'primary');
     my $outcome;
     if ($homeserver ne '') {
-        unless ($homeserver eq $perlvar{'lonHostID'}) {
-            if ($srch->{'srchby'} eq 'email') {
-                my $lcrev = &get_server_loncaparev(undef,$homeserver);
-                my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/);
-                if (($major eq '' && $minor eq '') || ($major < 2) ||
-                    (($major == 2) && ($minor < 11)) || 
-                    (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/))) {
-                    return;
-                }
-            }
-        }
 	my $queryid=&reply("querysend:instdirsearch:".
 			   &escape($srch->{'srchby'}).':'.
 			   &escape($srch->{'srchterm'}).':'.
@@ -1893,15 +1876,6 @@ sub usersearch {
     my $query = 'usersearch';
     foreach my $tryserver (keys(%libserv)) {
         if (&host_domain($tryserver) eq $dom) {
-            unless ($tryserver eq $perlvar{'lonHostID'}) {
-                if ($srch->{'srchby'} eq 'email') {
-                    my $lcrev = &get_server_loncaparev(undef,$tryserver);
-                    my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/);
-                    next if (($major eq '' && $minor eq '') || ($major < 2) ||
-                             (($major == 2) && ($minor < 11)) || 
-                             (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/)));
-                }
-            }
             my $host=&hostname($tryserver);
             my $queryid=
                 &reply("querysend:".&escape($query).':'.
@@ -2282,22 +2256,6 @@ sub get_domain_defaults {
     return %domdefaults;
 }
 
-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 {
@@ -3058,14 +3016,6 @@ sub can_edit_resource {
                         $forceedit = 1;
                     }
                     $cfile = $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'}) {
@@ -3090,14 +3040,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;
@@ -3107,13 +3049,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'}) {
@@ -3448,7 +3385,7 @@ sub userfileupload {
             } else {
                 $docudom = $env{'user.domain'};
             }
-            if ($destuname =~ /^$match_username$/) {
+            if ($destuname =~ /^$match_username$/) { 
                 $docuname = $destuname;
             } else {
                 $docuname = $env{'user.name'};
@@ -4828,10 +4765,9 @@ my %cachedtimes=();
 my $cachedtime='';
 
 sub load_all_first_access {
-    my ($uname,$udom,$ignorecache)=@_;
+    my ($uname,$udom)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&
-        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
-        (!$ignorecache)) {
+        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
         return;
     }
     $cachedtime=time;
@@ -4840,7 +4776,7 @@ sub load_all_first_access {
 }
 
 sub get_first_access {
-    my ($type,$argsymb,$argmap,$ignorecache)=@_;
+    my ($type,$argsymb,$argmap)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);
@@ -4852,7 +4788,7 @@ sub get_first_access {
     } else {
 	$res=$symb;
     }
-    &load_all_first_access($uname,$udom,$ignorecache);
+    &load_all_first_access($uname,$udom);
     return $cachedtimes{"$courseid\0$res"};
 }
 
@@ -4882,6 +4818,9 @@ sub set_first_access {
                         'course.'.$courseid.'.timerinterval.'.$res => $interval,
                      }
                   );
+            if (($cachedtime) && (abs($start-$cachedtime) < 5)) {
+                $cachedtimes{"$courseid\0$res"} = $start;
+            }
         }
         return $putres;
     }
@@ -6258,7 +6197,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,'.');
@@ -7191,7 +7130,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|ext\.tool)$})) 
+    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) 
 	 || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
 	&& ($priv eq 'bre')) {
 	return 'F';
@@ -7852,8 +7791,7 @@ sub get_commblock_resources {
                             }
                         }
                     }
-                    if ($interval[0] =~ /^(\d+)/) {
-                        my $timelimit = $1;
+                    if ($interval[0] =~ /^\d+$/) {
                         my $first_access;
                         if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);
@@ -7863,7 +7801,7 @@ sub get_commblock_resources {
                             $first_access=&get_first_access($interval[1]);
                         }
                         if ($first_access) {
-                            my $timesup = $first_access+$timelimit;
+                            my $timesup = $first_access+$interval[0];
                             if ($timesup > $now) {
                                 my $activeblock;
                                 foreach my $res (@to_test) {
@@ -9730,13 +9668,25 @@ sub generate_coursenum {
 sub is_course {
     my ($cdom, $cnum) = scalar(@_) == 1 ? 
          ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
-
-    return unless $cdom and $cnum;
-
-    my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,
-        '.');
-
-    return unless(exists($courses{$cdom.'_'.$cnum}));
+    return unless (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
+    my $uhome=&homeserver($cnum,$cdom);
+    my $iscourse;
+    if (grep { $_ eq $uhome } current_machine_ids()) {
+        $iscourse = &LONCAPA::Lond::is_course($cdom,$cnum);
+    } else {
+        my $hashid = $cdom.':'.$cnum;
+        ($iscourse,my $cached) = &is_cached_new('iscourse',$hashid);
+        unless (defined($cached)) {
+            my %courses = &courseiddump($cdom, '.', 1, '.', '.',
+                                        $cnum,undef,undef,'.');
+            $iscourse = 0;
+            if (exists($courses{$cdom.'_'.$cnum})) {
+                $iscourse = 1;
+            }
+            &do_cache_new('iscourse',$hashid,$iscourse,3600);
+        }
+    }
+    return unless($iscourse);
     return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
 }
 
@@ -9918,7 +9868,7 @@ sub files_not_in_path {
     my $filename = $user."savedfiles";
     my @return_files;
     my $path_part;
-    open(IN,'<',LONCAPA::tempdir().$filename);
+    open(IN, '<',LONCAPA::tempdir().$filename);
     while (my $line = <IN>) {
         #ok, I know it's clunky, but I want it to work
         my @paths_and_file = split(m|/|, $line);
@@ -10578,7 +10528,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
@@ -10597,44 +10547,13 @@ sub resdata {
     }
     if (!ref($result)) { return $result; }    
     foreach my $item (@which) {
-        if (ref($item) eq 'ARRAY') {
-	    if (defined($result->{$item->[0]})) {
-	        return [$result->{$item->[0]},$item->[1]];
-	    }
-        }
+	if (defined($result->{$item->[0]})) {
+	    return [$result->{$item->[0]},$item->[1]];
+	}
     }
     return undef;
 }
 
-sub get_domain_ltitools {
-    my ($cdom) = @_;
-    my %ltitools;
-    my ($result,$cached)=&is_cached_new('ltitools',$cdom);
-    if (defined($cached)) {
-        if (ref($result) eq 'HASH') {
-            %ltitools = %{$result};
-        }
-    } else {
-        my %domconfig = &get_dom('configuration',['ltitools'],$cdom);
-        if (ref($domconfig{'ltitools'}) eq 'HASH') {
-            %ltitools = %{$domconfig{'ltitools'}};
-            my %encdomconfig = &get_dom('encconfig',['ltitools'],$cdom);
-            if (ref($encdomconfig{'ltitools'}) eq 'HASH') {
-                foreach my $id (keys(%ltitools)) {
-                    if (ref($encdomconfig{'ltitools'}{$id}) eq 'HASH') {
-                        foreach my $item ('key','secret') {
-                            $ltitools{$id}{$item} = $encdomconfig{'ltitools'}{$id}{$item};
-                        }
-                    }
-                }
-            }
-        }
-        my $cachetime = 24*60*60;
-        &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);
-    }
-    return %ltitools;
-}
-
 sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;
@@ -11083,14 +11002,13 @@ sub add_prefix_and_part {
 
 my %metaentry;
 my %importedpartids;
-my %importedrespids;
 sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);
     # 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;
     }
@@ -11111,11 +11029,9 @@ sub metadata {
     }
     {
 # Imported parts would go here
-        my @origfiletagids=();
+        my %importedids=();
+        my @origfileimportpartids=();
         my $importedparts=0;
-
-# Imported responseids would go here
-        my $importedresponses=0;
 #
 # Is this a recursive call for a library?
 #
@@ -11210,37 +11126,8 @@ sub metadata {
                         my $dir=$filename;
                         $dir=~s|[^/]*$||;
                         $location=&filelocation($dir,$location);
-
-                        my $importid=$token->[2]->{'id'};
+                       
                         my $importmode=$token->[2]->{'importmode'};
-#
-# Check metadata for imported file to
-# see if it contained response items
-#
-                        my %currmetaentry = %metaentry;
-                        my $libresponseorder = &metadata($location,'responseorder');
-                        my $origfile;
-                        if ($libresponseorder ne '') {
-                            if ($#origfiletagids<0) {
-                                undef(%importedrespids);
-                                undef(%importedpartids);
-                            }
-                            @{$importedrespids{$importid}} = split(/\s*,\s*/,$libresponseorder);
-                            if (@{$importedrespids{$importid}} > 0) {
-                                $importedresponses = 1;
-# We need to get the original file and the imported file to get the response order correct
-# Load and inspect original file
-                                if ($#origfiletagids<0) {
-                                    my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
-                                    $origfile=&getfile($origfilelocation);
-                                    @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
-                                }
-                            }
-                        }
-# Do not overwrite contents of %metaentry hash for resource itself with 
-# hash populated for imported library file
-                        %metaentry = %currmetaentry;
-                        undef(%currmetaentry);
                         if ($importmode eq 'problem') {
 # Import as problem/response
                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
@@ -11249,15 +11136,12 @@ sub metadata {
                            $importedparts=1;
 # We need to get the original file and the imported file to get the part order correct
 # Good news: we do not need to worry about nested libraries, since parts cannot be nested
-# Load and inspect original file if we didn't do that already
-                           if ($#origfiletagids<0) {
-                               undef(%importedrespids);
-                               undef(%importedpartids);
-                               if ($origfile eq '') {
-                                   my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
-                                   $origfile=&getfile($origfilelocation);
-                                   @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
-                               }
+# Load and inspect original file
+                           if ($#origfileimportpartids<0) {
+                              undef(%importedpartids);
+                              my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
+                              my $origfile=&getfile($origfilelocation);
+                              @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                            }
 
 # Load and inspect imported file
@@ -11371,48 +11255,20 @@ sub metadata {
 	    grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
 	$metaentry{':packages'} = join(',',@uniq_packages);
 
-        if (($importedresponses) || ($importedparts)) {
-            if ($importedparts) {
+        if ($importedparts) {
 # We had imported parts and need to rebuild partorder
-                $metaentry{':partorder'}='';
-                $metathesekeys{'partorder'}=1;
-            }
-            if ($importedresponses) {
-# We had imported responses and need to rebuild responseorder
-                $metaentry{':responseorder'}='';
-                $metathesekeys{'responseorder'}=1;
-            }
-            for (my $index=0;$index<$#origfiletagids;$index+=2) {
-                my $origid = $origfiletagids[$index+1];
-                if ($origfiletagids[$index] eq 'part') {
-# Original part, part of the problem
-                    if ($importedparts) {
-                        $metaentry{':partorder'}.=','.$origid;
-                    }
-                } elsif ($origfiletagids[$index] eq 'import') {
-                    if ($importedparts) {
-# We have imported parts at this position
-                        $metaentry{':partorder'}.=','.$importedpartids{$origid};
-                    }
-                    if ($importedresponses) {
-# We have imported responses at this position
-                        if (ref($importedrespids{$origid}) eq 'ARRAY') {
-                            $metaentry{':responseorder'}.=','.join(',',map { $origid.'_'.$_ } @{$importedrespids{$origid}});
-                        }
-                    }
-                } else {
-# Original response item, part of the problem
-                    if ($importedresponses) {
-                        $metaentry{':responseorder'}.=','.$origid;
-                    }
-                }
-            }
-            if ($importedparts) {
-                $metaentry{':partorder'}=~s/^\,//;
-            }
-            if ($importedresponses) {
-                $metaentry{':responseorder'}=~s/^\,//;
-            }
+           $metaentry{':partorder'}='';
+           $metathesekeys{'partorder'}=1;
+           for (my $index=0;$index<$#origfileimportpartids;$index+=2) {
+               if ($origfileimportpartids[$index] eq 'part') {
+# original part, part of the problem
+                  $metaentry{':partorder'}.=','.$origfileimportpartids[$index+1];
+               } else {
+# we have imported parts at this position
+                  $metaentry{':partorder'}.=','.$importedpartids{$origfileimportpartids[$index+1]};
+               }
+           }
+           $metaentry{':partorder'}=~s/^\,//;
         }
 
 	$metaentry{':keys'} = join(',',keys(%metathesekeys));
@@ -12684,8 +12540,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;
 }
@@ -12759,15 +12613,17 @@ sub get_dns {
     }
 
     my %alldns;
-    open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");
-    foreach my $dns (<$config>) {
-	next if ($dns !~ /^\^(\S*)/x);
-        my $line = $1;
-        my ($host,$protocol) = split(/:/,$line);
-        if ($protocol ne 'https') {
-            $protocol = 'http';
+    if (open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab")) {
+        foreach my $dns (<$config>) {
+	    next if ($dns !~ /^\^(\S*)/x);
+            my $line = $1;
+            my ($host,$protocol) = split(/:/,$line);
+            if ($protocol ne 'https') {
+                $protocol = 'http';
+            }
+	    $alldns{$host} = $protocol;
         }
-	$alldns{$host} = $protocol;
+        close($config);
     }
     while (%alldns) {
 	my ($dns) = sort { $b cmp $a } keys(%alldns);