--- loncom/lonnet/perl/lonnet.pm	2017/12/18 23:14:03	1.1362
+++ loncom/lonnet/perl/lonnet.pm	2018/03/30 18:07:47	1.1370
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1362 2017/12/18 23:14:03 raeburn Exp $
+# $Id: lonnet.pm,v 1.1370 2018/03/30 18:07:47 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -5229,6 +5229,9 @@ sub set_first_access {
                         'course.'.$courseid.'.timerinterval.'.$res => $interval,
                      }
                   );
+            if (($cachedtime) && (abs($start-$cachedtime) < 5)) {
+                $cachedtimes{"$courseid\0$res"} = $start;
+            }
         }
         return $putres;
     }
@@ -7143,6 +7146,7 @@ sub usertools_access {
                       community  => 1,
                       textbook   => 1,
                       placement  => 1,
+                      lti        => 1,
                  );
     } elsif ($context eq 'requestauthor') {
         %tools = (
@@ -7339,25 +7343,29 @@ sub is_advanced_user {
 }
 
 sub check_can_request {
-    my ($dom,$can_request,$request_domains) = @_;
+    my ($dom,$can_request,$request_domains,$uname,$udom) = @_;
     my $canreq = 0;
+    if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
+        $uname = $env{'user.name'};
+        $udom = $env{'user.domain'};
+    }
     my ($types,$typename) = &Apache::loncommon::course_types();
     my @options = ('approval','validate','autolimit');
     my $optregex = join('|',@options);
     if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
         foreach my $type (@{$types}) {
-            if (&usertools_access($env{'user.name'},
-                                  $env{'user.domain'},
-                                  $type,undef,'requestcourses')) {
+            if (&usertools_access($uname,$udom,$type,undef,
+                                  'requestcourses')) {
                 $canreq ++;
                 if (ref($request_domains) eq 'HASH') {
-                    push(@{$request_domains->{$type}},$env{'user.domain'});
+                    push(@{$request_domains->{$type}},$udom);
                 }
-                if ($dom eq $env{'user.domain'}) {
+                if ($dom eq $udom) {
                     $can_request->{$type} = 1;
                 }
             }
-            if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
+            if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
+                ($env{'environment.reqcrsotherdom.'.$type} ne '')) {
                 my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});
                 if (@curr > 0) {
                     foreach my $item (@curr) {
@@ -7374,7 +7382,7 @@ sub check_can_request {
                             }
                         }
                     }
-                    unless($dom eq $env{'user.domain'}) {
+                    unless ($dom eq $env{'user.domain'}) {
                         $canreq ++;
                         if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {
                             $can_request->{$type} = 1;
@@ -8889,6 +8897,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) = @_;
@@ -9268,8 +9303,12 @@ sub assignrole {
                             }
                         }
                     }
-                } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
-                    $refused = '';
+                } elsif (($selfenroll == 1) && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
+                    if ($role eq 'st') {
+                        $refused = '';
+                    } elsif (($context eq 'ltienroll') && ($env{'request.lti'})) {
+                        $refused = '';
+                    }
                 } elsif ($context eq 'requestcourses') {
                     my @possroles = ('st','ta','ep','in','cc','co');
                     if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
@@ -9535,10 +9574,14 @@ sub modifyuser {
     my $newuser;
     if ($uhome eq 'no_host') {
         $newuser = 1;
+        unless (($umode && ($upass ne '')) || ($umode eq 'localauth') ||
+                ($umode eq 'lti')) {
+            return 'error: more information needed to create new user';
+        }
     }
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && 
-	(($umode && $upass) || ($umode eq 'localauth'))) {
+	(($umode && $upass) || ($umode eq 'localauth') || ($umode eq 'lti'))) {
         my $unhome='';
         if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { 
             $unhome = $desiredhome;
@@ -11201,10 +11244,11 @@ sub get_numsuppfiles {
     unless (defined($cached)) {
         my $chome=&homeserver($cnum,$cdom);
         unless ($chome eq 'no_host') {
-            ($suppcount,my $errors) = (0,0);
+            ($suppcount,my $supptools,my $errors) = (0,0,0);
             my $suppmap = 'supplemental.sequence';
-            ($suppcount,$errors) = 
-                &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
+            ($suppcount,$supptools,$errors) =
+                &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,
+                                                         $supptools,$errors);
         }
         &do_cache_new('suppcount',$hashid,$suppcount,600);
     }
@@ -11691,6 +11735,7 @@ sub add_prefix_and_part {
 
 my %metaentry;
 my %importedpartids;
+my %importedrespids;
 sub metadata {
     my ($uri,$what,$toolsymb,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);
@@ -11729,7 +11774,15 @@ sub metadata {
 # uploaded map containing the tool. The value is retrieved via
 # &EXT(), if a valid symb is available.  Otherwise the value of
 # gradable in the exttool_$marker.db file for the tool instance
-# is retrived via &get().
+# is retrieved via &get().
+#
+# When lonuserstate::traceroute() calls lonnet::EXT() for 
+# hiddenresource and encrypturl (during course initialization)
+# the map-level parameter for resource.0.gradable included in the 
+# uploaded map containing the tool will not yet have been stored
+# in the user_course_parms.db file for the user's session, so in 
+# this case fall back to retrieving gradable status from the
+# exttool_$marker.db file.
 #
 # In order to avoid an infinite loop, &metadata() will return
 # before a call to &EXT(), if the uri is for an external tool
@@ -11744,7 +11797,7 @@ sub metadata {
             my ($checked,$use_passback);
             if ($toolsymb ne '') {
                 (undef,undef,my $tooluri) = &decode_symb($toolsymb);
-                if ($tooluri eq $uri) {
+                if (($tooluri eq $uri) && (&EXT('resource.0.gradable',$toolsymb))) {
                     $checked = 1;
                     if (&EXT('resource.0.gradable',$toolsymb) =~ /^yes$/i) {
                         $use_passback = 1;
@@ -11754,7 +11807,7 @@ sub metadata {
             unless ($checked) {
                 my ($ignore,$cdom,$cnum,$marker) = split(m{/},$uri);
                 $marker=~s/\D//g;
-                if (!$marker) {
+                if ($marker) {
                     my %toolsettings=&get('exttool_'.$marker,['gradable'],$cdom,$cnum);
                     $use_passback = $toolsettings{'gradable'};
                 }
@@ -11769,9 +11822,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?
 #
@@ -11866,8 +11921,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'});
@@ -11876,12 +11960,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
@@ -11912,7 +11999,6 @@ sub metadata {
 				$metaentry{':'.$meta}=$metaentry{':'.$meta};
 				$metathesekeys{$meta}=1;
 			    }
-			
                         }
 		    } else {
 #
@@ -11995,20 +12081,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 rebuil 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));