--- loncom/lonnet/perl/lonnet.pm	2002/01/04 16:31:41	1.197
+++ loncom/lonnet/perl/lonnet.pm	2002/06/14 20:47:45	1.237
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.197 2002/01/04 16:31:41 www Exp $
+# $Id: lonnet.pm,v 1.237 2002/06/14 20:47:45 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -66,7 +66,7 @@
 # 12/18 Scott Harrison
 # 12/21,12/22,12/27,12/28 Gerd Kortemeyer
 # YEAR=2002
-# 1/4 Gerd Kortemeyer
+# 1/4,2/4,2/7 Gerd Kortemeyer
 #
 ###
 
@@ -77,14 +77,14 @@ use Apache::File;
 use LWP::UserAgent();
 use HTTP::Headers;
 use vars 
-qw(%perlvar %hostname %homecache %hostip %spareid %hostdom 
+qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom 
    %libserv %pr %prp %metacache %packagetab 
    %courselogs %accesshash $processmarker $dumpcount 
-   %coursedombuf %coursehombuf);
+   %coursedombuf %coursehombuf %courseresdatacache);
 use IO::Socket;
 use GDBM_File;
 use Apache::Constants qw(:common :http);
-use HTML::TokeParser;
+use HTML::LCParser;
 use Fcntl qw(:flock);
 my $readit;
 
