--- loncom/lonnet/perl/lonnet.pm	2018/03/30 21:30:00	1.1371
+++ loncom/lonnet/perl/lonnet.pm	2018/07/04 16:58:29	1.1378
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1371 2018/03/30 21:30:00 raeburn Exp $
+# $Id: lonnet.pm,v 1.1378 2018/07/04 16:58:29 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -652,31 +652,39 @@ sub transfer_profile_to_env {
 sub check_for_valid_session {
     my ($r,$name,$userhashref,$domref) = @_;
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
-    my ($linkname,$pubname);
-    if ($name eq '') {
-        $name = 'lonID';
+    my ($lonidsdir,$linkname,$pubname,$secure,$lonid);
+    if ($name eq 'lonDAV') {
+        $lonidsdir=$r->dir_config('lonDAVsessDir');
+    } else {
+        $lonidsdir=$r->dir_config('lonIDsDir');
+        if ($name eq '') {
+            $name = 'lonID';
+        }
+    }
+    if ($name eq 'lonID') {
+        $secure = 'lonSID';
         $linkname = 'lonLinkID';
         $pubname = 'lonPubID';
-    }
-    my $lonid=$cookies{$name};
-    if (!$lonid) {
-        if (($name eq 'lonID') && ($ENV{'SERVER_PORT'} != 443) && ($linkname)) {
+        if (exists($cookies{$secure})) {
+            $lonid=$cookies{$secure};
+        } elsif (exists($cookies{$name})) {
+            $lonid=$cookies{$name};
+        } elsif (exists($cookies{$linkname})) {
             $lonid=$cookies{$linkname};
+        } elsif (exists($cookies{$pubname})) {
+            $lonid=$cookies{$pubname};
         }
-        if (!$lonid) {
-            if (($name eq 'lonID') && ($pubname)) {
-                $lonid=$cookies{$pubname};
-            }
-        }
+    } else {
+        $lonid=$cookies{$name};
     }
     return undef if (!$lonid);
 
     my $handle=&LONCAPA::clean_handle($lonid->value);
-    my $lonidsdir;
-    if ($name eq 'lonDAV') {
-        $lonidsdir=$r->dir_config('lonDAVsessDir');
-    } else {
-        $lonidsdir=$r->dir_config('lonIDsDir');
+    if (-l "$lonidsdir/$handle.id") {
+        my $link = readlink("$lonidsdir/$handle.id");
+        if ((-e $link) && ($link =~ m{^\Q$lonidsdir\E/(.+)\.id$})) {
+            $handle = $1;
+        }
     }
     if (!-e "$lonidsdir/$handle.id") {
         if ((ref($domref)) && ($name eq 'lonID') && 
@@ -708,6 +716,10 @@ sub check_for_valid_session {
         $userhashref->{'name'} = $disk_env{'user.name'};
         $userhashref->{'domain'} = $disk_env{'user.domain'};
         $userhashref->{'lti'} = $disk_env{'request.lti.login'};
+        if ($userhashref->{'lti'}) {
+            $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};
+            $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'};
+        }
     }
 
     return $handle;
@@ -758,16 +770,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';
@@ -9283,7 +9298,7 @@ sub assignrole {
             }
             if ($refused) {
                 my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
-                if (!$selfenroll && $context eq 'course') {
+                if (!$selfenroll && (($context eq 'course') || ($context eq 'ltienroll' && $env{'request.lti.login'}))) {
                     my %crsenv;
                     if ($role eq 'cc' || $role eq 'co') {
                         %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
@@ -9306,7 +9321,7 @@ sub assignrole {
                 } 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'})) {
+                    } elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {
                         $refused = '';
                     }
                 } elsif ($context eq 'requestcourses') {
@@ -11928,23 +11943,31 @@ sub metadata {
 # Check metadata for imported file to
 # see if it contained response items
 #
+                        my ($origfile,@libfilekeys);
                         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;
+                        @libfilekeys = split(/,/,&metadata($location,'keys',undef,undef,undef,
+                                                           $depthcount+1));
+                        if (grep(/^responseorder$/,@libfilekeys)) {
+                            my $libresponseorder = &metadata($location,'responseorder',undef,undef,
+                                                             undef,$depthcount+1);
+                            if ($libresponseorder ne '') {
+                                if ($#origfiletagids<0) {
+                                    undef(%importedrespids);
+                                    undef(%importedpartids);
+                                }
+                                my @respids = split(/\s*,\s*/,$libresponseorder);
+                                if (@respids) {
+                                    $importedrespids{$importid} = join(',',map { $importid.'_'.$_ } @respids);
+                                }
+                                if ($importedrespids{$importid} ne '') {
+                                    $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 ($#origfiletagids<0) {
+                                        my $origfilelocation=$perlvar{'lonDocRoot'}.&clutter($uri);
+                                        $origfile=&getfile($origfilelocation);
+                                        @origfiletagids=($origfile=~/<((?:\w+)response|import|part)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                                    }
                                 }
                             }
                         }
@@ -11952,10 +11975,7 @@ sub metadata {
 # 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'});
-                        } elsif ($importmode eq 'part') {
+                        if ($importmode eq 'part') {
 # Import as part(s)
                            $importedparts=1;
 # We need to get the original file and the imported file to get the part order correct
@@ -11970,10 +11990,23 @@ sub metadata {
                                    @origfiletagids=($origfile=~/<(part|import)[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
                                }
                            }
-
-# Load and inspect imported file
-                           my $impfile=&getfile($location);
-                           my @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                           my @impfilepartids;
+# If <partorder> tag is included in metadata for the imported file
+# get the parts in the imported file from that.
+                           if (grep(/^partorder$/,@libfilekeys)) {
+                               %currmetaentry = %metaentry;
+                               my $libpartorder = &metadata($location,'partorder',undef,undef,undef,
+                                                            $depthcount+1);
+                               %metaentry = %currmetaentry;
+                               undef(%currmetaentry);
+                               if ($libpartorder ne '') {
+                                   @impfilepartids=split(/\s*,\s*/,$libpartorder);
+                               }
+                           } else {
+# If no <partorder> tag available, load and inspect imported file
+                               my $impfile=&getfile($location);
+                               @impfilepartids=($impfile=~/<part[^>]*id\s*=\s*[\"\']([^\"\']+)[\"\'][^>]*>/gs);
+                           }
                            if ($#impfilepartids>=0) {
 # This problem had parts
                                $importedpartids{$token->[2]->{'id'}}=join(',',@impfilepartids);
@@ -11984,13 +12017,28 @@ sub metadata {
                                $importedpartids{$token->[2]->{'id'}}=$token->[2]->{'id'};
                            }
                         } else {
+# Import as problem or as normal import
+                            $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+                            unless ($importmode eq 'problem') {
 # Normal import
-                           $unikey=&add_prefix_and_part($prefix,$token->[2]->{'part'});
-                           if (defined($token->[2]->{'id'})) {
-                              $unikey.='_'.$token->[2]->{'id'};
-                           }
+                                if (defined($token->[2]->{'id'})) {
+                                    $unikey.='_'.$token->[2]->{'id'};
+                                }
+                            }
+# Check metadata for imported file to
+# see if it contained parts
+                            if (grep(/^partorder$/,@libfilekeys)) {
+                                %currmetaentry = %metaentry;
+                                my $libpartorder = &metadata($location,'partorder',undef,undef,undef,
+                                                             $depthcount+1);
+                                %metaentry = %currmetaentry;
+                                undef(%currmetaentry);
+                                if ($libpartorder ne '') {
+                                    $importedparts = 1;
+                                    $importedpartids{$token->[2]->{'id'}}=$libpartorder;
+                                }
+                            }
                         }
-
 			if ($depthcount<20) {
 			    my $metadata = 
 				&metadata($uri,'keys',$toolsymb,$location,$unikey,
@@ -12102,12 +12150,14 @@ sub metadata {
                 } elsif ($origfiletagids[$index] eq 'import') {
                     if ($importedparts) {
 # We have imported parts at this position
-                        $metaentry{':partorder'}.=','.$importedpartids{$origid};
+                        if ($importedpartids{$origid} ne '') {
+                            $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}});
+                        if ($importedrespids{$origid} ne '') {
+                            $metaentry{':responseorder'}.=','.$importedrespids{$origid};
                         }
                     }
                 } else {
@@ -12124,7 +12174,6 @@ sub metadata {
                 $metaentry{':responseorder'}=~s/^\,//;
             }
         }
-
 	$metaentry{':keys'} = join(',',keys(%metathesekeys));
 	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
 	$metaentry{':allpossiblekeys'}=join(',',keys(%metathesekeys));