--- loncom/lonnet/perl/lonnet.pm	2017/06/13 16:20:47	1.1172.2.93.2.1
+++ loncom/lonnet/perl/lonnet.pm	2018/04/29 00:56:53	1.1172.2.93.4.10
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.93.2.1 2017/06/13 16:20:47 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.93.4.10 2018/04/29 00:56:53 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,6 +1841,17 @@ 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'}).':'.
@@ -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;
@@ -3038,8 +3108,12 @@ sub can_edit_resource {
                 } else {
                     $cfile = $env{'form.suppurl'};
                     my $escfile = &unescape($cfile);
-                    $escfile =~ s{^http://}{};
-                    $cfile = &escape("/adm/wrapper/ext/$escfile");
+                    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'}) {
@@ -3195,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') {
@@ -3253,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);
@@ -3369,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'};
@@ -3404,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') {
@@ -3479,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';
@@ -3537,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; 
         }
@@ -4497,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);
@@ -6183,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,'.');
@@ -7116,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';
@@ -8116,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 {
@@ -8145,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'; }
@@ -8537,6 +8612,33 @@ sub auto_validate_class_sec {
     return $response;
 }
 
+sub auto_validate_instclasses {
+    my ($cdom,$cnum,$owners,$classesref) = @_;
+    my ($homeserver,%validations);
+    $homeserver = &homeserver($cnum,$cdom);
+    unless ($homeserver eq 'no_host') {
+        my $ownerlist;
+        if (ref($owners) eq 'ARRAY') {
+            $ownerlist = join(',',@{$owners});
+        } else {
+            $ownerlist = $owners;
+        }
+        if (ref($classesref) eq 'HASH') {
+            my $classes = &freeze_escape($classesref);
+            my $response=&reply('autovalidateinstclasses:'.&escape($ownerlist).
+                                ':'.$cdom.':'.$classes,$homeserver);
+            unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
+                my @items = split(/&/,$response);
+                foreach my $item (@items) {
+                    my ($key,$value) = split('=',$item);
+                    $validations{&unescape($key)} = &thaw_unescape($value);
+                }
+            }
+        }
+    }
+    return %validations;
+}
+
 sub auto_crsreq_update {
     my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,
         $code,$accessstart,$accessend,$inbound) = @_;
@@ -9770,7 +9872,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");
     }
@@ -9784,7 +9886,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");    
@@ -9794,7 +9896,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);
@@ -9816,7 +9918,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);
@@ -10504,6 +10606,35 @@ sub resdata {
     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;
@@ -10952,13 +11083,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;
     }
@@ -10979,9 +11111,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?
 #
@@ -11076,8 +11210,37 @@ 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'});
@@ -11086,12 +11249,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
-                           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 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 imported file
@@ -11205,20 +11371,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));
@@ -12306,7 +12500,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;
@@ -12419,7 +12613,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);
@@ -12490,6 +12684,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;
 }
@@ -12563,7 +12759,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;
@@ -12591,7 +12787,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;
@@ -12684,7 +12880,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);
 	}
@@ -12736,8 +12932,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)) {
@@ -12770,7 +12981,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);
@@ -13036,7 +13247,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);
@@ -13052,7 +13263,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);
@@ -13077,7 +13288,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);
@@ -13091,7 +13302,7 @@ BEGIN {
 }
 # ------------------------------------------------------------ Read permissions
 {
-    open(my $config,"<$perlvar{'lonTabDir'}/roles.tab");
+    open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab");
 
     while (my $configline=<$config>) {
 	chomp($configline);
@@ -13105,7 +13316,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);
@@ -13125,7 +13336,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; }
@@ -13171,7 +13382,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 =~ /^\#/);