--- loncom/lonnet/perl/lonnet.pm	2007/11/20 00:26:38	1.927
+++ loncom/lonnet/perl/lonnet.pm	2008/02/21 10:04:35	1.942
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.927 2007/11/20 00:26:38 albertel Exp $
+# $Id: lonnet.pm,v 1.942 2008/02/21 10:04:35 foxr Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1635,7 +1635,7 @@ sub ssi_body {
                                      &ssi($filelink,%form));
     $output=~s|//(\s*<!--)? BEGIN LON-CAPA Internal.+?// END LON-CAPA Internal\s*(-->)?\s||gs;
     $output=~s/^.*?\<body[^\>]*\>//si;
-    $output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
+    $output=~s/\<\/body\s*\>.*?$//si;
     return $output;
 }
 
@@ -1650,9 +1650,21 @@ sub absolute_url {
     return $protocol.$host_name;
 }
 
+#
+#   Server side include.
+# Parameters:
+#  fn     Possibly encrypted resource name/id.
+#  form   Hash that describes how the rendering should be done
+#         and other things.
+#  r      Optional reference that will be given the response.
+#         This is mostly provided so that the caller can implement
+#         error detection, recovery and retry policies.
+#     
+# Returns:
+#    The content of the response.
 sub ssi {
 
-    my ($fn,%form)=@_;
+    my ($fn,%form, $r)=@_;
 
     my $ua=new LWP::UserAgent;
     
@@ -1670,6 +1682,10 @@ sub ssi {
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response=$ua->request($request);
 
+    if ($r) {
+	$$r = $response;
+    }
+
     return $response->content;
 }
 
@@ -2200,10 +2216,10 @@ sub flushcourselogs {
             }
         }
         $courseidbuffer{$coursehombuf{$crsid}}{$crsid} = {
-            'description' => &escape($coursedescrbuf{$crsid}),
-            'inst_code'    => &escape($courseinstcodebuf{$crsid}),
-            'type'        => &escape($coursetypebuf{$crsid}),
-            'owner'       => &escape($courseownerbuf{$crsid}),
+            'description' => $coursedescrbuf{$crsid},
+            'inst_code'    => $courseinstcodebuf{$crsid},
+            'type'        => $coursetypebuf{$crsid},
+            'owner'       => $courseownerbuf{$crsid},
         };
     }
 #
@@ -2399,7 +2415,11 @@ sub get_course_adv_roles {
     my %coursehash=&coursedescription($cid);
     my %nothide=();
     foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
-	$nothide{join(':',split(/[\@\:]/,$user))}=1;
+        if ($user !~ /:/) {
+	    $nothide{join(':',split(/[\@]/,$user))}=1;
+        } else {
+            $nothide{$user}=1;
+        }
     }
     my %returnhash=();
     my %dumphash=
@@ -2427,15 +2447,25 @@ sub get_course_adv_roles {
 }
 
 sub get_my_roles {
-    my ($uname,$udom,$context,$types,$roles,$roledoms)=@_;
+    my ($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv)=@_;
     unless (defined($uname)) { $uname=$env{'user.name'}; }
     unless (defined($udom)) { $udom=$env{'user.domain'}; }
-    my %dumphash;
+    my (%dumphash,%nothide);
     if ($context eq 'userroles') { 
         %dumphash = &dump('roles',$udom,$uname);
     } else {
         %dumphash=
             &dump('nohist_userroles',$udom,$uname);
+        if ($hidepriv) {
+            my %coursehash=&coursedescription($udom.'_'.$uname);
+            foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
+                if ($user !~ /:/) {
+                    $nothide{join(':',split(/[\@]/,$user))} = 1;
+                } else {
+                    $nothide{$user} = 1;
+                }
+            }
+        }
     }
     my %returnhash=();
     my $now=time;
@@ -2448,7 +2478,7 @@ sub get_my_roles {
         }
         if (($tstart) && ($tstart<0)) { next; }
         my $status = 'active';
-        if (($tend) && ($tend<$now)) {
+        if (($tend) && ($tend<=$now)) {
             $status = 'previous';
         } 
         if (($tstart) && ($now<$tstart)) {
@@ -2486,7 +2516,18 @@ sub get_my_roles {
                 }
             }
         }
-	$returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
+        if ($hidepriv) {
+            if ((&privileged($username,$domain)) &&
+                (!$nothide{$username.':'.$domain})) { 
+                next;
+            }
+        }
+        if ($withsec) {
+            $returnhash{$username.':'.$domain.':'.$role.':'.$section} =
+                $tstart.':'.$tend;
+        } else {
+            $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend;
+        }
     }
     return %returnhash;
 }
