--- loncom/lonnet/perl/lonnet.pm	2005/11/01 15:07:29	1.674
+++ loncom/lonnet/perl/lonnet.pm	2006/01/10 16:08:10	1.693
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.674 2005/11/01 15:07:29 www Exp $
+# $Id: lonnet.pm,v 1.693 2006/01/10 16:08:10 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -40,8 +40,8 @@ qw(%perlvar %hostname %badServerCache %i
    %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount 
    %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
    %domaindescription %domain_auth_def %domain_auth_arg_def 
-   %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
-   %env);
+   %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary
+   $tmpdir $_64bit %env);
 
 use IO::Socket;
 use GDBM_File;
@@ -49,10 +49,11 @@ use Apache::Constants qw(:common :http);
 use HTML::LCParser;
 use HTML::Parser;
 use Fcntl qw(:flock);
-use Apache::lonlocal;
 use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
 use Time::HiRes qw( gettimeofday tv_interval );
 use Cache::Memcached;
+use Digest::MD5;
+
 my $readit;
 my $max_connection_retries = 10;     # Or some such value.
 
@@ -270,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]);
+	my ($envname,$envvalue)=split(/=/,$profile[$envi],2);
 	$env{$envname} = $envvalue;
         if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) {
             if ($time < time-300) {
@@ -288,14 +289,14 @@ sub transfer_profile_to_env {
 
 sub appenv {
     my %newenv=@_;
-    foreach (keys %newenv) {
-	if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
+    foreach my $key (keys(%newenv)) {
+	if (($newenv{$key}=~/^user\.role/) || ($newenv{$key}=~/^user\.priv/)) {
             &logthis("<font color=\"blue\">WARNING: ".
-                "Attempt to modify environment ".$_." to ".$newenv{$_}
+                "Attempt to modify environment ".$key." to ".$newenv{$key}
                 .'</font>');
-	    delete($newenv{$_});
+	    delete($newenv{$key});
         } else {
-            $env{$_}=$newenv{$_};
+            $env{$key}=$newenv{$key};
         }
     }
 
@@ -322,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]);
+	    my ($name,$value)=split(/=/,$oldenv[$i],2);
 	    unless (defined($newenv{$name})) {
 		$newenv{$name}=$value;
 	    }
@@ -379,12 +380,12 @@ sub delenv {
 	    close($fh);
 	    return 'error: '.$!;
 	}
-	foreach (@oldenv) {
-	    if ($_=~/^$delthis/) { 
-                my ($key,undef) = split('=',$_);
+	foreach my $cur_key (@oldenv) {
+	    if ($cur_key=~/^$delthis/) { 
+                my ($key,undef) = split('=',$cur_key,2);
                 delete($env{$key});
             } else {
-                print $fh $_; 
+                print $fh $cur_key; 
             }
 	}
 	close($fh);
@@ -1279,8 +1280,15 @@ sub clean_filename {
 }
 
 # --------------- Take an uploaded file and put it into the userfiles directory
-# input: name of form element, coursedoc=1 means this is for the course
-# output: url of file in userspace
+# input: $formname - the contents of the file are in $env{"form.$formname"}
+#                    the desired filenam is in $env{"form.$formname"}
+#        $coursedoc - if true up to the current course
+#                     if false
+#        $subdir - directory in userfile to store the file into
+#        $parser, $allfiles, $codebase - unknown
+#
+# output: url of file in userspace, or error: <message> 
+#             or /adm/notfound.html if failure to upload occurse
 
 
 sub userfileupload {
@@ -1852,28 +1860,25 @@ sub courseiddump {
 # ---------------------------------------------------------- DC e-mail
 
 sub dcmailput {
-    my ($domain,$msgid,$contents,$server)=@_;
+    my ($domain,$msgid,$message,$server)=@_;
     my $status = &Apache::lonnet::critical(
        'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
-       &Apache::lonnet::escape($$contents{$server}),$server);
+       &Apache::lonnet::escape($message),$server);
     return $status;
 }
 
 sub dcmaildump {
     my ($dom,$startdate,$enddate,$senders) = @_;
-    my %returnhash=(); 
-    foreach my $tryserver (keys(%libserv)) {
-        if ($hostdom{$tryserver} eq $dom) {
-            %{$returnhash{$tryserver}}=();
-	    my $cmd='dcmaildump:'.$dom.':'.
-		&escape($startdate).':'.&escape($enddate).':';
-	    my @esc_senders=map { &escape($_)} @$senders;
-	    $cmd.=&escape(join('&',@esc_senders));
-	    foreach (split(/\&/,&reply($cmd,$tryserver))) {
-                my ($key,$value) = split(/\=/,$_);
-                if (($key) && ($value)) {
-                    $returnhash{$tryserver}{&unescape($key)} = &unescape($value);
-                }
+    my %returnhash=();
+    if (exists($domain_primary{$dom})) {
+        my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.
+                                                         &escape($enddate).':';
+	my @esc_senders=map { &escape($_)} @$senders;
+	$cmd.=&escape(join('&',@esc_senders));
+	foreach (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
+            my ($key,$value) = split(/\=/,$_);
+            if (($key) && ($value)) {
+                $returnhash{&unescape($key)} = &unescape($value);
             }
         }
     }
@@ -2574,15 +2579,17 @@ sub rolesinit {
     my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
     if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
     my %allroles=();
+    my %allgroups=();   
     my $now=time;
     my $userroles="user.login.time=$now\n";
+    my $group_privs;
 
     if ($rolesdump ne '') {
         foreach (split(/&/,$rolesdump)) {
 	  if ($_!~/^rolesdef_/) {
             my ($area,$role)=split(/=/,$_);
 	    $area=~s/\_\w\w$//;
-            my ($trole,$tend,$tstart);
+            my ($trole,$tend,$tstart,$group_privs);
 	    if ($role=~/^cr/) { 
 		if ($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|) {
 		    ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|);
@@ -2590,6 +2597,10 @@ sub rolesinit {
 		} else {
 		    $trole=$role;
 		}
+            } elsif ($role =~ m|^gr/|) {
+                ($trole,$tend,$tstart) = split(/_/,$role);
+                ($trole,$group_privs) = split(/\//,$trole);
+                $group_privs = &unescape($group_privs);
 	    } else {
 		($trole,$tend,$tstart)=split(/_/,$role);
 	    }
@@ -2601,13 +2612,15 @@ sub rolesinit {
 		my ($tdummy,$tdomain,$trest)=split(/\//,$area);
 		if ($trole =~ /^cr\//) {
                     &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+                } elsif ($trole eq 'gr') {
+                    &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
 		} else {
                     &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
 		}
             }
           }
         }
-        my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
+        my ($author,$adv) = &set_userprivs(\$userroles,\%allroles,\%allgroups);
         $userroles.='user.adv='.$adv."\n".
 	            'user.author='.$author."\n";
         $env{'user.adv'}=$adv;
@@ -2649,6 +2662,17 @@ sub custom_roleprivs {
     }
 }
 
+sub group_roleprivs {
+    my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;
+    my $access = 1;
+    my $now = time;
+    if (($tend!=0) && ($tend<$now)) { $access = 0; }
+    if (($tstart!=0) && ($tstart>$now)) { $access=0; }
+    if ($access) {
+        my ($course,$group) = ($area =~ m|(/\w+/\w+)/([^/]+)$|);
+        $$allgroups{$course}{$group} .=':'.$group_privs;
+    }
+}
 
 sub standard_roleprivs {
     my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
@@ -2669,9 +2693,31 @@ sub standard_roleprivs {
 }
 
 sub set_userprivs {
-    my ($userroles,$allroles) = @_; 
+    my ($userroles,$allroles,$allgroups) = @_; 
     my $author=0;
     my $adv=0;
+    my %grouproles = ();
+    if (keys(%{$allgroups}) > 0) {
+        foreach my $role (keys %{$allroles}) {
+            my ($trole,$area,$sec,$extendedarea);
+            if ($role =~ m|^(\w+)\.(/\w+/\w+)(/?\w*)|) {
+                $trole = $1;
+                $area = $2;
+                $sec = $3;
+                $extendedarea = $area.$sec;
+                if (exists($$allgroups{$area})) {
+                    foreach my $group (keys(%{$$allgroups{$area}})) {
+                        my $spec = $trole.'.'.$extendedarea;
+                        $grouproles{$spec.'.'.$area.'/'.$group} = 
+                                                $$allgroups{$area}{$group};
+                    }
+                }
+            }
+        }
+    }
+    foreach (keys(%grouproles)) {
+        $$allroles{$_} = $grouproles{$_};
+    }
     foreach (keys %{$allroles}) {
         my %thesepriv=();
         if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
@@ -2971,8 +3017,9 @@ sub tmpput {
 
 # ------------------------------------------------------------ tmpget interface
 sub tmpget {
-    my ($token)=@_;
-    my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'});
+    my ($token,$server)=@_;
+    if (!defined($server)) { $server = $perlvar{'lonHostID'}; }
+    my $rep=&reply("tmpget:$token",$server);
     my %returnhash;
     foreach my $item (split(/\&/,$rep)) {
 	my ($key,$value)=split(/=/,$item);
@@ -2981,6 +3028,13 @@ 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 {
@@ -3023,8 +3077,6 @@ sub allowed {
     my $orguri=$uri;
     $uri=&declutter($uri);
     
-    
-    
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m|/bulletinboard$|)) 
@@ -3071,7 +3123,7 @@ sub allowed {
     if (($priv eq 'ccc') && ($env{'request.role'} =~ /^dc\./)) {
         # uri is the requested domain in this case.
         # comparison to 'request.role.domain' shows if the user has selected
-        # a role of dc for the domain in question. 
+        # a role of dc for the domain in question.
         return 'F' if ($uri eq $env{'request.role.domain'});
     }
 
@@ -3102,6 +3154,14 @@ sub allowed {
        $thisallowed.=$1;
     }
 
+# Group: uri itself is a group
+    my $groupuri=$uri;
+    $groupuri=~s/^([^\/])/\/$1/;
+    if ($env{'user.priv.'.$env{'request.role'}.'.'.$groupuri}
+       =~/\Q$priv\E\&([^\:]*)/) {
+       $thisallowed.=$1;
+    }
+
 # URI is an uploaded document for this course, default permissions don't matter
 # not allowing 'edit' access (editupload) to uploaded course docs
     if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
@@ -3293,17 +3353,21 @@ sub allowed {
        my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/\Q$rolecode\E/) {
-           &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
-                'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
-                $env{'request.course.id'});
+	   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'});
+	   }
            return '';
        }
 
        if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
 	   =~/\Q$unamedom\E/) {
-           &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
-                'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
-                $env{'request.course.id'});
+	   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'});
+	   }
            return '';
        }
    }
@@ -3313,9 +3377,11 @@ sub allowed {
    if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$env{'request.role'}))[0];
        if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
-	   &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
-		'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
-          return '';
+	   if ($priv ne 'pch') { 
+	       &logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
+			'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
+	   }
+	   return '';
        }
    }
 
@@ -3652,11 +3718,102 @@ sub auto_instcode_format {
     return $response;
 }
 
+# ------------------------------------------------------- Course Group routines
+
+sub get_coursegroups {
+    my ($cdom,$cnum,$group) = @_;
+    return(&dump('coursegroups',$cdom,$cnum,$group));
+}
+
+sub modify_coursegroup {
+    my ($cdom,$cnum,$groupsettings) = @_;
+    return(&put('coursegroups',$groupsettings,$cdom,$cnum));
+}
+
+sub modify_group_roles {
+    my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs) = @_;
+    my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
+    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;
+}
+
+sub modify_coursegroup_membership {
+    my ($cdom,$cnum,$membership) = @_;
+    my $result = &put('groupmembership',$membership,$cdom,$cnum);
+    return $result;
+}
+
+sub get_active_groups {
+    my ($udom,$uname,$cdom,$cnum) = @_;
+    my $now = time;
+    my %groups = ();
+    foreach my $key (keys(%env)) {
+        if ($key =~ m-user\.role\.gr\./([^/]+)/([^/]+)/(\w+)$-) {
+            my ($start,$end) = split(/\./,$env{$key});
+            if (($end!=0) && ($end<$now)) { next; }
+            if (($start!=0) && ($start>$now)) { next; }
+            if ($1 eq $cdom && $2 eq $cnum) {
+                $groups{$3} = $env{$key} ;
+            }
+        }
+    }
+    return %groups;
+}
+
+sub get_group_membership {
+    my ($cdom,$cnum,$group) = @_;
+    return(&dump('groupmembership',$cdom,$cnum,$group));
+}
+
+sub get_users_groups {
+    my ($udom,$uname,$courseid) = @_;
+    my $cachetime=1800;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+
+    my $hashid="$udom:$uname:$courseid";
+    my ($result,$cached)=&is_cached_new('getgroups',$hashid);
+    if (defined($cached)) { return $result; }
+
+    my %roleshash = &dump('roles',$udom,$uname,$courseid);
+    my ($tmp) = keys(%roleshash);
+    if ($tmp=~/^error:/) {
+        &logthis('Error retrieving roles: '.$tmp.' for '.$uname.':'.$udom);
+        return '';
+    } else {
+        my $grouplist;
+        foreach my $key (keys %roleshash) {
+            if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) {
+                unless ($roleshash{$key} =~ /_1_1$/) {   # deleted membership
+                    $grouplist .= $1.':';
+                }
+            }
+        }
+        $grouplist =~ s/:$//;
+        return &do_cache_new('getgroups',$hashid,$grouplist,$cachetime);
+    }
+}
+
+sub devalidate_getgroups_cache {
+    my ($udom,$uname,$cdom,$cnum)=@_;
+    my $courseid = $cdom.'_'.$cnum;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my $hashid="$udom:$uname:$courseid";
+    &devalidate_cache_new('getgroups',$hashid);
+}
+
 # ------------------------------------------------------------------ Plain Text
 
 sub plaintext {
     my $short=shift;
-    return &mt($prp{$short});
+    return &Apache::lonlocal::mt($prp{$short});
 }
 
 # ----------------------------------------------------------------- Assign Role
@@ -3674,6 +3831,16 @@ sub assignrole {
            return 'refused'; 
         }
         $mrole='cr';
+    } elsif ($role =~ /^gr\//) {
+        my $cwogrp=$url;
+        $cwogrp=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
+        unless (&allowed('mdg',$cwogrp)) {
+            &logthis('Refused group assignrole: '.
+              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
+                    $env{'user.name'}.' at '.$env{'user.domain'});
+            return 'refused';
+        }
+        $mrole='gr';
     } else {
         my $cwosec=$url;
         $cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
@@ -3834,6 +4001,7 @@ sub modifyuser {
     }
     my $reply = &put('environment', \%names, $udom,$uname);
     if ($reply ne 'ok') { return 'error: '.$reply; }
+    &devalidate_cache_new('namescache',$uname.':'.$udom);
     &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
 	     $last.', '.$gene.' by '.
@@ -4638,7 +4806,7 @@ sub EXT {
 # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {
 	    if ($qualifier eq 'textremote') {
-		if (&mt('textual_remote_display') eq 'on') {
+		if (&Apache::lonlocal::mt('textual_remote_display') eq 'on') {
 		    return 1;
 		} else {
 		    return 0;
@@ -4655,10 +4823,21 @@ sub EXT {
         return $env{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {
 
-	my $section;
 	if (defined($courseid) && $courseid eq $env{'request.course.id'}) {
 	    if (!$symbparm) { $symbparm=&symbread(); }
 	}
+
+	if ($space eq 'title') {
+	    if (!$symbparm) { $symbparm = $env{'request.filename'}; }
+	    return &gettitle($symbparm);
+	}
+	
+	if ($space eq 'map') {
+	    my ($map) = &decode_symb($symbparm);
+	    return &symbread($map);
+	}
+
+	my ($section, $group, @groups);
 	my ($courselevelm,$courselevel);
 	if ($symbparm && defined($courseid) && 
 	    $courseid eq $env{'request.course.id'}) {
@@ -4675,12 +4854,20 @@ sub EXT {
 	    if (($env{'user.name'} eq $uname) &&
 		($env{'user.domain'} eq $udom)) {
 		$section=$env{'request.course.sec'};
+                @groups=&sort_course_groups($env{'request.course.groups'},$courseid); 
+                if (@groups > 0) {
+                    @groups = sort(@groups);
+                }
 	    } else {
 		if (! defined($usection)) {
 		    $section=&getsection($udom,$uname,$courseid);
 		} else {
 		    $section = $usection;
 		}
+                my $grouplist = &get_users_groups($udom,$uname,$courseid);
+                if ($grouplist) {
+                    @groups=&sort_course_groups($grouplist,$courseid);
+                }
 	    }
 
 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
@@ -4696,12 +4883,17 @@ sub EXT {
 	    my $userreply=&resdata($uname,$udom,'user',
 				       ($courselevelr,$courselevelm,
 					$courselevel));
-
 	    if (defined($userreply)) { return $userreply; }
 
 # ------------------------------------------------ second, check some of course
+            my $coursereply;
+            if (@groups > 0) {
+                $coursereply = &check_group_parms($courseid,\@groups,$symbparm,
+                                       $mapparm,$spacequalifierrest);
+                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,
@@ -4776,6 +4968,32 @@ sub EXT {
     return '';
 }
 
+sub check_group_parms {
+    my ($courseid,$groups,$symbparm,$mapparm,$what) = @_;
+    my @groupitems = ();
+    my $resultitem;
+    my @levels = ($symbparm,$mapparm,$what);
+    foreach my $group (@{$groups}) {
+        foreach my $level (@levels) {
+             my $item = $courseid.'.['.$group.'].'.$level;
+             push(@groupitems,$item);
+        }
+    }
+    my $coursereply = &resdata($env{'course.'.$courseid.'.num'},
+                            $env{'course.'.$courseid.'.domain'},
+                                     'course',@groupitems);
+    return $coursereply;
+}
+
+sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
+    my ($grouplist,$courseid) = @_;
+    my @groups = split/:/,$grouplist;
+    if (@groups > 1) {
+        @groups = sort(@groups);
+    }
+    return @groups;
+}
+
 sub packages_tab_default {
     my ($uri,$varname)=@_;
     my (undef,$part,$name)=split(/\./,$varname);
@@ -5266,6 +5484,9 @@ 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};
@@ -5379,8 +5600,37 @@ sub numval3 {
     return $total;
 }
 
+sub digest {
+    my ($data)=@_;
+    my $digest=&Digest::MD5::md5($data);
+    my ($a,$b,$c,$d)=unpack("iiii",$digest);
+    my ($e,$f);
+    {
+        use integer;
+        $e=($a+$b);
+        $f=($c+$d);
+        if ($_64bit) {
+            $e=(($e<<32)>>32);
+            $f=(($f<<32)>>32);
+        }
+    }
+    if (wantarray) {
+	return ($e,$f);
+    } else {
+	my $g;
+	{
+	    use integer;
+	    $g=($e+$f);
+	    if ($_64bit) {
+		$g=(($g<<32)>>32);
+	    }
+	}
+	return $g;
+    }
+}
+
 sub latest_rnd_algorithm_id {
-    return '64bit4';
+    return '64bit5';
 }
 
 sub get_rand_alg {
@@ -5420,11 +5670,15 @@ sub rndseed {
     if (!$username) { $username=$wusername }
     my $which=&get_rand_alg();
     if (defined(&getCODE())) {
-	if ($which eq '64bit4') {
+	if ($which eq '64bit5') {
+	    return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
+	} elsif ($which eq '64bit4') {
 	    return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username);
 	} else {
 	    return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
 	}
+    } elsif ($which eq '64bit5') {
+	return &rndseed_64bit5($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit4') {
 	return &rndseed_64bit4($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit3') {
@@ -5547,6 +5801,12 @@ sub rndseed_64bit4 {
     }
 }
 
+sub rndseed_64bit5 {
+    my ($symb,$courseid,$domain,$username)=@_;
+    my ($num1,$num2)=&digest("$symb,$courseid,$domain,$username");
+    return "$num1:$num2";
+}
+
 sub rndseed_CODE_64bit {
     my ($symb,$courseid,$domain,$username)=@_;
     {
@@ -5585,6 +5845,13 @@ sub rndseed_CODE_64bit4 {
     }
 }
 
+sub rndseed_CODE_64bit5 {
+    my ($symb,$courseid,$domain,$username)=@_;
+    my $code = &getCODE();
+    my ($num1,$num2)=&digest("$symb,$courseid,$code");
+    return "$num1:$num2";
+}
+
 sub setup_random_from_rndseed {
     my ($rndseed)=@_;
     if ($rndseed =~/([,:])/) {
@@ -5923,13 +6190,6 @@ sub thaw_unescape {
     return &unescape($value);
 }
 
-sub mod_perl_version {
-    return 1;
-    if (defined($perlvar{'MODPERL2'})) {
-	return 2;
-    }
-}
-
 sub correct_line_ends {
     my ($result)=@_;
     $$result =~s/\r\n/\n/mg;
@@ -6000,7 +6260,7 @@ BEGIN {
 #           next if /^\#/;
            chomp;
            my ($domain, $domain_description, $def_auth, $def_auth_arg,
-	       $def_lang, $city, $longi, $lati) = split(/:/,$_);
+	       $def_lang, $city, $longi, $lati, $primary) = split(/:/,$_);
 	   $domain_auth_def{$domain}=$def_auth;
            $domain_auth_arg_def{$domain}=$def_auth_arg;
 	   $domaindescription{$domain}=$domain_description;
@@ -6008,6 +6268,7 @@ BEGIN {
 	   $domain_city{$domain}=$city;
 	   $domain_longi{$domain}=$longi;
 	   $domain_lati{$domain}=$lati;
+           $domain_primary{$domain}=$primary;
 
  #         &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
 #          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );