Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.182 and 1.229

-version 1.182, 2001/12/05 14:48:28
+version 1.229, 2002/05/21 13:06:07
  Line 61
  # 10/5,10/10,11/13,11/15 Scott Harrison
  # 11/17,11/20,11/22,11/29 Gerd Kortemeyer
  # 12/5 Matthew Hall
- #
+ # 12/5 Guy Albertelli
- # $Id$
+ # 12/6,12/7,12/12 Gerd Kortemeyer
+ # 12/18 Scott Harrison
+ # 12/21,12/22,12/27,12/28 Gerd Kortemeyer
+ # YEAR=2002
+ # 1/4,2/4,2/7 Gerd Kortemeyer
  #
  ###
- # Functions for use by content handlers:
- #
- # metadata_query(sql-query-string,custom-metadata-regex) :
- #                                    returns file handle of where sql and
- #                                    regex results will be stored for query
- # plaintext(short)   : plain text explanation of short term
- # fileembstyle(ext)  : embed style in page for file extension
- # filedescription(ext) : descriptor text for file extension
- # allowed(short,url) : returns codes for allowed actions
- #                      F: full access
- #                      U,I,K: authentication modes (cxx only)
- #                      '': forbidden
- #                      1: user needs to choose course
- #                      2: browse allowed
- # definerole(rolename,sys,dom,cou) : define a custom role rolename
- #                      set privileges in format of lonTabs/roles.tab for
- #                      system, domain and course level,
- # assignrole(udom,uname,url,role,end,start) : give a role to a user for the
- #                      level given by url. Optional start and end dates
- #                      (leave empty string or zero for "no date")
- # assigncustomrole (udom,uname,url,rdom,rnam,rolename,end,start) : give a
- #                      custom role to a user for the level given by url.
- #                      Specify name and domain of role author, and role name
- # revokerole (udom,uname,url,role) : Revoke a role for url
- # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
- # appenv(hash)       : adds hash to session environment
- # delenv(varname)    : deletes all environment entries starting with varname
- # store(hashref,symb,courseid,udom,uname)
- #                    : stores hash permanently for this url
- #                      hashref needs to be given, and should be a \%hashname
- #                      the remaining args aren't required and if they aren't
- #                      passed or are '' they will be derived from the ENV
- # cstore(hashref,symb,courseid,udom,uname)
- #                    : same as store but uses the critical interface to
- #                      guarentee a store
- # restore(symb,courseid,udom,uname)
- #                    : returns hash for this symb, all args are optional
- #                      if they aren't given they will be derived from the
- #                      current enviroment
- #
- #
- # for the next 6 functions udom and uname are optional
- #         if supplied they use udom as the domain and uname
- #         as the username for the function (supply a courseid
- #         for the uname if you want a course database)
- #         if not supplied it uses %ENV and looks at
- #         user. attribute for the values
- #
- # eget(namesp,arrayref,udom,uname)
- #                    : returns hash with keys from array  reference filled
- #                      in from namesp (encrypts the return communication)
- # get(namesp,arrayref,udom,uname)
- #                    : returns hash with keys from array  reference filled
- #                      in from namesp
- # dump(namesp,udom,uname) : dumps the complete namespace into a hash
- # del(namesp,array,udom,uname)  : deletes keys out of array from namesp
- # put(namesp,hash,udom,uname)   : stores hash in namesp
- # cput(namesp,hash,udom,uname)  : critical put
- #
- #
- # ssi(url,hash)      : does a complete request cycle on url to localhost, posts
- #                      hash
- # coursedescription(id) : returns and caches course description for id
- # repcopy(filename)  : replicate file
- # dirlist(url)       : gets a directory listing
- # directcondval(index) : reading condition value of single condition from
- #                        state string
- # condval(index)     : value of condition index based on state
- # EXT(name)          : value of a variable
- # symblist(map,hash) : Updates symbolic storage links
- # symbread([filename]) : returns the data handle (filename optional)
- # rndseed([symb,courseid,domain,uname])
- #                    : returns a random seed, all arguments are optional,
- #                      if they aren't sent it use the environment to derive
- #                      them
- #                      Note: if symb isn't sent and it can't get one from
- #                      &symbread it will use the current time as it's return
- # receipt()          : returns a receipt to be given out to users
- # getfile(filename)  : returns the contents of filename, or a -1 if it can't
- #                      be found, replicates and subscribes to the file
- # filelocation(dir,file) : returns a fairly clean absolute reference to file
- #                          from the directory dir
- # hreflocation(dir,file) : same as filelocation, but for hrefs
- # log(domain,user,home,msg) : write to permanent log for user
- # usection(domain,user,courseid) : output of section name/number or '' for
- #                                  "not in course" and '-1' for "no section"
- # userenvironment(domain,user,what) : puts out any environment parameter
- #                                     for a user
- # idput(domain,hash) : writes IDs for users from hash (name=>id,name=>id)
- # idget(domain,array): returns hash with usernames (id=>name,id=>name) for
- #                      an array of IDs
- # idrget(domain,array): returns hash with IDs for usernames (name=>id,...) for
- #                       an array of names
- # metadata(file,entry): returns the metadata entry for a file. entry='keys'
- #                       returns a comma separated list of keys
- #
  package Apache::lonnet;
  use strict;
- Line 170  use Apache::File;
+ Line 77  use Apache::File;
  use LWP::UserAgent();
  use HTTP::Headers;
  use vars
- qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab %courselogs);
+ qw(%perlvar %hostname %homecache %badhomecache %hostip %spareid %hostdom
+    %libserv %pr %prp %metacache %packagetab
+    %courselogs %accesshash $processmarker $dumpcount
+    %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;
  # --------------------------------------------------------------------- Logging
- Line 226  sub subreply {
+ Line 137  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>");
- Line 322  sub critical {
+ Line 249  sub critical {
  sub appenv {
      my %newenv=@_;
-     map {
+     foreach (keys %newenv) {
  	if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) {
              &logthis("<font color=blue>WARNING: ".
                  "Attempt to modify environment ".$_." to ".$newenv{$_}
- Line 331  sub appenv {
+ Line 258  sub appenv {
          } else {
              $ENV{$_}=$newenv{$_};
          }
-     } keys %newenv;
+     }
      my $lockfh;
      unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
- Line 413  sub delenv {
+ Line 340  sub delenv {
           $fh->close();
           return 'error: '.$!;
       }
-      map {
+      foreach (@oldenv) {
  	 unless ($_=~/^$delthis/) { print $fh $_; }
-      } @oldenv;
+      }
       $fh->close();
      }
      return 'ok';
- Line 437  sub spareserver {
+ Line 364  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 {
- Line 480  sub queryauthenticate {
+ Line 442  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'});
- Line 518  sub authenticate {
+ Line 481  sub authenticate {
  # ---------------------- Find the homebase for a user from domain's lib servers
  sub homeserver {
-     my ($uname,$udom)=@_;
+     my ($uname,$udom, $cacheBadFlag)=@_;
      my $index="$uname:$udom";
-     if ($homecache{$index}) { return "$homecache{$index}"; }
+     if ($homecache{$index}) {
+         return "$homecache{$index}";
+     }
      my $tryserver;
      foreach $tryserver (keys %libserv) {
+         next if ($cacheBadFlag eq 'true' &&
+ 		 exists($badhomecache{$index}->{$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;
- 	   }
+            } else {
+ 	       $badhomecache{$index}->{$tryserver}=1;
+            }
+        } else {
+            $badhomecache{$index}->{$tryserver}=1;
         }
      }
      return 'no_host';
- Line 568  sub idget {
+ Line 537  sub idget {
  sub idrget {
      my ($udom,@unames)=@_;
      my %returnhash=();
-     map {
+     foreach (@unames) {
          $returnhash{$_}=(&userenvironment($udom,$_,'id'))[1];
-     } @unames;
+     }
      return %returnhash;
  }
- Line 579  sub idrget {
+ Line 548  sub idrget {
  sub idput {
      my ($udom,%ids)=@_;
      my %servers=();
-     map {
+     foreach (keys %ids) {
          my $uhom=&homeserver($_,$udom);
          if ($uhom ne 'no_host') {
              my $id=&escape($ids{$_});
- Line 592  sub idput {
+ Line 561  sub idput {
              }
              &critical('put:'.$udom.':'.$unam.':environment:id='.$id,$uhom);
          }
-     } keys %ids;
+     }
-     map {
+     foreach (keys %servers) {
          &critical('idput:'.$udom.':'.$servers{$_},$_);
-     } keys %servers;
+     }
  }
  # ------------------------------------- Find the section of student in a course
- Line 604  sub usection {
+ Line 573  sub usection {
      my ($udom,$unam,$courseid)=@_;
      $courseid=~s/\_/\//g;
      $courseid=~s/^(\w)/\/$1/;
-     map {
+     foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+                         &homeserver($unam,$udom)))) {
          my ($key,$value)=split(/\=/,$_);
          $key=&unescape($key);
          if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
- Line 621  sub usection {
+ Line 591  sub usection {
              }
              unless ($notactive) { return $section; }
          }
-     } split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+     }
-                         &homeserver($unam,$udom)));
      return '-1';
  }
- Line 664  sub subscribe {
+ Line 633  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);
- Line 729  sub ssi {
+ Line 699  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);
      }
- Line 751  sub log {
+ Line 721  sub log {
  sub flushcourselogs {
      &logthis('Flushing course log buffers');
-     map {
+     foreach (keys %courselogs) {
          my $crsid=$_;
-         if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'.
+         if (&reply('log:'.$coursedombuf{$crsid}.':'.
- 		          $ENV{'course.'.$crsid.'.num'}.':'.
+ 		          &escape($courselogs{$crsid}),
- 		           &escape($courselogs{$crsid}),
+ 		          $coursehombuf{$crsid}) eq 'ok') {
- 		          $ENV{'course.'.$crsid.'.home'}) eq 'ok') {
  	    delete $courselogs{$crsid};
          } else {
              &logthis('Failed to flush log buffer for '.$crsid);
- Line 766  sub flushcourselogs {
+ Line 735  sub flushcourselogs {
                 delete $courselogs{$crsid};
              }
          }
-     } keys %courselogs;
+     }
+     &logthis('Flushing access logs');
+     foreach (keys %accesshash) {
+         my $entry=$_;
+         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
+         my %temphash=($entry => $accesshash{$entry});
+         if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') {
+ 	    delete $accesshash{$entry};
+         }
+     }
+     $dumpcount++;
  }
  sub courselog {
      my $what=shift;
      $what=time.':'.$what;
      unless ($ENV{'request.course.id'}) { return ''; }
+     $coursedombuf{$ENV{'request.course.id'}}=
+        $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
+        $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+     $coursehombuf{$ENV{'request.course.id'}}=
+        $ENV{'course.'.$ENV{'request.course.id'}.'.home'};
      if (defined $courselogs{$ENV{'request.course.id'}}) {
  	$courselogs{$ENV{'request.course.id'}}.='&'.$what;
      } else {
- Line 787  sub courseacclog {
+ Line 771  sub courseacclog {
      my $fnsymb=shift;
      unless ($ENV{'request.course.id'}) { return ''; }
      my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
-     if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {
+     if ($fnsymb=~/(problem|exam|quiz|assess|survey|form)$/) {
- 	map {
+         $what.=':POST';
+ 	foreach (keys %ENV) {
              if ($_=~/^form\.(.*)/) {
  		$what.=':'.$1.'='.$ENV{$_};
              }
-         } keys %ENV;
+         }
      }
      &courselog($what);
  }
+ sub countacc {
+     my $url=&declutter(shift);
+     unless ($ENV{'request.course.id'}) { return ''; }
+     $accesshash{$ENV{'request.course.id'}.'___'.$url.'___course'}=1;
+     my $key=$processmarker.'_'.$dumpcount.'___'.$url.'___count';
+     if (defined($accesshash{$key})) {
+ 	$accesshash{$key}++;
+     } else {
+         $accesshash{$key}=1;
+     }
+ }
  # ----------------------------------------------------------- Check out an item
  sub checkout {
- Line 923  sub devalidate {
+ Line 920  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 (%hash) = @_;
-   my $result='';
+   my $result=&hashref2str(\%hash);
-   map { $result.=escape($_).'='.escape($hash{$_}).'&'; } keys %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;
  }
- Line 934  sub hash2str {
+ Line 976  sub hash2str {
  sub str2hash {
    my ($string) = @_;
    my %returnhash;
-   map {
+   foreach (split(/\&/,$string)) {
      my ($name,$value)=split(/\=/,$_);
-     $returnhash{&unescape($name)}=&unescape($value);
+     $name=&unescape($name);
-   } split(/\&/,$string);
+     $value=&unescape($value);
-   return %returnhash;
+     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);
+ }
+ 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
- Line 1073  sub store {
+ Line 1145  sub store {
      if ($stuname) { $home=&homeserver($stuname,$domain); }
+     $symb=&symbclean($symb);
      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
      &devalidate($symb);
      $symb=escape($symb);
-     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+     if (!$namespace) {
+        unless ($namespace=$ENV{'request.course.id'}) {
+           return '';
+        }
+     }
      if (!$domain) { $domain=$ENV{'user.domain'}; }
      if (!$stuname) { $stuname=$ENV{'user.name'}; }
      if (!$home) { $home=$ENV{'user.home'}; }
      my $namevalue='';
-     map {
+     foreach (keys %$storehash) {
          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
-     } keys %$storehash;
+     }
      $namevalue=~s/\&$//;
+     &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue);
      return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
  }
- Line 1098  sub cstore {
+ Line 1176  sub cstore {
      if ($stuname) { $home=&homeserver($stuname,$domain); }
+     $symb=&symbclean($symb);
      if (!$symb) { unless ($symb=&symbread()) { return ''; } }
      &devalidate($symb);
      $symb=escape($symb);
-     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
+     if (!$namespace) {
+        unless ($namespace=$ENV{'request.course.id'}) {
+           return '';
+        }
+     }
      if (!$domain) { $domain=$ENV{'user.domain'}; }
      if (!$stuname) { $stuname=$ENV{'user.name'}; }
      if (!$home) { $home=$ENV{'user.home'}; }
      my $namevalue='';
-     map {
+     foreach (keys %$storehash) {
          $namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
-     } keys %$storehash;
+     }
      $namevalue=~s/\&$//;
-     return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
+     &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue);
+     return critical
+                 ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
  }
  # --------------------------------------------------------------------- Restore
- Line 1127  sub restore {
+ Line 1212  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'}) {
+           return '';
+        }
      }
-     if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
      if (!$domain) { $domain=$ENV{'user.domain'}; }
      if (!$stuname) { $stuname=$ENV{'user.name'}; }
      if (!$home) { $home=$ENV{'user.home'}; }
      my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");
      my %returnhash=();
-     map {
+     foreach (split(/\&/,$answer)) {
  	my ($name,$value)=split(/\=/,$_);
          $returnhash{&unescape($name)}=&unescape($value);
-     } split(/\&/,$answer);
+     }
      my $version;
      for ($version=1;$version<=$returnhash{'version'};$version++) {
-        map {
+        foreach (split(/\:/,$returnhash{$version.':keys'})) {
            $returnhash{$_}=$returnhash{$version.':'.$_};
-        } split(/\:/,$returnhash{$version.':keys'});
+        }
      }
      return %returnhash;
  }
- Line 1195  sub rolesinit {
+ Line 1284  sub rolesinit {
      my $thesestr;
      if ($rolesdump ne '') {
-         map {
+         foreach (split(/&/,$rolesdump)) {
  	  if ($_!~/^rolesdef\&/) {
              my ($area,$role)=split(/=/,$_);
              $area=~s/\_\w\w$//;
- Line 1251  sub rolesinit {
+ Line 1340  sub rolesinit {
  	       }
              }
            }
-         } split(/&/,$rolesdump);
+         }
          my $adv=0;
          my $author=0;
-         map {
+         foreach (keys %allroles) {
              %thesepriv=();
              if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }
              if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
-             map {
+             foreach (split(/:/,$allroles{$_})) {
                  if ($_ ne '') {
  		    my ($privilege,$restrictions)=split(/&/,$_);
                      if ($restrictions eq '') {
- Line 1269  sub rolesinit {
+ Line 1358  sub rolesinit {
                          }
                      }
                  }
-             } split(/:/,$allroles{$_});
+             }
              $thesestr='';
-             map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
+             foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
              $userroles.='user.priv.'.$_.'='.$thesestr."\n";
-         } keys %allroles;
+         }
          $userroles.='user.adv='.$adv."\n".
  	            'user.author='.$author."\n";
          $ENV{'user.adv'}=$adv;
- Line 1286  sub rolesinit {
+ Line 1375  sub rolesinit {
  sub get {
     my ($namespace,$storearr,$udomain,$uname)=@_;
     my $items='';
-    map {
+    foreach (@$storearr) {
         $items.=escape($_).'&';
-    } @$storearr;
+    }
     $items=~s/\&$//;
     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
     if (!$uname) { $uname=$ENV{'user.name'}; }
- Line 1298  sub get {
+ Line 1387  sub get {
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
     my $i=0;
-    map {
+    foreach (@$storearr) {
        $returnhash{$_}=unescape($pairs[$i]);
        $i++;
-    } @$storearr;
+    }
     return %returnhash;
  }
- Line 1310  sub get {
+ Line 1399  sub get {
  sub del {
     my ($namespace,$storearr,$udomain,$uname)=@_;
     my $items='';
-    map {
+    foreach (@$storearr) {
         $items.=escape($_).'&';
-    } @$storearr;
+    }
     $items=~s/\&$//;
     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
     if (!$uname) { $uname=$ENV{'user.name'}; }
- Line 1324  sub del {
+ Line 1413  sub del {
  # -------------------------------------------------------------- dump interface
  sub dump {
-    my ($namespace,$udomain,$uname)=@_;
+    my ($namespace,$udomain,$uname,$regexp)=@_;
     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
     if (!$uname) { $uname=$ENV{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
-    my $rep=reply("dump:$udomain:$uname:$namespace",$uhome);
+    if ($regexp) {
+        $regexp=&escape($regexp);
+    } else {
+        $regexp='.';
+    }
+    my $rep=reply("dump:$udomain:$uname:$namespace:$regexp",$uhome);
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
-    map {
+    foreach (@pairs) {
        my ($key,$value)=split(/=/,$_);
        $returnhash{unescape($key)}=unescape($value);
-    } @pairs;
+    }
     return %returnhash;
  }
- Line 1346  sub put {
+ Line 1440  sub put {
     if (!$uname) { $uname=$ENV{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
     my $items='';
-    map {
+    foreach (keys %$storehash) {
         $items.=&escape($_).'='.&escape($$storehash{$_}).'&';
-    } keys %$storehash;
+    }
     $items=~s/\&$//;
     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
  }
- Line 1361  sub cput {
+ Line 1455  sub cput {
     if (!$uname) { $uname=$ENV{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);
     my $items='';
-    map {
+    foreach (keys %$storehash) {
         $items.=escape($_).'='.escape($$storehash{$_}).'&';
-    } keys %$storehash;
+    }
     $items=~s/\&$//;
     return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
  }
- Line 1373  sub cput {
+ Line 1467  sub cput {
  sub eget {
     my ($namespace,$storearr,$udomain,$uname)=@_;
     my $items='';
-    map {
+    foreach (@$storearr) {
         $items.=escape($_).'&';
-    } @$storearr;
+    }
     $items=~s/\&$//;
     if (!$udomain) { $udomain=$ENV{'user.domain'}; }
     if (!$uname) { $uname=$ENV{'user.name'}; }
- Line 1384  sub eget {
+ Line 1478  sub eget {
     my @pairs=split(/\&/,$rep);
     my %returnhash=();
     my $i=0;
-    map {
+    foreach (@$storearr) {
        $returnhash{$_}=unescape($pairs[$i]);
        $i++;
-    } @$storearr;
+    }
     return %returnhash;
  }
- Line 1480  sub allowed {
+ Line 1574  sub allowed {
  	  my $refuri=$ENV{'httpref.'.$orguri};
              unless ($refuri) {
-                 map {
+                 foreach (keys %ENV) {
  		    if ($_=~/^httpref\..*\*/) {
  			my $pattern=$_;
                          $pattern=~s/^httpref\.\/res\///;
- Line 1490  sub allowed {
+ Line 1584  sub allowed {
  			    $refuri=$ENV{$_};
                          }
                      }
-                 } keys %ENV;
+                 }
              }
           if ($refuri) {
  	  $refuri=&declutter($refuri);
- Line 1599  sub allowed {
+ Line 1693  sub allowed {
     if ($thisallowed=~/C/) {
         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
         if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
- 	   =~/\,$rolecode\,/) {
+ 	   =~/$rolecode/) {
             &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
                  'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
                  $ENV{'request.course.id'});
- Line 1646  sub allowed {
+ Line 1740  sub allowed {
  sub definerole {
    if (allowed('mcr','/')) {
      my ($rolename,$sysrole,$domrole,$courole)=@_;
-     map {
+     foreach (split('/',$sysrole)) {
  	my ($crole,$cqual)=split(/\&/,$_);
          if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; }
          if ($pr{'cr:s'}=~/$crole\&/) {
- Line 1654  sub definerole {
+ Line 1748  sub definerole {
                 return "refused:s:$crole&$cqual";
              }
          }
-     } split('/',$sysrole);
+     }
-     map {
+     foreach (split('/',$domrole)) {
  	my ($crole,$cqual)=split(/\&/,$_);
          if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; }
          if ($pr{'cr:d'}=~/$crole\&/) {
- Line 1663  sub definerole {
+ Line 1757  sub definerole {
                 return "refused:d:$crole&$cqual";
              }
          }
-     } split('/',$domrole);
+     }
-     map {
+     foreach (split('/',$courole)) {
  	my ($crole,$cqual)=split(/\&/,$_);
          if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; }
          if ($pr{'cr:c'}=~/$crole\&/) {
- Line 1672  sub definerole {
+ Line 1766  sub definerole {
                 return "refused:c:$crole&$cqual";
              }
          }
-     } split('/',$courole);
+     }
      my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
                  "$ENV{'user.domain'}:$ENV{'user.name'}:".
  	        "rolesdef_$rolename=".
- Line 1710  sub plaintext {
+ Line 1804  sub plaintext {
      return $prp{$short};
  }
- # ------------------------------------------------------------------ Plain Text
- sub fileembstyle {
-     my $ending=lc(shift);
-     return $fe{$ending};
- }
- # ------------------------------------------------------------ Description Text
- sub filedescription {
-     my $ending=lc(shift);
-     return $fd{$ending};
- }
  # ----------------------------------------------------------------- Assign Role
  sub assignrole {
- Line 1762  sub assignrole {
+ Line 1842  sub assignrole {
  }
  # -------------------------------------------------- Modify user authentication
+ # Overrides without validation
  sub modifyuserauth {
      my ($udom,$uname,$umode,$upass)=@_;
      my $uhome=&homeserver($uname,$udom);
-     &logthis('Call to modify user authentication'.$udom.', '.$uname.', '.
+     unless (&allowed('mau',$udom)) { return 'refused'; }
+     &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
               $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
      my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
  		     &escape($upass),$uhome);
+     &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
+         'Authentication changed for '.$udom.', '.$uname.', '.$umode.
+          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+     &log($udom,,$uname,$uhome,
+         'Authentication changed by '.$ENV{'user.domain'}.', '.
+                                      $ENV{'user.name'}.', '.$umode.
+          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
      unless ($reply eq 'ok') {
+         &logthis('Authentication mode error: '.$reply);
  	return 'error: '.$reply;
      }
      return 'ok';
- Line 1777  sub modifyuserauth {
+ Line 1868  sub modifyuserauth {
  # --------------------------------------------------------------- Modify a user
  sub modifyuser {
-     my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene)=@_;
+     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.' by '.
+ 	     $last.', '.$gene.'(forceid: '.$forceid.')'.
-              $ENV{'user.name'}.' at '.$ENV{'user.domain'});
+              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
+                                      ' desiredhome not specified').
+              ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
      my $uhome=&homeserver($uname,$udom);
  # ----------------------------------------------------------------- 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) {
- Line 1804  sub modifyuser {
+ Line 1903  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);
- Line 1815  sub modifyuser {
+ Line 1915  sub modifyuser {
          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/;
         my %uidhash=&idrget($udom,$uname);
-        if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)) {
+        if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)
+          && (!$forceid)) {
  	  unless ($uid eq $uidhash{$uname}) {
  	      return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid;
            }
- Line 1832  sub modifyuser {
+ Line 1933  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; }
- Line 1849  sub modifyuser {
+ Line 1951  sub modifyuser {
  sub modifystudent {
      my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-         $end,$start)=@_;
+         $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);
+ 	($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')) {
- Line 1892  sub writecoursepref {
+ Line 1995  sub writecoursepref {
  	return 'error: no such course';
      }
      my $cstring='';
-     map {
+     foreach (keys %prefs) {
  	$cstring.=escape($_).'='.escape($prefs{$_}).'&';
-     } keys %prefs;
+     }
      $cstring=~s/\&$//;
      return reply('put:'.$cdomain.':'.$cnum.':environment:'.$cstring,$chome);
  }
- Line 1983  sub dirlist {
+ Line 2086  sub dirlist {
  			       $tryserver);
               if (($listing ne 'no_such_dir') && ($listing ne 'empty')
                && ($listing ne 'con_lost')) {
-                 map {
+                 foreach (split(/:/,$listing)) {
                    my ($entry,@stat)=split(/&/,$_);
                    $allusers{$entry}=1;
-                 } split(/:/,$listing);
+                 }
               }
  	  }
         }
         my $alluserstr='';
-        map {
+        foreach (sort keys %allusers) {
             $alluserstr.=$_.'&user:';
-        } sort keys %allusers;
+        }
         $alluserstr=~s/:$//;
         return split(/:/,$alluserstr);
       }
- Line 2004  sub dirlist {
+ Line 2107  sub dirlist {
  	   $alldom{$hostdom{$tryserver}}=1;
         }
         my $alldomstr='';
-        map {
+        foreach (sort keys %alldom) {
            $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
-        } sort keys %alldom;
+        }
         $alldomstr=~s/:$//;
         return split(/:/,$alldomstr);
     }
- Line 2027  sub condval {
+ Line 2130  sub condval {
      my $condidx=shift;
      my $result=0;
      my $allpathcond='';
-     map {
+     foreach (split(/\|/,$condidx)) {
         if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_})) {
  	   $allpathcond.=
                 '('.$ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_}.')|';
         }
-     } split(/\|/,$condidx);
+     }
      $allpathcond=~s/\|$//;
      if ($ENV{'request.course.id'}) {
         if ($allpathcond) {
            my $operand='|';
  	  my @stack;
-           map {
+            foreach ($allpathcond=~/(\d+|\(|\)|\&|\|)/g) {
                if ($_ eq '(') {
                   push @stack,($operand,$result)
                } elsif ($_ eq ')') {
- Line 2056  sub condval {
+ Line 2159  sub condval {
                       $result=$result>$new?$new:$result;
                    } else {
                       $result=$result>$new?$result:$new;
                    }
                }
-           } ($allpathcond=~/(\d+|\(|\)|\&|\|)/g);
+           }
         }
      }
      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]) {
- Line 2083  sub EXT {
+ Line 2229  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;
- Line 2104  sub EXT {
+ Line 2259  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;
- Line 2124  sub EXT {
+ Line 2279  sub EXT {
          }
      } elsif ($realm eq 'course') {
  # ---------------------------------------------------------- course.description
-         return $ENV{'course.'.$ENV{'request.course.id'}.'.'.
+         return $ENV{'course.'.$courseid.'.'.$spacequalifierrest};
-                               $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) { $symbparm=&symbread(); }
-          if ($symbparm) {
+ 	    my $symbp=$symbparm;
-             $symbp=$symbparm;
+ 	    my $mapp=(split(/\_\_\_/,$symbp))[0];
- 	 } else {
-             $symbp=&symbread();
+ 	    my $symbparm=$symbp.'.'.$spacequalifierrest;
-          }
+ 	    my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
-          my $mapp=(split(/\_\_\_/,$symbp))[0];
+ 	    my $section;
-          my $symbparm=$symbp.'.'.$spacequalifierrest;
+ 	    if (($ENV{'user.name'} eq $uname) &&
-          my $mapparm=$mapp.'___(all).'.$spacequalifierrest;
+ 		($ENV{'user.domain'} eq $udom)) {
+ 		$section={'request.course.sec'};
-          my $seclevel=
+ 	    } else {
-             $ENV{'request.course.id'}.'.['.
+ 		$section=&usection($udom,$uname,$courseid);
- 		$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;
- # ----------------------------------------------------------- first, check user
+ 	    my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
-          my %resourcedata=get('resourcedata',
+ 	    my $seclevelr=$courseid.'.['.$section.'].'.$symbparm;
-                            [$courselevelr,$courselevelm,$courselevel]);
+ 	    my $seclevelm=$courseid.'.['.$section.'].'.$mapparm;
-          if (($resourcedata{$courselevelr}!~/^error\:/) &&
-              ($resourcedata{$courselevelr}!~/^con_lost/)) {
+ 	    my $courselevel=$courseid.'.'.$spacequalifierrest;
+ 	    my $courselevelr=$courseid.'.'.$symbparm;
-          if ($resourcedata{$courselevelr}) {
+ 	    my $courselevelm=$courseid.'.'.$mapparm;
-             return $resourcedata{$courselevelr}; }
-          if ($resourcedata{$courselevelm}) {
-             return $resourcedata{$courselevelm}; }
-          if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }
-       } else {
+ # ----------------------------------------------------------- first, check user
- 	  if ($resourcedata{$courselevelr}!~/No such file/) {
+ 	    my %resourcedata=&get('resourcedata',
- 	    &logthis("<font color=blue>WARNING:".
+ 				  [$courselevelr,$courselevelm,$courselevel],
- 		   " Trying to get resource data for ".$ENV{'user.name'}." at "
+ 				 $udom,$uname);
-                    .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
+ 	    if (($resourcedata{$courselevelr}!~/^error\:/) &&
-                  "</font>");
+ 		($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:'.
+ 	    my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'},
-               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
+ 					  $ENV{'course.'.$courseid.'.domain'},
-               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
+ 					  ($seclevelr,$seclevelm,$seclevel,
- 	      ':resourcedata:'.
+ 					   $courselevelr,$courselevelm,
-    &escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
+ 					   $courselevel));
-    &escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
+ 	    if ($coursereply) { return $coursereply; }
- 		   $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
-       if ($reply!~/^error\:/) {
- 	  map {
- 	      if ($_) { return &unescape($_); }
-           } split(/\&/,$reply);
-       }
-       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>");
-       }
  # ------------------------------------------------------ third, check map parms
-        my %parmhash=();
+ 	    my %parmhash=();
-        my $thisparm='';
+ 	    my $thisparm='';
-        if (tie(%parmhash,'GDBM_File',
+ 	    if (tie(%parmhash,'GDBM_File',
-           $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) {
+ 		    $ENV{'request.course.fn'}.'_parms.db',
-            $thisparm=$parmhash{$symbparm};
+ 		    &GDBM_READER,0640)) {
- 	   untie(%parmhash);
+ 		$thisparm=$parmhash{$symbparm};
-        }
+ 		untie(%parmhash);
-        if ($thisparm) { return $thisparm; }
+ 	    }
-      }
+ 	    if ($thisparm) { return $thisparm; }
+ 	}
  # --------------------------------------------- last, look in resource metadata
-       $spacequalifierrest=~s/\./\_/;
+ 	$spacequalifierrest=~s/\./\_/;
-       my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
+ 	my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest);
-       if ($metadata) { return $metadata; }
+ 	if ($metadata) { return $metadata; }
-       $metadata=&metadata($ENV{'request.filename'},
+ 	$metadata=&metadata($ENV{'request.filename'},
-                                          'parameter_'.$spacequalifierrest);
+ 			    'parameter_'.$spacequalifierrest);
-       if ($metadata) { return $metadata; }
+ 	if ($metadata) { return $metadata; }
  # ------------------------------------------------------------------ Cascade up
+ 	unless ($space eq '0') {
-       unless ($space eq '0') {
+ 	    my ($part,$id)=split(/\_/,$space);
-           my ($part,$id)=split(/\_/,$space);
+ 	    if ($id) {
-           if ($id) {
+ 		my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
- 	      my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
+ 				     $symbparm,$udom,$uname);
-                                    $symbparm);
+ 		if ($partgeneral) { return $partgeneral; }
-               if ($partgeneral) { return $partgeneral; }
+ 	    } else {
-           } else {
+ 		my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
-               my $resourcegeneral=&EXT('resource.0.'.$qualifierrest,
+ 					 $symbparm,$udom,$uname);
-                                        $symbparm);
+ 		if ($resourcegeneral) { return $resourcegeneral; }
-               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') {
- Line 2278  sub metadata {
+ Line 2418  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) {
- Line 2304  sub metadata {
+ Line 2444  sub metadata {
                } else {
                   $metacache{$uri.':packages'}=$package.$keyroot;
  	      }
-               map {
+               foreach (keys %packagetab) {
  		  if ($_=~/^$package\&/) {
  		      my ($pack,$name,$subp)=split(/\&/,$_);
                        my $value=$packagetab{$_};
- Line 2321  sub metadata {
+ Line 2461  sub metadata {
                           $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
  		      }
                    }
-               } keys %packagetab;
+               }
               } else {
  #
  # This is not a package - some other kind of start tag
- Line 2351  sub metadata {
+ Line 2491  sub metadata {
  		 if (defined($depthcount)) { $depthcount++; } else
                                             { $depthcount=0; }
                   if ($depthcount<20) {
- 		     map {
+ 		     foreach (split(/\,/,&metadata($uri,'keys',
-                          $metathesekeys{$_}=1;
- 		     } split(/\,/,&metadata($uri,'keys',
                                    $parser->get_text('/import'),$unikey,
-                                   $depthcount));
+                                   $depthcount))) {
+                          $metathesekeys{$_}=1;
+ 		     }
  		 }
               } else {
- Line 2363  sub metadata {
+ Line 2503  sub metadata {
                   $unikey.='_'.$token->[2]->{'name'};
  	      }
                $metathesekeys{$unikey}=1;
-               map {
+               foreach (@{$token->[3]}) {
  		  $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
-               } @{$token->[3]};
+               }
                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'};
  		      }
- Line 2394  sub symblist {
+ Line 2534  sub symblist {
      if (($ENV{'request.course.fn'}) && (%newhash)) {
          if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                        &GDBM_WRCREAT,0640)) {
- 	    map {
+ 	    foreach (keys %newhash) {
                  $hash{declutter($_)}=$mapname.'___'.$newhash{$_};
-             } keys %newhash;
+             }
              if (untie(%hash)) {
  		return 'ok';
              }
- Line 2405  sub symblist {
+ Line 2545  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);
- Line 2451  sub symbread {
+ Line 2642  sub symbread {
                   } else {
  # ------------------------------------------ There is more than one possibility
                       my $realpossible=0;
-                      map {
+                      foreach (@possibilities) {
  			 my $file=$bighash{'src_'.$_};
                           if (&allowed('bre',$file)) {
           		    my ($mapid,$resid)=split(/\./,$_);
- Line 2461  sub symbread {
+ Line 2652  sub symbread {
                                         '___'.$resid;
                              }
  			 }
-                      } @possibilities;
+                      }
  		     if ($realpossible!=1) { $syval=''; }
                   }
  	      }
- Line 2469  sub symbread {
+ Line 2660  sub symbread {
             }
          }
          if ($syval) {
-            return $syval.'___'.$thisfn;
+            return &symbclean($syval.'___'.$thisfn);
          }
      }
      &appenv('request.ambiguous' => $thisfn);
- Line 2570  sub filelocation {
+ Line 2761  sub filelocation {
  sub hreflocation {
      my ($dir,$file)=@_;
-     unless (($_=~/^http:\/\//i) || ($_=~/^\//)) {
+     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;
- Line 2607  sub unescape {
+ Line 2799  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;
- Line 2687  BEGIN {
+ Line 2897  BEGIN {
      }
  }
- # ------------------------------------------------------------- Read file types
- {
-     my $config=Apache::File->new("$perlvar{'lonTabDir'}/filetypes.tab");
-     while (my $configline=<$config>) {
-        next if (/^\#/);
-        chomp($configline);
-        my ($ending,$emb,@descr)=split(/\s+/,$configline);
-        if ($descr[0] ne '') {
-          $fe{$ending}=lc($emb);
-          $fd{$ending}=join(' ',@descr);
-        }
-     }
- }
  %metacache=();
- $readit='done';
+ $processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};
+ $dumpcount=0;
  &logtouch();
  &logthis('<font color=yellow>INFO: Read configuration</font>');
+ $readit=1;
+ }
  }
 ;
+ __END__
+ =head1 NAME
+ Apache::lonnet - TCP networking package
+ =head1 SYNOPSIS
+ Invoked by other LON-CAPA modules.
+  &Apache::lonnet::SUBROUTINENAME(ARGUMENTS);
+ =head1 INTRODUCTION
+ This module provides subroutines which interact with the
+ lonc/lond (TCP) network layer of LON-CAPA.
+ This is part of the LearningOnline Network with CAPA project
+ described at http://www.lon-capa.org.
+ =head1 HANDLER SUBROUTINE
+ There is no handler routine for this module.
+ =head1 OTHER SUBROUTINES
+ =over 4
+ =item *
+ logtouch() : make sure the logfile, lonnet.log, exists
+ =item *
+ logthis() : append message to lonnet.log
+ =item *
+ logperm() : append a permanent message to lonnet.perm.log
+ =item *
+ subreply() : non-critical communication, called by &reply
+ =item *
+ reply() : makes two attempts to pass message; logs refusals and rejections
+ =item *
+ reconlonc() : tries to reconnect lonc client processes.
+ =item *
+ critical() : passes a critical message to another server; if cannot get
+ through then place message in connection buffer
+ =item *
+ appenv(%hash) : read in current user environment, append new environment
+ values to make new user environment
+ =item *
+ delenv($varname) : read in current user environment, remove all values
+ beginning with $varname, write new user environment (note: flock is used
+ to prevent conflicting shared read/writes with file)
+ =item *
+ spareserver() : find server with least workload from spare.tab
+ =item *
+ queryauthenticate($uname,$udom) : try to determine user's current
+ authentication scheme
+ =item *
+ authenticate($uname,$upass,$udom) : try to authenticate user from domain's lib
+ servers (first use the current one)
+ =item *
+ homeserver($uname,$udom) : find the homebase for a user from domain's lib
+ servers
+ =item *
+ idget($udom,@ids) : find the usernames behind a list of IDs (returns hash:
+ id=>name,id=>name)
+ =item *
+ idrget($udom,@unames) : find the IDs behind a list of usernames (returns hash:
+ name=>id,name=>id)
+ =item *
+ idput($udom,%ids) : store away a list of names and associated IDs
+ =item *
+ usection($domain,$user,$courseid) : output of section name/number or '' for
+ "not in course" and '-1' for "no section"
+ =item *
+ userenvironment($domain,$user,$what) : puts out any environment parameter
+ for a user
+ =item *
+ subscribe($fname) : subscribe to a resource, return URL if possible
+ =item *
+ repcopy($filename) : replicate file
+ =item *
+ ssi($url,%hash) : server side include, does a complete request cycle on url to
+ localhost, posts hash
+ =item *
+ log($domain,$name,$home,$message) : write to permanent log for user; use
+ critical subroutine
+ =item *
+ flushcourselogs() : flush (save) buffer logs and access logs
+ =item *
+ courselog($what) : save message for course in hash
+ =item *
+ courseacclog($what) : save message for course using &courselog().  Perform
+ special processing for specific resource types (problems, exams, quizzes, etc).
+ =item *
+ countacc($url) : count the number of accesses to a given URL
+ =item *
+ sub checkout($symb,$tuname,$tudom,$tcrsid) : check out an item
+ =item *
+ sub checkin($token) : check in an item
+ =item *
+ sub expirespread($uname,$udom,$stype,$usymb) : set expire date for spreadsheet
+ =item *
+ devalidate($symb) : devalidate spreadsheets
+ =item *
+ hash2str(%hash) : convert a hash into a string complete with escaping and '='
+ 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 *
+ str2array($string) : convert string to hash using unescaping and
+ splitting on '&', supports elements that are arrayrefs and hashrefs
+ =item *
+ tmpreset($symb,$namespace,$domain,$stuname) : temporary storage
+ =item *
+ tmprestore($symb,$namespace,$domain,$stuname) : temporary restore
+ =item *
+ store($storehash,$symb,$namespace,$domain,$stuname) : stores hash permanently
+ for this url; hashref needs to be given and should be a \%hashname; the
+ remaining args aren't required and if they aren't passed or are '' they will
+ be derived from the ENV
+ =item *
+ cstore($storehash,$symb,$namespace,$domain,$stuname) : same as store but
+ uses critical subroutine
+ =item *
+ restore($symb,$namespace,$domain,$stuname) : returns hash for this symb;
+ all args are optional
+ =item *
+ coursedescription($courseid) : course description
+ =item *
+ rolesinit($domain,$username,$authhost) : get user privileges
+ =item *
+ get($namespace,$storearr,$udomain,$uname) : returns hash with keys from array
+ reference filled in from namesp ($udomain and $uname are optional)
+ =item *
+ del($namespace,$storearr,$udomain,$uname) : deletes keys out of array from
+ namesp ($udomain and $uname are optional)
+ =item *
+ dump($namespace,$udomain,$uname,$regexp) :
+ dumps the complete (or key matching regexp) namespace into a hash
+ ($udomain, $uname and $regexp are optional)
+ =item *
+ put($namespace,$storehash,$udomain,$uname) : stores hash in namesp
+ ($udomain and $uname are optional)
+ =item *
+ cput($namespace,$storehash,$udomain,$uname) : critical put
+ ($udomain and $uname are optional)
+ =item *
+ eget($namespace,$storearr,$udomain,$uname) : returns hash with keys from array
+ reference filled in from namesp (encrypts the return communication)
+ ($udomain and $uname are optional)
+ =item *
+ allowed($priv,$uri) : check for a user privilege; returns codes for allowed
+ actions
+  F: full access
+  U,I,K: authentication modes (cxx only)
+  '': forbidden
+: user needs to choose course
+: browse allowed
+ =item *
+ definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom
+ role rolename set privileges in format of lonTabs/roles.tab for system, domain,
+ and course level
+ =item *
+ metadata_query($query,$custom,$customshow) : make a metadata query against the
+ network of library servers; returns file handle of where SQL and regex results
+ will be stored for query
+ =item *
+ plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
+ explanation of a user role term
+ =item *
+ assignrole($udom,$uname,$url,$role,$end,$start) : assign role; give a role to a
+ user for the level given by URL.  Optional start and end dates (leave empty
+ string or zero for "no date")
+ =item *
+ modifyuserauth($udom,$uname,$umode,$upass) : modify user authentication
+ =item *
+ modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) :
+ modify user
+ =item *
+ modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
+ $end,$start) : modify student
+ =item *
+ writecoursepref($courseid,%prefs) : write preferences for a course
+ =item *
+ createcourse($udom,$description,$url) : make/modify course
+ =item *
+ assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign
+ custom role; give a custom role to a user for the level given by URL.  Specify
+ name and domain of role author, and role name
+ =item *
+ revokerole($udom,$uname,$url,$role) : revoke a role for url
+ =item *
+ revokecustomrole($udom,$uname,$url,$role) : revoke a custom role
+ =item *
+ dirlist($uri) : return directory list based on URI
+ =item *
+ directcondval($number) : get current value of a condition; reads from a state
+ string
+ =item *
+ condval($condidx) : value of condition index based on state
+ =item *
+ EXT($varname,$symbparm) : value of a variable
+ =item *
+ metadata($uri,$what,$liburi,$prefix,$depthcount) : get metadata; returns the
+ metadata entry for a file; entry='keys', returns a comma separated list of keys
+ =item *
+ symblist($mapname,%newhash) : update symbolic storage links
+ =item *
+ symbread($filename) : return symbolic list entry (filename argument optional);
+ returns the data handle
+ =item *
+ numval($salt) : return random seed value (addend for rndseed)
+ =item *
+ rndseed($symb,$courseid,$domain,$username) : create a random sum; returns
+ a random seed, all arguments are optional, if they aren't sent it uses the
+ environment to derive them. Note: if symb isn't sent and it can't get one
+ from &symbread it will use the current time as its return value
+ =item *
+ ireceipt($funame,$fudom,$fucourseid,$fusymb) : return unique,
+ unfakeable, receipt
+ =item *
+ receipt() : API to ireceipt working off of ENV values; given out to users
+ =item *
+ getfile($file) : serves up a file, returns the contents of a file or -1;
+ 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, $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 *
+ hreflocation($dir,$file) : returns file system location or a URL; same as
+ filelocation except for hrefs
+ =item *
+ declutter() : declutters URLs (remove docroot, beginning slashes, 'res' etc)
+ =item *
+ escape() : unpack non-word characters into CGI-compatible hex codes
+ =item *
+ unescape() : pack CGI-compatible hex codes into actual non-word ASCII character
+ =item *
+ goodbye() : flush course logs and log shutting down; it is called in srm.conf
+ as a PerlChildExitHandler
+ =back
+ =cut

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.

Removed from v.1.182
changed lines
	Added in v.1.229