--- loncom/lonnet/perl/lonnet.pm	2006/01/11 08:25:06	1.683.2.9
+++ loncom/lonnet/perl/lonnet.pm	2005/12/09 00:08:51	1.685
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.683.2.9 2006/01/11 08:25:06 albertel Exp $
+# $Id: lonnet.pm,v 1.685 2005/12/09 00:08:51 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -271,7 +271,7 @@ sub transfer_profile_to_env {
     my %Remove;
     for ($envi=0;$envi<=$#profile;$envi++) {
 	chomp($profile[$envi]);
-	my ($envname,$envvalue)=split(/=/,$profile[$envi],2);
+	my ($envname,$envvalue)=split(/=/,$profile[$envi]);
 	$env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
@@ -323,7 +323,7 @@ sub appenv {
     for (my $i=0; $i<=$#oldenv; $i++) {
         chomp($oldenv[$i]);
         if ($oldenv[$i] ne '') {
-	    my ($name,$value)=split(/=/,$oldenv[$i],2);
+	    my ($name,$value)=split(/=/,$oldenv[$i]);
 	    unless (defined($newenv{$name})) {
 		$newenv{$name}=$value;
 	    }
@@ -382,7 +382,7 @@ sub delenv {
 	}
 	foreach (@oldenv) {
 	    if ($_=~/^$delthis/) { 
-                my ($key,undef) = split('=',$_,2);
+                my ($key,undef) = split('=',$_);
                 delete($env{$key});
             } else {
                 print $fh $_; 
@@ -3010,9 +3010,8 @@ sub tmpput {
 
 # ------------------------------------------------------------ tmpget interface
 sub tmpget {
-    my ($token,$server)=@_;
-    if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
-    my $rep=&reply("tmpget:$token",$server);
+    my ($token)=@_;
+    my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'});
     my %returnhash;
     foreach my $item (split(/\&/,$rep)) {
 	my ($key,$value)=split(/=/,$item);
@@ -3021,13 +3020,6 @@ sub tmpget {
     return %returnhash;
 }
 
-# ------------------------------------------------------------ tmpget interface
-sub tmpdel {
-    my ($token,$server)=@_;
-    if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
-    return &reply("tmpdel:$token",$server);
-}
-
 # ---------------------------------------------- Custom access rule evaluation
 
 sub customaccess {
@@ -3346,21 +3338,17 @@ sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/\Q$rolecode\E/) {
-	   if ($priv ne 'pch') { 
-	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
-			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
-			$env{'request.course.id'});
-	   }
+           &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
+                'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
+                $env{'request.course.id'});
            return '';
        }
 
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
 	   =~/\Q$unamedom\E/) {
-	   if ($priv ne 'pch') { 
-	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
-			'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
-			$env{'request.course.id'});
-	   }
+           &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
+                'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
+                $env{'request.course.id'});
            return '';
        }
    }
@@ -3370,11 +3358,9 @@ sub allowed {
    if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$env{'request.role'}))[0];
        if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
-	   if ($priv ne 'pch') { 
-	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
-			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
-	   }
-	   return '';
+	   &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
+		'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
+          return '';
        }
    }
 
