--- loncom/lonnet/perl/lonnet.pm	2017/05/13 13:58:49	1.1172.2.93
+++ loncom/lonnet/perl/lonnet.pm	2018/03/28 10:22:10	1.1172.2.93.4.8
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.93 2017/05/13 13:58:49 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.93.4.8 2018/03/28 10:22:10 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -142,7 +142,7 @@ our @EXPORT = qw(%env);
 sub logtouch {
     my $execdir=$perlvar{'lonDaemons'};
     unless (-e "$execdir/logs/lonnet.log") {	
-	open(my $fh,">>$execdir/logs/lonnet.log");
+	open(my $fh,">>","$execdir/logs/lonnet.log");
 	close $fh;
     }
     my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
@@ -154,7 +154,7 @@ sub logthis {
     my $execdir=$perlvar{'lonDaemons'};
     my $now=time;
     my $local=localtime($now);
-    if (open(my $fh,">>$execdir/logs/lonnet.log")) {
+    if (open(my $fh,">>","$execdir/logs/lonnet.log")) {
 	my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string.
 	print $fh $logstring;
 	close($fh);
@@ -167,7 +167,7 @@ sub logperm {
     my $execdir=$perlvar{'lonDaemons'};
     my $now=time;
     my $local=localtime($now);
-    if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) {
+    if (open(my $fh,">>","$execdir/logs/lonnet.perm.log")) {
 	print $fh "$now:$message:$local\n";
 	close($fh);
     }
@@ -436,7 +436,7 @@ sub reconlonc {
 
     &logthis("Trying to reconnect lonc");
     my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid";
-    if (open(my $fh,"<$loncfile")) {
+    if (open(my $fh,"<",$loncfile)) {
 	my $loncpid=<$fh>;
         chomp($loncpid);
         if (kill 0 => $loncpid) {
@@ -476,7 +476,7 @@ sub critical {
             $dumpcount++;
             {
 		my $dfh;
-		if (open($dfh,">$dfilename")) {
+		if (open($dfh,">",$dfilename)) {
 		    print $dfh "$cmd\n"; 
 		    close($dfh);
 		}
@@ -485,7 +485,7 @@ sub critical {
             my $wcmd='';
             {
 		my $dfh;
-		if (open($dfh,"<$dfilename")) {
+		if (open($dfh,"<",$dfilename)) {
 		    $wcmd=<$dfh>; 
 		    close($dfh);
 		}
@@ -601,7 +601,7 @@ sub transfer_profile_to_env {
 
 # ---------------------------------------------------- Check for valid session 
 sub check_for_valid_session {
-    my ($r,$name,$userhashref) = @_;
+    my ($r,$name,$userhashref,$domref) = @_;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
     if ($name eq '') {
         $name = 'lonID';
@@ -616,7 +616,16 @@ sub check_for_valid_session {
     } else {
         $lonidsdir=$r->dir_config('lonIDsDir');
     }
-    return undef if (!-e "$lonidsdir/$handle.id");
+    if (!-e "$lonidsdir/$handle.id") {
+        if ((ref($domref)) && ($name eq 'lonID') &&
+            ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) {
+            my ($possuname,$possudom,$possuhome) = ($1,$2,$3);
+            if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) {
+                $$domref = $possudom;
+            }
+        }
+        return undef;
+    }
 
     my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id");
     return undef if (!$opened);
@@ -1688,7 +1697,12 @@ sub get_dom {
         }
     }
     if ($udom && $uhome && ($uhome ne 'no_host')) {
-        my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+        my $rep;
+        if ($namespace =~ /^enc/) {
+            $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
+        } else {
+            $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
+        }
         my %returnhash;
         if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;
@@ -1732,7 +1746,11 @@ sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }
         $items=~s/\&$//;
-        return &reply("putdom:$udom:$namespace:$items",$uhome);
+        if ($namespace =~ /^enc/) {
+            return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);
+        } else {
+            return &reply("putdom:$udom:$namespace:$items",$uhome);
+        }
     } else {
         &logthis("put_dom failed - no homeserver and/or domain");
     }
@@ -1823,13 +1841,24 @@ 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'}).':'.
 			   &escape($srch->{'srchtype'}),$homeserver);
 	my $host=&hostname($homeserver);
 	if ($queryid !~/^\Q$host\E\_/) {
-	    &logthis('institutional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.'in domain '.$udom);
+	    &logthis('institutional directory search invalid queryid: '.$queryid.' for host: '.$homeserver.' in domain '.$udom);
 	    return;
 	}
 	my $response = &get_query_reply($queryid);
@@ -1864,6 +1893,15 @@ 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).':'.
@@ -2244,6 +2282,22 @@ 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 {
@@ -3004,6 +3058,14 @@ 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'}) {
@@ -3028,6 +3090,14 @@ 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;
@@ -3037,8 +3107,13 @@ sub can_edit_resource {
                     $cfile = &clutter($res);
                 } else {
                     $cfile = $env{'form.suppurl'};
-                    $cfile =~ s{^http://}{};
-                    $cfile = '/adm/wrapper/ext/'.$cfile;
+                    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");
+                    }
                 }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {
@@ -3194,7 +3269,7 @@ sub process_coursefile {
                                  $home);
             }
         } elsif ($action eq 'uploaddoc') {
-            open(my $fh,'>'.$filepath.'/'.$fname);
+            open(my $fh,'>',$filepath.'/'.$fname);
             print $fh $env{'form.'.$source};
             close($fh);
             if ($parser eq 'parse') {
@@ -3252,7 +3327,7 @@ sub store_edited_file {
     ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
     $fpath=$docudom.'/'.$docuname.'/'.$fpath;
     my $filepath = &build_filepath($fpath);
-    open(my $fh,'>'.$filepath.'/'.$fname);
+    open(my $fh,'>',$filepath.'/'.$fname);
     print $fh $content;
     close($fh);
     my $home=&homeserver($docuname,$docudom);
@@ -3368,12 +3443,12 @@ sub userfileupload {
                          '_'.$env{'user.domain'}.'/pending';
         } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
             my ($docuname,$docudom);
-            if ($destudom) {
+            if ($destudom =~ /^$match_domain$/) {
                 $docudom = $destudom;
             } else {
                 $docudom = $env{'user.domain'};
             }
-            if ($destuname) {
+            if ($destuname =~ /^$match_username$/) {
                 $docuname = $destuname;
             } else {
                 $docuname = $env{'user.name'};
@@ -3403,7 +3478,7 @@ sub userfileupload {
                 mkdir($fullpath,0777);
             }
         }
-        open(my $fh,'>'.$fullpath.'/'.$fname);
+        open(my $fh,'>',$fullpath.'/'.$fname);
         print $fh $env{'form.'.$formname};
         close($fh);
         if ($context eq 'existingfile') {
@@ -3478,7 +3553,7 @@ sub finishuserfileupload {
 
 # Save the file
     {
-	if (!open(FH,'>'.$filepath.'/'.$file)) {
+	if (!open(FH,'>',$filepath.'/'.$file)) {
 	    &logthis('Failed to create '.$filepath.'/'.$file);
 	    print STDERR ('Failed to create '.$filepath.'/'.$file."\n");
 	    return '/adm/notfound.html';
@@ -3536,7 +3611,8 @@ sub finishuserfileupload {
         my $input = $filepath.'/'.$file;
         my $output = $filepath.'/'.'tn-'.$file;
         my $thumbsize = $thumbwidth.'x'.$thumbheight;
-        system("convert -sample $thumbsize $input $output");
+        my @args = ('convert','-sample',$thumbsize,$input,$output);
+        system({$args[0]} @args);
         if (-e $filepath.'/'.'tn-'.$file) {
             $fetchthumb  = 1; 
         }
@@ -4496,7 +4572,7 @@ sub postannounce {
 
 sub getannounce {
 
-    if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) {
+    if (open(my $fh,"<",$perlvar{'lonDocRoot'}.'/announcement.txt')) {
 	my $announcement='';
 	while (my $line = <$fh>) { $announcement .= $line; }
 	close($fh);
@@ -4752,9 +4828,10 @@ my %cachedtimes=();
 my $cachedtime='';
 
 sub load_all_first_access {
-    my ($uname,$udom)=@_;
+    my ($uname,$udom,$ignorecache)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&
-        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
+        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
+        (!$ignorecache)) {
         return;
     }
     $cachedtime=time;
@@ -4763,7 +4840,7 @@ sub load_all_first_access {
 }
 
 sub get_first_access {
-    my ($type,$argsymb,$argmap)=@_;
+    my ($type,$argsymb,$argmap,$ignorecache)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);
@@ -4775,7 +4852,7 @@ sub get_first_access {
     } else {
 	$res=$symb;
     }
-    &load_all_first_access($uname,$udom);
+    &load_all_first_access($uname,$udom,$ignorecache);
     return $cachedtimes{"$courseid\0$res"};
 }
 
@@ -6181,7 +6258,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,'.');
@@ -7114,7 +7191,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)$})) 
+    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$})) 
 	 || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
 	&& ($priv eq 'bre')) {
 	return 'F';
@@ -7775,7 +7852,8 @@ sub get_commblock_resources {
                             }
                         }
                     }
-                    if ($interval[0] =~ /^\d+$/) {
+                    if ($interval[0] =~ /^(\d+)/) {
+                        my $timelimit = $1;
                         my $first_access;
                         if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);
@@ -7785,7 +7863,7 @@ sub get_commblock_resources {
                             $first_access=&get_first_access($interval[1]);
                         }
                         if ($first_access) {
-                            my $timesup = $first_access+$interval[0];
+                            my $timesup = $first_access+$timelimit;
                             if ($timesup > $now) {
                                 my $activeblock;
                                 foreach my $res (@to_test) {
@@ -8113,7 +8191,7 @@ sub fetch_enrollment_query {
                         if ($xml_classlist =~ /^error/) {
                             &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum);
                         } else {
-                            if ( open(FILE,">$destname") ) {
+                            if ( open(FILE,">",$destname) ) {
                                 print FILE &unescape($xml_classlist);
                                 close(FILE);
                             } else {
@@ -8142,7 +8220,7 @@ sub get_query_reply {
     for (1..$loopmax) {
 	sleep($sleep);
         if (-e $replyfile.'.end') {
-	    if (open(my $fh,$replyfile)) {
+	    if (open(my $fh,"<",$replyfile)) {
 		$reply = join('',<$fh>);
 		close($fh);
 	   } else { return 'error: reply_file_error'; }
@@ -9767,7 +9845,7 @@ sub save_selected_files {
     my ($user, $path, @files) = @_;
     my $filename = $user."savedfiles";
     my @other_files = &files_not_in_path($user, $path);
-    open (OUT, '>'.$tmpdir.$filename);
+    open (OUT,'>',LONCAPA::tempdir().$filename);
     foreach my $file (@files) {
         print (OUT $env{'form.currentpath'}.$file."\n");
     }
@@ -9781,7 +9859,7 @@ sub save_selected_files {
 sub clear_selected_files {
     my ($user) = @_;
     my $filename = $user."savedfiles";
-    open (OUT, '>'.LONCAPA::tempdir().$filename);
+    open (OUT,'>',LONCAPA::tempdir().$filename);
     print (OUT undef);
     close (OUT);
     return ("ok");    
@@ -9791,7 +9869,7 @@ sub files_in_path {
     my ($user, $path) = @_;
     my $filename = $user."savedfiles";
     my %return_files;
-    open (IN, '<'.LONCAPA::tempdir().$filename);
+    open (IN,'<',LONCAPA::tempdir().$filename);
     while (my $line_in = <IN>) {
         chomp ($line_in);
         my @paths_and_file = split (m!/!, $line_in);
@@ -9813,7 +9891,7 @@ sub files_not_in_path {
     my $filename = $user."savedfiles";
     my @return_files;
     my $path_part;
-    open(IN, '<'.LONCAPA::.$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);
@@ -10473,7 +10551,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
@@ -10492,13 +10570,44 @@ sub resdata {
     }
     if (!ref($result)) { return $result; }    
     foreach my $item (@which) {
-	if (defined($result->{$item->[0]})) {
-	    return [$result->{$item->[0]},$item->[1]];
-	}
+        if (ref($item) eq 'ARRAY') {
+	    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;
@@ -10947,13 +11056,14 @@ 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)$})) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -10974,9 +11084,11 @@ sub metadata {
     }
     {
 # Imported parts would go here
-        my %importedids=();
-        my @origfileimportpartids=();
+        my @origfiletagids=();
         my $importedparts=0;
+
+# Imported responseids would go here
+        my $importedresponses=0;
 #
 # Is this a recursive call for a library?
 #
@@ -11071,8 +11183,32 @@ 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 $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);
+                                }
+                            }
+                        }
                         if ($importmode eq 'problem') {
 # Import as problem/response
                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
@@ -11081,12 +11217,15 @@ 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
+# Load and inspect original file if we didn't do that already
                            if ($#origfileimportpartids<0) {
-                              undef(%importedpartids);
-                              my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
-                              my $origfile=&getfile($origfilelocation);
-                              @origfileimportpartids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                               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 imported file
@@ -11200,20 +11339,48 @@ sub metadata {
 	    grep { ! $seen{$_} ++ } (split(',',$metaentry{':packages'}));
 	$metaentry{':packages'} = join(',',@uniq_packages);
 
-        if ($importedparts) {
+        if (($importedresponses) || ($importedparts)) {
+            if ($importedparts) {
 # We had imported parts and need to rebuild partorder
-           $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{':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{':keys'} = join(',',keys(%metathesekeys));
@@ -12301,7 +12468,7 @@ sub readfile {
     my $file = shift;
     if ( (! -e $file ) || ($file eq '') ) { return -1; };
     my $fh;
-    open($fh,"<$file");
+    open($fh,"<",$file);
     my $a='';
     while (my $line = <$fh>) { $a .= $line; }
     return $a;
@@ -12414,7 +12581,7 @@ sub machine_ids {
 
 sub additional_machine_domains {
     my @domains;
-    open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab");
+    open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab");
     while( my $line = <$fh>) {
         $line =~ s/\s//g;
         push(@domains,$line);
@@ -12485,6 +12652,8 @@ 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;
 }
@@ -12558,7 +12727,7 @@ sub get_dns {
     }
 
     my %alldns;
-    open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");
     foreach my $dns (<$config>) {
 	next if ($dns !~ /^\^(\S*)/x);
         my $line = $1;
@@ -12586,7 +12755,7 @@ sub get_dns {
     close($config);
     my $which = (split('/',$url))[3];
     &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
-    open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
+    open($config,"<","$perlvar{'lonTabDir'}/dns_$which.tab");
     my @content = <$config>;
     &$func(\@content,$hashref);
     return;
@@ -12679,7 +12848,7 @@ sub fetch_dns_checksums {
 	my ($ignore_cache,$nocache) = @_;
 	&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache);
 	my $fh;
-	if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) {
+	if (open($fh,"<",$perlvar{'lonTabDir'}.'/domain.tab')) {
 	    my @lines = <$fh>;
 	    &parse_domain_tab(\@lines);
 	}
@@ -12731,8 +12900,23 @@ sub fetch_dns_checksums {
 	    my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
 	    $name=~s/\s//g;
 	    if ($id && $domain && $role && $name) {
+                if ((exists($hostname{$id})) && ($hostname{$id} ne '')) {
+                    my $curr = $hostname{$id};
+                    my $skip;
+                    if (ref($name_to_host{$curr}) eq 'ARRAY') {
+                        if (($curr eq $name) && (@{$name_to_host{$curr}} == 1)) {
+                            $skip = 1;
+                        } else {
+                            @{$name_to_host{$curr}} = grep { $_ ne $id } @{$name_to_host{$curr}};
+                        }
+                    }
+                    unless ($skip) {
+                        push(@{$name_to_host{$name}},$id);
+                    }
+                } else {
+                    push(@{$name_to_host{$name}},$id);
+                }
 		$hostname{$id}=$name;
-		push(@{$name_to_host{$name}}, $id);
 		$hostdom{$id}=$domain;
 		if ($role eq 'library') { $libserv{$id}=$name; }
                 if (defined($protocol)) {
@@ -12765,7 +12949,7 @@ sub fetch_dns_checksums {
     sub load_hosts_tab {
 	my ($ignore_cache,$nocache) = @_;
 	&get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache);
-	open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
+	open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");
 	my @config = <$config>;
 	&parse_hosts_tab(\@config);
 	close($config);
@@ -13031,7 +13215,7 @@ sub all_loncaparevs {
 {
     sub load_loncaparevs {
         if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
-            if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+            if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) {
                 while (my $configline=<$config>) {
                     chomp($configline);
                     my ($hostid,$loncaparev)=split(/:/,$configline);
@@ -13047,7 +13231,7 @@ sub all_loncaparevs {
 {
     sub load_serverhomeIDs {
         if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
-            if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+            if (open(my $config,"<","$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
                 while (my $configline=<$config>) {
                     chomp($configline);
                     my ($name,$id)=split(/:/,$configline);
@@ -13072,7 +13256,7 @@ BEGIN {
 
 # ------------------------------------------------------ Read spare server file
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/spare.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/spare.tab");
 
     while (my $configline=<$config>) {
        chomp($configline);
@@ -13086,7 +13270,7 @@ BEGIN {
 }
 # ------------------------------------------------------------ Read permissions
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab");
 
     while (my $configline=<$config>) {
 	chomp($configline);
@@ -13100,7 +13284,7 @@ BEGIN {
 
 # -------------------------------------------- Read plain texts for permissions
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/rolesplain.tab");
 
     while (my $configline=<$config>) {
 	chomp($configline);
@@ -13120,7 +13304,7 @@ BEGIN {
 
 # ---------------------------------------------------------- Read package table
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/packages.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/packages.tab");
 
     while (my $configline=<$config>) {
 	if ($configline !~ /\S/ || $configline=~/^#/) { next; }
@@ -13166,7 +13350,7 @@ BEGIN {
 # ---------------------------------------------------------- Read managers table
 {
     if (-e "$perlvar{'lonTabDir'}/managers.tab") {
-        if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) {
+        if (open(my $config,"<","$perlvar{'lonTabDir'}/managers.tab")) {
             while (my $configline=<$config>) {
                 chomp($configline);
                 next if ($configline =~ /^\#/);