@@ -2550,7 +2591,7 @@ sub courseidput {
         foreach my $cid (keys(%$storehash)) {
             $what .= &escape($cid).'=';
             foreach my $item ('description','inst_code','owner','type') {
-                $what .= &escape($storehash->{$item}).':';
+                $what .= &escape($storehash->{$cid}{$item}).':';
             }
             $what =~ s/\:$/&/;
         }
@@ -2685,7 +2726,9 @@ sub set_first_access {
     my ($type)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();
     my ($map,$id,$res)=&decode_symb($symb);
-    if ($type eq 'map') {
+    if ($type eq 'course') {
+	$res='course';
+    } elsif ($type eq 'map') {
 	$res=&symbread($map);
     } else {
 	$res=$symb;
@@ -3500,7 +3543,7 @@ sub set_userprivs {
     }
     foreach my $role (keys(%{$allroles})) {
         my %thesepriv;
-        if (($role=~/^au/) || ($role=~/^ca/)) { $author=1; }
+        if (($role=~/^au/) || ($role=~/^ca/) || ($role=~/^aa/)) { $author=1; }
         foreach my $item (split(/:/,$$allroles{$role})) {
             if ($item ne '') {
                 my ($privilege,$restrictions)=split(/&/,$item);
@@ -4841,8 +4884,15 @@ sub auto_run {
             $response = 1;
         }
     } else {
-        my $homeserver = &homeserver($cnum,$cdom);
-        $response = &reply('autorun:'.$cdom,$homeserver);
+        my $homeserver;
+        if (&is_course($cdom,$cnum)) {
+            $homeserver = &homeserver($cnum,$cdom);
+        } else {
+            $homeserver = &domain($cdom,'primary');
+        }
+        if ($homeserver ne 'no_host') {
+            $response = &reply('autorun:'.$cdom,$homeserver);
+        }
     }
     return $response;
 }
@@ -5248,11 +5298,21 @@ sub assignrole {
     } else {
         my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
-        unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) { 
-           &logthis('Refused assignrole: '.
-             $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
-		    $env{'user.name'}.' at '.$env{'user.domain'});
-           return 'refused'; 
+        if (!(&allowed('c'.$role,$cwosec)) && !(&allowed('c'.$role,$udom))) {
+            my $refused;
+            if (($env{'request.course.sec'}  ne '') && ($role eq 'st')) {
+                if (!(&allowed('c'.$role,$url))) {
+                    $refused = 1;
+                }
+            } else {
+                $refused = 1;
+            }
+            if ($refused) { 
+                &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
+                         ' '.$role.' '.$end.' '.$start.' by '.
+	  	         $env{'user.name'}.' at '.$env{'user.domain'});
+                return 'refused';
+            }
         }
         $mrole=$role;
     }
@@ -6610,7 +6670,7 @@ sub EXT {
 				       ([$courselevelr,'resource'],
 					[$courselevelm,'map'     ],
 					[$courselevel, 'course'  ]));
-	    if (defined($userreply)) { return $userreply; }
+	    if (defined($userreply)) { return &get_reply($userreply); }
 
 # ------------------------------------------------ second, check some of course
             my $coursereply;
@@ -6673,7 +6733,7 @@ sub EXT {
 	    if ($part eq '') { $part='0'; }
 	    my @partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
 				 $symbparm,$udom,$uname,$section,1);
-	    if (@partgeneral) { return &get_reply(\@partgeneral); }
+	    if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }
 	}
 	if ($recurse) { return undef; }
 	my $pack_def=&packages_tab_default($filename,$varname);
@@ -6707,10 +6767,14 @@ sub EXT {
 
 sub get_reply {
     my ($reply_value) = @_;
-    if (wantarray) {
-	return @$reply_value;
+    if (ref($reply_value) eq 'ARRAY') {
+        if (wantarray) {
+	    return @$reply_value;
+        }
+        return $reply_value->[0];
+    } else {
+        return $reply_value;
     }
-    return $reply_value->[0];
 }
 
 sub check_group_parms {
@@ -6851,8 +6915,9 @@ sub metadata {
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring;
 	if ($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) {
+	    my $which = &hreflocation('','/'.($liburi || $uri));
 	    $metastring = 
-		&Apache::lonnet::ssi_body(&hreflocation('','/'.$uri),
+		&Apache::lonnet::ssi_body($which,
 					  ('grade_target' => 'meta'));
 	    $cachetime = 1; # only want this cached in the child not long term
 	} elsif ($uri !~ m -^(editupload)/-) {
@@ -7970,7 +8035,13 @@ sub filelocation {
         }
     }
     $location=~s://+:/:g; # remove duplicate /
-    while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
+    while ($location=~m{/\.\./}) {
+	if ($location =~ m{/[^/]+/\.\./}) {
+	    $location=~ s{/[^/]+/\.\./}{/}g;
+	} else {
+	    $location=~ s{/\.\./}{/}g;
+	}
+    } #remove dir/..
     while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
     return $location;
 }
@@ -8836,14 +8907,15 @@ explanation of a user role term
 
 =item *
 
-get_my_roles($uname,$udom,$context,$types,$roles,$roledoms) :
+get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :
 All arguments are optional. Returns a hash of a roles, either for
 co-author/assistant author roles for a user's Construction Space
 (default), or if $context is 'userroles', roles for the user himself,
-In the hash, keys are set to colon-sparated $uname,$udom,and $role,
-and value is set to colon-separated start and end times for the role.
-If no username and domain are specified, will default to current
-user/domain. Types, roles, and roledoms are references to arrays,
+In the hash, keys are set to colon-separated $uname,$udom,$role, and
+(optionally) if $withsec is true, a fourth colon-separated item - $section.
+For each key, value is set to colon-separated start and end times for
+the role.  If no username and domain are specified, will default to
+current user/domain. Types, roles, and roledoms are references to arrays
 of role statuses (active, future or previous), roles 
 (e.g., cc,in, st etc.) and domains of the roles which can be used
 to restrict the list of roles reported. If no array ref is