@@ -3405,8 +3391,7 @@ sub is_on_map {
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
     $pathname=~s|/\Q$filename\E$||;
-    $pathname=~s/^adm\/wrapper\///;
-    $pathname=~s/^adm\/coursedocs\/showdoc\///;
+    $pathname=~s/^adm\/wrapper\///;    
     #Trying to find the conditional for the file
     my $match=($env{'acc.res.'.$env{'request.course.id'}.'.'.$pathname}=~
 	       /\&\Q$filename\E\:([\d\|]+)\&/);
@@ -3730,6 +3715,10 @@ sub modify_group_roles {
     my $role = 'gr/'.&escape($userprivs);
     my ($uname,$udom) = split(/:/,$user);
     my $result = &assignrole($udom,$uname,$url,$role,$end,$start);
+    if ($result eq 'ok') {
+        &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
+    }
+
     return $result;
 }
 
@@ -4813,7 +4802,8 @@ sub EXT {
         return $env{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {
 
-	my $section;
+	my ($section,$group);
+        my @groups = ();
 	if (defined($courseid) && $courseid eq $env{'request.course.id'}) {
 	    if (!$symbparm) { $symbparm=&symbread(); }
 	}
@@ -4833,14 +4823,29 @@ sub EXT {
 	    if (($env{'user.name'} eq $uname) &&
 		($env{'user.domain'} eq $udom)) {
 		$section=$env{'request.course.sec'};
+                @groups=split(/:/,$env{'request.course.groups'});
+                if (@groups > 0) {
+                    @groups = sort(@groups);
+                    $group = $groups[0];
+                }
 	    } else {
 		if (! defined($usection)) {
 		    $section=&getsection($udom,$uname,$courseid);
 		} else {
 		    $section = $usection;
 		}
+                my $grouplist = &get_users_groups($udom,$uname,$courseid);
+                if ($grouplist) {
+                    @groups = split(/:/,$grouplist);
+                    @groups = sort(@groups);
+                    $group = $groups[0];
+                }
 	    }
 
+            my $grplevel=$courseid.'.['.$group.'].'.$spacequalifierrest;
+            my $grplevelr=$courseid.'.['.$group.'].'.$symbparm;
+            my $grplevelm=$courseid.'.['.$group.'].'.$mapparm;
+
 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
 	    my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
 	    my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
@@ -4858,8 +4863,17 @@ sub EXT {
 	    if (defined($userreply)) { return $userreply; }
 
 # ------------------------------------------------ second, check some of course
+            my $coursereply;
+            if (defined($group)) {
+                $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                                     $env{'course.'.$courseid.'.domain'},
+                                     'course',
+                                     ($grplevelr,$grplevelm,$grplevel,
+                                      $courselevelr));
+                if (defined($coursereply)) { return $coursereply; }
+            }
 
-	    my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
+	    $coursereply=&resdata($env{'course.'.$courseid.'.num'},
 				     $env{'course.'.$courseid.'.domain'},
 				     'course',
 				     ($seclevelr,$seclevelm,$seclevel,
@@ -4930,11 +4944,6 @@ sub EXT {
 	if ($space eq 'time') {
 	    return time;
         }
-    } elsif ($realm eq 'server') {
-# ----------------------------------------------------------------- system.time
-	if ($space eq 'name') {
-	    return $ENV{'SERVER_NAME'};
-        }
     }
     return '';
 }
@@ -4981,8 +4990,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)
-	  && ($uri !~ m|^adm/coursedocs/|) && ($uri !~ m|^adm/wrapper/|)) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
 	($uri =~ m|home/[^/]+/public_html/|)) {
 	return undef;
@@ -5300,7 +5308,6 @@ sub symbverify {
     my $thisfn=$thisurl;
 # wrapper not part of symbs
     $thisfn=~s/^\/adm\/wrapper//;
-    $thisfn=~s/^\/adm\/coursedocs\/showdoc\///;
     $thisfn=&declutter($thisfn);
 # direct jump to resource in page or to a sequence - will construct own symbs
     if ($thisfn=~/\.(page|sequence)$/) { return 1; }
@@ -5355,7 +5362,6 @@ sub symbclean {
 # remove wrapper
 
     $symb=~s/(\_\_\_\d+\_\_\_)adm\/wrapper\/(res\/)*/$1/;
-    $symb=~s/(\_\_\_\d+\_\_\_)adm\/coursedocs\/showdoc\/(res\/)*/$1/;
     return $symb;
 }
 
@@ -5432,9 +5438,6 @@ sub symbread {
         if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
             $targetfn = 'adm/wrapper/'.$thisfn;
         }
-	if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
-	    $targetfn=$1;
-	}
         if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                       &GDBM_READER(),0640)) {
 	    $syval=$hash{$targetfn};
@@ -6088,8 +6091,6 @@ sub declutter {
     if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
     $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
     $thisfn=~s/^\///;
-    $thisfn=~s|^adm/wrapper/||;
-    $thisfn=~s|^adm/coursedocs/showdoc/||;
     $thisfn=~s/^res\///;
     $thisfn=~s/\?.+$//;
     return $thisfn;
@@ -6102,23 +6103,6 @@ sub clutter {
     unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { 
        $thisfn='/res'.$thisfn; 
     }
-    if ($thisfn !~m|/adm|) {
-	if ($thisfn =~ m|/ext/|) {
-	    $thisfn='/adm/wrapper'.$thisfn;
-	} else {
-	    my ($ext) = ($thisfn =~ /\.(\w+)$/);
-	    my $embstyle=&Apache::loncommon::fileembstyle($ext);
-	    if (($embstyle eq 'img') 
-		|| ($embstyle eq 'emb')
-		|| ($embstyle eq 'wrp')) {
-		$thisfn='/adm/wrapper'.$thisfn;
-	    } elsif ($embstyle eq 'ssi') {
-		#do nothing with these
-	    } elsif ($thisfn!~/\.(sequence|page)$/) {
-		$thisfn='/adm/coursedocs/showdoc'.$thisfn;
-	    }
-	}
-    }
     return $thisfn;
 }
 
@@ -6262,7 +6246,7 @@ BEGIN {
     }
     close($config);
     # FIXME: dev server don't want this, production servers _do_ want this
-    &get_iphost();
+    #&get_iphost();
 }
 
 sub get_iphost {