@@ -137,8 +137,24 @@ sub subreply {
 
 sub reply {
     my ($cmd,$server)=@_;
+    unless (defined($hostname{$server})) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);
-    if ($answer eq 'con_lost') { $answer=subreply($cmd,$server); }
+    if ($answer eq 'con_lost') {
+       #sleep 5; 
+       #$answer=subreply($cmd,$server);
+       #if ($answer eq 'con_lost') {
+	#   &logthis("Second attempt con_lost on $server");
+        #   my $peerfile="$perlvar{'lonSockDir'}/$server";
+        #   my $client=IO::Socket::UNIX->new(Peer    =>"$peerfile",
+        #                                    Type    => SOCK_STREAM,
+        #                                    Timeout => 10)
+        #              or return "con_lost";
+        #   &logthis("Killing socket");
+        #   print $client "close_connection_exit\n";
+           #sleep 5;
+        #   $answer=subreply($cmd,$server);       
+       #}   
+    }
     if (($answer=~/^refused/) || ($answer=~/^rejected/)) {
        &logthis("<font color=blue>WARNING:".
                 " $cmd to $server returned $answer</font>");
@@ -348,6 +364,41 @@ sub spareserver {
     return $spareserver;
 }
 
+# --------------------------------------------- Try to change a user's password
+
+sub changepass {
+    my ($uname,$udom,$currentpass,$newpass,$server)=@_;
+    $currentpass = &escape($currentpass);
+    $newpass     = &escape($newpass);
+    my $answer = reply("encrypt:passwd:$udom:$uname:$currentpass:$newpass",
+		       $server);
+    if (! $answer) {
+	&logthis("No reply on password change request to $server ".
+		 "by $uname in domain $udom.");
+    } elsif ($answer =~ "^ok") {
+        &logthis("$uname in $udom successfully changed their password ".
+		 "on $server.");
+    } elsif ($answer =~ "^pwchange_failure") {
+	&logthis("$uname in $udom was unable to change their password ".
+		 "on $server.  The action was blocked by either lcpasswd ".
+		 "or pwchange");
+    } elsif ($answer =~ "^non_authorized") {
+        &logthis("$uname in $udom did not get their password correct when ".
+		 "attempting to change it on $server.");
+    } elsif ($answer =~ "^auth_mode_error") {
+        &logthis("$uname in $udom attempted to change their password despite ".
+		 "not being locally or internally authenticated on $server.");
+    } elsif ($answer =~ "^unknown_user") {
+        &logthis("$uname in $udom attempted to change their password ".
+		 "on $server but were unable to because $server is not ".
+		 "their home server.");
+    } elsif ($answer =~ "^refused") {
+	&logthis("$server refused to change $uname in $udom password because ".
+		 "it was sent an unencrypted request to change the password.");
+    }
+    return $answer;
+}
+
 # ----------------------- Try to determine user's current authentication scheme
 
 sub queryauthenticate {
@@ -391,6 +442,7 @@ sub queryauthenticate {
 sub authenticate {
     my ($uname,$upass,$udom)=@_;
     $upass=escape($upass);
+    $uname=~s/\W//g;
     if (($perlvar{'lonRole'} eq 'library') && 
         ($udom eq $perlvar{'lonDefDomain'})) {
     my $answer=reply("encrypt:auth:$udom:$uname:$upass",$perlvar{'lonHostID'});
@@ -429,19 +481,23 @@ sub authenticate {
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 sub homeserver {
-    my ($uname,$udom)=@_;
-
+    my ($uname,$udom,$ignoreBadCache)=@_;
     my $index="$uname:$udom";
-    if ($homecache{$index}) { return "$homecache{$index}"; }
-
+    if ($homecache{$index}) { 
+        return "$homecache{$index}"; 
+    }
     my $tryserver;
     foreach $tryserver (keys %libserv) {
+        next if ($ignoreBadCache ne 'true' && 
+		 exists($badServerCache{$tryserver}));
 	if ($hostdom{$tryserver} eq $udom) {
            my $answer=reply("home:$udom:$uname",$tryserver);
            if ($answer eq 'found') { 
-	      $homecache{$index}=$tryserver;
+              $homecache{$index}=$tryserver;
               return $tryserver; 
-	   }
+           } elsif ($answer eq 'no_host') {
+	       $badServerCache{$tryserver}=1;
+           }
        }
     }    
     return 'no_host';
@@ -575,6 +631,7 @@ sub subscribe {
 sub repcopy {
     my $filename=shift;
     $filename=~s/\/+/\//g;
+    if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; }
     my $transname="$filename.in.transfer";
     if ((-e $filename) || (-e $transname)) { return OK; }
     my $remoteurl=subscribe($filename);
@@ -640,7 +697,7 @@ sub ssi {
     
     if (%form) {
       $request=new HTTP::Request('POST',"http://".$ENV{'HTTP_HOST'}.$fn);
-      $request->content(join '&', map { "$_=$form{$_}" } keys %form);
+      $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
     } else {
       $request=new HTTP::Request('GET',"http://".$ENV{'HTTP_HOST'}.$fn);
     }
@@ -742,6 +799,7 @@ sub checkout {
     my $now=time;
     my $lonhost=$perlvar{'lonHostID'};
     my $infostr=&escape(
+                 'CHECKOUTTOKEN&'.
                  $tuname.'&'.
                  $tudom.'&'.
                  $tcrsid.'&'.
@@ -791,7 +849,7 @@ sub checkin {
     $lonhost=~tr/A-Z/a-z/;
     my $dtoken=$ta.'_'.$hostip{$lonhost}.'_'.$tb;
     $dtoken=~s/\W/\_/g;
-    my ($tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
+    my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
 
     unless (($tuname) && ($tudom)) {
@@ -861,10 +919,55 @@ sub devalidate {
     }
 }
 
+sub arrayref2str {
+  my ($arrayref) = @_;
+  my $result='_ARRAY_REF__';
+  foreach my $elem (@$arrayref) {
+    if (ref($elem) eq 'ARRAY') {
+      $result.=&escape(&arrayref2str($elem)).'&';
+    } elsif (ref($elem) eq 'HASH') {
+      $result.=&escape(&hashref2str($elem)).'&';
+    } elsif (ref($elem)) {
+      &logthis("Got a ref of ".(ref($elem))." skipping.");
+    } else {
+      $result.=&escape($elem).'&';
+    }
+  }
+  $result=~s/\&$//;
+  return $result;
+}
+
 sub hash2str {
-  my (%hash)=@_;
-  my $result='';
-  foreach (keys %hash) { $result.=escape($_).'='.escape($hash{$_}).'&'; }
+  my (%hash) = @_;
+  my $result=&hashref2str(\%hash);
+  $result=~s/^_HASH_REF__//;
+  return $result;
+}
+
+sub hashref2str {
+  my ($hashref)=@_;
+  my $result='_HASH_REF__';
+  foreach (keys(%$hashref)) {
+    if (ref($_) eq 'ARRAY') {
+      $result.=&escape(&arrayref2str($_)).'=';
+    } elsif (ref($_) eq 'HASH') {
+      $result.=&escape(&hashref2str($_)).'=';
+    } elsif (ref($_)) {
+      &logthis("Got a ref of ".(ref($_))." skipping.");
+    } else {
+      $result.=&escape($_).'=';
+    }
+
+    if (ref($$hashref{$_}) eq 'ARRAY') {
+      $result.=&escape(&arrayref2str($$hashref{$_})).'&';
+    } elsif (ref($$hashref{$_}) eq 'HASH') {
+      $result.=&escape(&hashref2str($$hashref{$_})).'&';
+    } elsif (ref($$hashref{$_})) {
+      &logthis("Got a ref of ".(ref($$hashref{$_}))." skipping.");
+    } else {
+      $result.=&escape($$hashref{$_}).'&';
+    }
+  }
   $result=~s/\&$//;
   return $result;
 }
@@ -874,9 +977,39 @@ sub str2hash {
   my %returnhash;
   foreach (split(/\&/,$string)) {
     my ($name,$value)=split(/\=/,$_);
-    $returnhash{&unescape($name)}=&unescape($value);
+    $name=&unescape($name);
+    $value=&unescape($value);
+    if ($value =~ /^_HASH_REF__/) {
+      $value =~ s/^_HASH_REF__//;
+      my %hash=&str2hash($value);
+      $value=\%hash;
+    } elsif ($value =~ /^_ARRAY_REF__/) {
+      $value =~ s/^_ARRAY_REF__//;
+      my @array=&str2array($value);
+      $value=\@array;
+    }
+    $returnhash{$name}=$value;
   }
-  return %returnhash;
+  return (%returnhash);
+}
+
+sub str2array {
+  my ($string) = @_;
+  my @returnarray;
+  foreach my $value (split(/\&/,$string)) {
+    $value=&unescape($value);
+    if ($value =~ /^_HASH_REF__/) {
+      $value =~ s/^_HASH_REF__//;
+      my %hash=&str2hash($value);
+      $value=\%hash;
+    } elsif ($value =~ /^_ARRAY_REF__/) {
+      $value =~ s/^_ARRAY_REF__//;
+      my @array=&str2array($value);
+      $value=\@array;
+    }
+    push(@returnarray,$value);
+  }
+  return (@returnarray);
 }
 
 # -------------------------------------------------------------------Temp Store
@@ -1011,6 +1144,7 @@ sub store {
 
     if ($stuname) { $home=&homeserver($stuname,$domain); }
 
+    $symb=&symbclean($symb);
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }
 
     &devalidate($symb);
@@ -1041,6 +1175,7 @@ sub cstore {
 
     if ($stuname) { $home=&homeserver($stuname,$domain); }
 
+    $symb=&symbclean($symb);
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }
 
     &devalidate($symb);
@@ -1076,7 +1211,7 @@ sub restore {
     if (!$symb) {
       unless ($symb=escape(&symbread())) { return ''; }
     } else {
-      $symb=&escape($symb);
+      $symb=&escape(&symbclean($symb));
     }
     if (!$namespace) { 
        unless ($namespace=$ENV{'request.course.id'}) { 
@@ -1414,19 +1549,16 @@ sub allowed {
 # the course
 
     if ($ENV{'request.course.id'}) {
+
        $courseprivid=$ENV{'request.course.id'};
        if ($ENV{'request.course.sec'}) {
           $courseprivid.='/'.$ENV{'request.course.sec'};
        }
        $courseprivid=~s/\_/\//;
        my $checkreferer=1;
-       my @uriparts=split(/\//,$uri);
-       my $filename=$uriparts[$#uriparts];
-       my $pathname=$uri;
-       $pathname=~s/\/$filename$//;
-       if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
-           /\&$filename\:([\d\|]+)\&/) {
-           $statecond=$1;
+       my ($match,$cond)=&is_on_map($uri);
+       if ($match) {
+           $statecond=$cond;
            if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                =~/$priv\&([^\:]*)/) {
                $thisallowed.=$1;
@@ -1436,7 +1568,6 @@ sub allowed {
        
        if ($checkreferer) {
 	  my $refuri=$ENV{'httpref.'.$orguri};
-
             unless ($refuri) {
                 foreach (keys %ENV) {
 		    if ($_=~/^httpref\..*\*/) {
@@ -1450,15 +1581,12 @@ sub allowed {
                     }
                 }
             }
+
          if ($refuri) { 
 	  $refuri=&declutter($refuri);
-          my @uriparts=split(/\//,$refuri);
-          my $filename=$uriparts[$#uriparts];
-          my $pathname=$refuri;
-          $pathname=~s/\/$filename$//;
-            if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
-              /\&$filename\:([\d\|]+)\&/) {
-              my $refstatecond=$1;
+          my ($match,$cond)=&is_on_map($refuri);
+            if ($match) {
+              my $refstatecond=$cond;
               if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                   =~/$priv\&([^\:]*)/) {
                   $thisallowed.=$1;
@@ -1556,6 +1684,7 @@ sub allowed {
 
    if ($thisallowed=~/C/) {
        my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
+       my $unamedom=$ENV{'user.name'}.':'.$ENV{'user.domain'};
        if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
 	   =~/$rolecode/) {
            &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
@@ -1563,6 +1692,14 @@ sub allowed {
                 $ENV{'request.course.id'});
            return '';
        }
+
+       if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.users.denied'}
+	   =~/$unamedom/) {
+           &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
+                'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
+                $ENV{'request.course.id'});
+           return '';
+       }
    }
 
 # Resource preferences
@@ -1599,6 +1736,23 @@ sub allowed {
    return 'F';
 }
 
+# --------------------------------------------------- Is a resource on the map?
+
+sub is_on_map {
+    my $uri=&declutter(shift);
+    my @uriparts=split(/\//,$uri);
+    my $filename=$uriparts[$#uriparts];
+    my $pathname=$uri;
+    $pathname=~s/\/$filename$//;
+    my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
+	       /\&$filename\:([\d\|]+)\&/);
+    if ($match) {
+       return (1,$1);
+   } else {
+       return (0,0);
+   }
+}
+
 # ----------------------------------------------------------------- Define Role
 
 sub definerole {
@@ -1732,21 +1886,28 @@ sub modifyuserauth {
 
 # --------------------------------------------------------------- Modify a user
 
-
 sub modifyuser {
-    my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,
-        $forceid)=@_;
+    my ($udom,    $uname, $uid,
+        $umode,   $upass, $first,
+        $middle,  $last,  $gene,
+        $forceid, $desiredhome)=@_;
+    $udom=~s/\W//g;
+    $uname=~s/\W//g;
     &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
              $umode.', '.$first.', '.$middle.', '.
-	     $last.', '.$gene.'(forceid: '.$forceid.') by '.
-             $ENV{'user.name'}.' at '.$ENV{'user.domain'});  
-    my $uhome=&homeserver($uname,$udom);
+	     $last.', '.$gene.'(forceid: '.$forceid.')'.
+             (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
+                                     ' desiredhome not specified'). 
+             ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
+    my $uhome=&homeserver($uname,$udom,'true');
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && ($umode) && ($upass)) {
         my $unhome='';
-	if ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {
+        if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { 
+            $unhome = $desiredhome;
+	} elsif($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $udom) {
 	    $unhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
-        } else {
+        } else { # load balancing routine for determining $unhome
             my $tryserver;
             my $loadm=10000000;
             foreach $tryserver (keys %libserv) {
@@ -1760,18 +1921,19 @@ sub modifyuser {
 	    }
         }
         if (($unhome eq '') || ($unhome eq 'no_host')) {
-	    return 'error: find home';
+	    return 'error: unable to find a home server for '.$uname.
+                   ' in domain '.$udom;
         }
         my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':'.$umode.':'.
                          &escape($upass),$unhome);
 	unless ($reply eq 'ok') {
             return 'error: '.$reply;
         }   
-        $uhome=&homeserver($uname,$udom);
+        $uhome=&homeserver($uname,$udom,'true');
         if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
 	    return 'error: verify home';
         }
-    }
+    }   # End of creation of new user
 # ---------------------------------------------------------------------- Add ID
     if ($uid) {
        $uid=~tr/A-Z/a-z/;
@@ -1789,6 +1951,7 @@ sub modifyuser {
     my %names=&get('environment',
 		   ['firstname','middlename','lastname','generation'],
 		   $udom,$uname);
+    if ($names{'firstname'} =~ m/^error:.*/) { %names=(); }
     if ($first)  { $names{'firstname'}  = $first; }
     if ($middle) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
@@ -1806,14 +1969,15 @@ sub modifyuser {
 
 sub modifystudent {
     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-        $end,$start,$forceid)=@_;
+        $end,$start,$forceid,$desiredhome)=@_;
     my $cid='';
     unless ($cid=$ENV{'request.course.id'}) {
 	return 'not_in_class';
     }
 # --------------------------------------------------------------- Make the user
     my $reply=&modifyuser
-	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid);
+	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
+         $desiredhome);
     unless ($reply eq 'ok') { return $reply; }
     my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
@@ -1872,11 +2036,11 @@ sub createcourse {
    my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
        unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
 # ----------------------------------------------- Make sure that does not exist
-   my $uhome=&homeserver($uname,$udom);
+   my $uhome=&homeserver($uname,$udom,'true');
    unless (($uhome eq '') || ($uhome eq 'no_host')) {
        $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
         unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
-       $uhome=&homeserver($uname,$udom);       
+       $uhome=&homeserver($uname,$udom,'true');       
        unless (($uhome eq '') || ($uhome eq 'no_host')) {
            return 'error: unable to generate unique course-ID';
        } 
@@ -1885,7 +2049,7 @@ sub createcourse {
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
                       $ENV{'user.home'});
     unless ($reply eq 'ok') { return 'error: '.$reply; }
-    $uhome=&homeserver($uname,$udom);
+    $uhome=&homeserver($uname,$udom,'true');
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such course';
     }
@@ -2021,11 +2185,54 @@ sub condval {
     return $result;
 }
 
+# --------------------------------------------------- Course Resourcedata Query
+
+sub courseresdata {
+    my ($coursenum,$coursedomain,@which)=@_;
+    my $coursehom=&homeserver($coursenum,$coursedomain);
+    my $hashid=$coursenum.':'.$coursedomain;
+    unless (defined($courseresdatacache{$hashid.'.time'})) {
+	unless (time-$courseresdatacache{$hashid.'.time'}<300) {
+           my $coursehom=&homeserver($coursenum,$coursedomain);
+           if ($coursehom) {
+              my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum.
+			     ':resourcedata:.',$coursehom);
+	      unless ($dumpreply=~/^error\:/) {
+	         $courseresdatacache{$hashid.'.time'}=time;
+                 $courseresdatacache{$hashid}=$dumpreply;
+	     }
+	  }
+       }
+    }
+   my @pairs=split(/\&/,$courseresdatacache{$hashid});
+   my %returnhash=();
+   foreach (@pairs) {
+      my ($key,$value)=split(/=/,$_);
+      $returnhash{unescape($key)}=unescape($value);
+   }
+    my $item;
+   foreach $item (@which) {
+       if ($returnhash{$item}) { return $returnhash{$item}; }
+   }
+   return '';
+}
+
 # --------------------------------------------------------- Value of a Variable
 
 sub EXT {
-    my ($varname,$symbparm)=@_;
+    my ($varname,$symbparm,$udom,$uname)=@_;
+
     unless ($varname) { return ''; }
+
+    #get real user name/domain, courseid and symb
+    my $courseid;
+    if (!($uname && $udom)) {
+      (my $cursymb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser();
+      if (!$symbparm) {	$symbparm=$cursymb; }
+    } else {
+	$courseid=$ENV{'request.course.id'};
+    }
+
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;
     if ($therest[0]) {
@@ -2040,19 +2247,28 @@ sub EXT {
     if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource
 	if ($space eq 'resource') {
-	    my %restored=&restore();
+	    my %restored=&restore(undef,undef,$udom,$uname);
             return $restored{$qualifierrest};
 # ----------------------------------------------------------------- user.access
         } elsif ($space eq 'access') {
+	    # FIXME - not supporting calls for a specific user
             return &allowed($qualifier,$rest);
 # ------------------------------------------ user.preferences, user.environment
         } elsif (($space eq 'preferences') || ($space eq 'environment')) {
-            return $ENV{join('.',('environment',$qualifierrest))};
+	    if (($uname eq $ENV{'user.name'}) &&
+		($udom eq $ENV{'user.domain'})) {
+		return $ENV{join('.',('environment',$qualifierrest))};
+	    } else {
+		my %returnhash=&userenvironment($udom,$uname,$qualifierrest);
+		return $returnhash{$qualifierrest};
+	    }
 # ----------------------------------------------------------------- user.course
         } elsif ($space eq 'course') {
+	    # FIXME - not supporting calls for a specific user
             return $ENV{join('.',('request.course',$qualifier))};
 # ------------------------------------------------------------------- user.role
         } elsif ($space eq 'role') {
+	    # FIXME - not supporting calls for a specific user
             my ($role,$where)=split(/\./,$ENV{'request.role'});
             if ($qualifier eq 'value') {
 		return $role;
@@ -2061,17 +2277,21 @@ sub EXT {
             }
 # ----------------------------------------------------------------- user.domain
         } elsif ($space eq 'domain') {
-            return $ENV{'user.domain'};
+            return $udom;
 # ------------------------------------------------------------------- user.name
         } elsif ($space eq 'name') {
-            return $ENV{'user.name'};
+            return $uname;
 # ---------------------------------------------------- Any other user namespace
         } else {
             my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
             my %reply=&get($space,[$item]);
             return $reply{$item};
         }
-    } elsif ($realm eq 'request') {
+    } elsif ($realm eq 'query') {
+# ---------------------------------------------- pull stuff out of query string
+        &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]);
+	return $ENV{'form.'.$space}; 
+   } elsif ($realm eq 'request') {
 # ------------------------------------------------------------- request.browser
         if ($space eq 'browser') {
 	    return $ENV{'browser.'.$qualifier};
@@ -2081,127 +2301,112 @@ sub EXT {
         }
     } elsif ($realm eq 'course') {
 # ---------------------------------------------------------- course.description
-        return $ENV{'course.'.$ENV{'request.course.id'}.'.'.
-                              $spacequalifierrest};
+        return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};
     } elsif ($realm eq 'resource') {
-       if ($ENV{'request.course.id'}) {
 
-#	   print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
+	if ($courseid eq $ENV{'request.course.id'}) {
 
+	    #print '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
 
 # ----------------------------------------------------- Cascading lookup scheme
-         my $symbp;
-         if ($symbparm) {
-            $symbp=$symbparm;
-	 } else {
-            $symbp=&symbread();
-         }            
-         my $mapp=(split(/\_\_\_/,$symbp))[0];
-
-         my $symbparm=$symbp.'.'.$spacequalifierrest;
-         my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
-
-         my $seclevel=
-            $ENV{'request.course.id'}.'.['.
-		$ENV{'request.course.sec'}.'].'.$spacequalifierrest;
-         my $seclevelr=
-            $ENV{'request.course.id'}.'.['.
-		$ENV{'request.course.sec'}.'].'.$symbparm;
-         my $seclevelm=
-            $ENV{'request.course.id'}.'.['.
-		$ENV{'request.course.sec'}.'].'.$mapparm;
-
-         my $courselevel=
-            $ENV{'request.course.id'}.'.'.$spacequalifierrest;
-         my $courselevelr=
-            $ENV{'request.course.id'}.'.'.$symbparm;
-         my $courselevelm=
-            $ENV{'request.course.id'}.'.'.$mapparm;
+	    if (!$symbparm) { $symbparm=&symbread(); }
+	    my $symbp=$symbparm;
+	    my $mapp=(split(/\_\_\_/,$symbp))[0];
+
+	    my $symbparm=$symbp.'.'.$spacequalifierrest;
+	    my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
+
+	    my $section;
+	    if (($ENV{'user.name'} eq $uname) &&
+		($ENV{'user.domain'} eq $udom)) {
+		$section={'request.course.sec'};
+	    } else {
+		$section=&usection($udom,$uname,$courseid);
+	    }
 
-# ----------------------------------------------------------- first, check user
-         my %resourcedata=get('resourcedata',
-                           [$courselevelr,$courselevelm,$courselevel]);
-         if (($resourcedata{$courselevelr}!~/^error\:/) &&
-             ($resourcedata{$courselevelr}!~/^con_lost/)) {
-
-         if ($resourcedata{$courselevelr}) { 
-            return $resourcedata{$courselevelr}; }
-         if ($resourcedata{$courselevelm}) { 
-            return $resourcedata{$courselevelm}; }
-         if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
+	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
+	    my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
+	    my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
+
+	    my $courselevel=$courseid.'.'.$spacequalifierrest;
+	    my $courselevelr=$courseid.'.'.$symbparm;
+	    my $courselevelm=$courseid.'.'.$mapparm;
 
-      } else {
-	  if ($resourcedata{$courselevelr}!~/No such file/) {
-	    &logthis("<font color=blue>WARNING:".
-		   " Trying to get resource data for ".$ENV{'user.name'}." at "
-                   .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
-                 "</font>");
-	  }
-      }
+# ----------------------------------------------------------- first, check user
+	    my %resourcedata=&get('resourcedata',
+				  [$courselevelr,$courselevelm,$courselevel],
+				 $udom,$uname);
+	    if (($resourcedata{$courselevelr}!~/^error\:/) &&
+		($resourcedata{$courselevelr}!~/^con_lost/)) {
+
+		if ($resourcedata{$courselevelr}) {
+		    return $resourcedata{$courselevelr}; }
+		if ($resourcedata{$courselevelm}) {
+		    return $resourcedata{$courselevelm}; }
+		if ($resourcedata{$courselevel}) {
+		    return $resourcedata{$courselevel}; }
+	    } else {
+		if ($resourcedata{$courselevelr}!~/No such file/) {
+		    &logthis("<font color=blue>WARNING:".
+			     " Trying to get resource data for ".
+			     $uname." at ".$udom.": ".
+			     $resourcedata{$courselevelr}."</font>");
+		}
+	    }
 
 # -------------------------------------------------------- second, check course
 
-        my $reply=&reply('get:'.
-              $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
-              $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
-	      ':resourcedata:'.
-   &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
-   &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
-		   $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
-      if ($reply!~/^error\:/) {
-	  foreach (split(/\&/,$reply)) {
-	      if ($_) { return &unescape($_); }
-          }
-      }
-      if (($reply=~/^con_lost/) || ($reply=~/^error\:/)) {
-	  &logthis("<font color=blue>WARNING:".
-                " Getting ".$reply." asking for ".$varname." for ".
-                $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
-                ' at '.
-                $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
-                ' from '.
-                $ENV{'course.'.$ENV{'request.course.id'}.'.home'}.
-                 "</font>");
-      }
+	    my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'},
+					  $ENV{'course.'.$courseid.'.domain'},
+					  ($seclevelr,$seclevelm,$seclevel,
+					   $courselevelr,$courselevelm,
+					   $courselevel));
+	    if ($coursereply) { return $coursereply; }
+
 # ------------------------------------------------------ third, check map parms
-       my %parmhash=();
-       my $thisparm='';       
-       if (tie(%parmhash,'GDBM_File',
-          $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
-           $thisparm=$parmhash{$symbparm};
-	   untie(%parmhash);
-       }
-       if ($thisparm) { return $thisparm; }
-     }
-     
+	    my %parmhash=();
+	    my $thisparm='';
+	    if (tie(%parmhash,'GDBM_File',
+		    $ENV{'request.course.fn'}.'_parms.db',
+		    &GDBM_READER,0640)) {
+		$thisparm=$parmhash{$symbparm};
+		untie(%parmhash);
+	    }
+	    if ($thisparm) { return $thisparm; }
+	}
 # --------------------------------------------- last, look in resource metadata
 
-      $spacequalifierrest=~s/\./\_/;
-      my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
-      if ($metadata) { return $metadata; }
-      $metadata=&metadata($ENV{'request.filename'},
-                                         'parameter_'.$spacequalifierrest);
-      if ($metadata) { return $metadata; }
+	$spacequalifierrest=~s/\./\_/;
+	my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
+	if ($metadata) { return $metadata; }
+	$metadata=&metadata($ENV{'request.filename'},
+			    'parameter_'.$spacequalifierrest);
+	if ($metadata) { return $metadata; }
 
 # ------------------------------------------------------------------ Cascade up
-
-      unless ($space eq '0') {
-          my ($part,$id)=split(/\_/,$space);
-          if ($id) {
-	      my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
-                                   $symbparm);
-              if ($partgeneral) { return $partgeneral; }
-          } else {
-              my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
-                                       $symbparm);
-              if ($resourcegeneral) { return $resourcegeneral; }
-          }
-      }
+	unless ($space eq '0') {
+	    my ($part,$id)=split(/\_/,$space);
+	    if ($id) {
+		my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
+				     $symbparm,$udom,$uname);
+		if ($partgeneral) { return $partgeneral; }
+	    } else {
+		my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
+					 $symbparm,$udom,$uname);
+		if ($resourcegeneral) { return $resourcegeneral; }
+	    }
+	}
 
 # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {
 # ----------------------------------------------------------------- environment
-        return $ENV{'environment.'.$spacequalifierrest};
+	if (($uname eq $ENV{'user.name'})&&($udom eq $ENV{'user.domain'})) {
+	    return $ENV{'environment.'.$spacequalifierrest};
+	} else {
+	    my %returnhash=&userenvironment($udom,$uname,
+					    $spacequalifierrest);
+	    return $returnhash{$spacequalifierrest};
+	}
     } elsif ($realm eq 'system') {
 # ----------------------------------------------------------------- system.time
 	if ($space eq 'time') {
@@ -2235,7 +2440,7 @@ sub metadata {
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
 	my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
-        my $parser=HTML::TokeParser->new(\$metastring);
+        my $parser=HTML::LCParser->new(\$metastring);
         my $token;
         undef %metathesekeys;
         while ($token=$parser->get_token) {
@@ -2324,7 +2529,7 @@ sub metadata {
 		  $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
               }
               unless (
-                 $metacache{$uri.':'.$unikey}=$parser->get_text('/'.$entry)
+                 $metacache{$uri.':'.$unikey}=&HTML::Entities::decode($parser->get_text('/'.$entry))
 		      ) { $metacache{$uri.':'.$unikey}=
 			      $metacache{$uri.':'.$unikey.'.default'};
 		      }
@@ -2362,12 +2567,63 @@ sub symblist {
     return 'error';
 }
 
+# --------------------------------------------------------------- Verify a symb
+
+sub symbverify {
+    my ($symb,$thisfn)=@_;
+    $thisfn=&declutter($thisfn);
+# direct jump to resource in page or to a sequence - will construct own symbs
+    if ($thisfn=~/\.(page|sequence)$/) { return 1; }
+# check URL part
+    my ($map,$resid,$url)=split(/\_\_\_/,$symb);
+    unless (&symbclean($url) eq &symbclean($thisfn)) { return 0; }
+
+    $symb=&symbclean($symb);
+
+    my %bighash;
+    my $okay=0;
+    if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+                            &GDBM_READER,0640)) {
+        my $ids=$bighash{'ids_/res/'.$thisfn};
+        unless ($ids) { 
+           $ids=$bighash{'ids_/'.$thisfn};
+        }
+        if ($ids) {
+# ------------------------------------------------------------------- Has ID(s)
+	    foreach (split(/\,/,$ids)) {
+               my ($mapid,$resid)=split(/\./,$_);
+               if (
+  &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
+   eq $symb) { 
+                  $okay=1; 
+               }
+	   }
+        }
+	untie(%bighash);
+    }
+    return $okay;
+}
+
+# --------------------------------------------------------------- Clean-up symb
+
+sub symbclean {
+    my $symb=shift;
+
+# remove version from map
+    $symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/;
+
+# remove version from URL
+    $symb=~s/\.(\d+)\.(\w+)$/\.$2/;
+
+    return $symb;
+}
+
 # ------------------------------------------------------ Return symb list entry
 
 sub symbread {
     my $thisfn=shift;
     unless ($thisfn) {
-        if ($ENV{'request.symb'}) { return $ENV{'request.symb'}; }
+        if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); }
 	$thisfn=$ENV{'request.filename'};
     }
     $thisfn=declutter($thisfn);
@@ -2426,7 +2682,7 @@ sub symbread {
            } 
         }
         if ($syval) {
-           return $syval.'___'.$thisfn; 
+           return &symbclean($syval.'___'.$thisfn); 
         }
     }
     &appenv('request.ambiguous' => $thisfn);
@@ -2530,6 +2786,7 @@ sub hreflocation {
     unless (($file=~/^http:\/\//i) || ($file=~/^\//)) {
        my $finalpath=filelocation($dir,$file);
        $finalpath=~s/^\/home\/httpd\/html//;
+       $finalpath=~s-/home/(\w+)/public_html/-/~$1/-;
        return $finalpath;
     } else {
        return $file;
@@ -2543,6 +2800,7 @@ sub declutter {
     $thisfn=~s/^$perlvar{'lonDocRoot'}//;
     $thisfn=~s/^\///;
     $thisfn=~s/^res\///;
+    $thisfn=~s/\?.+$//;
     return $thisfn;
 }
 
@@ -2565,18 +2823,30 @@ sub unescape {
 # ================================================================ Main Program
 
 sub goodbye {
+   &logthis("Starting Shut down");
    &flushcourselogs();
    &logthis("Shutting down");
 }
 
 BEGIN {
-# ------------------------------------------------------------ Read access.conf
+# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
     unless ($readit) {
 {
-    my $config=Apache::File->new("/etc/httpd/conf/access.conf");
+    my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf");
 
     while (my $configline=<$config>) {
-        if ($configline =~ /PerlSetVar/) {
+        if ($configline =~ /^[^\#]*PerlSetVar/) {
+	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
+           chomp($varvalue);
+           $perlvar{$varname}=$varvalue;
+        }
+    }
+}
+{
+    my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf");
+
+    while (my $configline=<$config>) {
+        if ($configline =~ /^[^\#]*PerlSetVar/) {
 	   my ($dummy,$varname,$varvalue)=split(/\s+/,$configline);
            chomp($varvalue);
            $perlvar{$varname}=$varvalue;
@@ -2827,12 +3097,30 @@ devalidate($symb) : devalidate spreadshe
 =item *
 
 hash2str(%hash) : convert a hash into a string complete with escaping and '='
-and '&' separators
+and '&' separators, supports elements that are arrayrefs and hashrefs
+
+=item *
+
+hashref2str($hashref) : convert a hashref into a string complete with
+escaping and '=' and '&' separators, supports elements that are
+arrayrefs and hashrefs
+
+=item *
+
+arrayref2str($arrayref) : convert an arrayref into a string complete
+with escaping and '&' separators, supports elements that are arrayrefs
+and hashrefs
+
+=item *
+
+str2hash($string) : convert string to hash using unescaping and
+splitting on '=' and '&', supports elements that are arrayrefs and
+hashrefs
 
 =item *
 
-str2hash($string) : convert string to hash using unescaping and splitting on
-'=' and '&'
+str2array($string) : convert string to hash using unescaping and
+splitting on '&', supports elements that are arrayrefs and hashrefs
 
 =item *
 
@@ -3027,7 +3315,7 @@ replicates and subscribes to the file
 =item *
 
 filelocation($dir,$file) : returns file system location of a file based on URI;
-meant to be "fairly clean" absolute reference
+meant to be "fairly clean" absolute reference, $dir is a directory that relative $file lookups are to looked in ($dir of /a/dir and a file of ../bob will become /a/bob)
 
 =item *