--- loncom/lonnet/perl/lonnet.pm	2002/07/30 19:57:40	1.255
+++ loncom/lonnet/perl/lonnet.pm	2003/03/22 21:23:35	1.345
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.255 2002/07/30 19:57:40 albertel Exp $
+# $Id: lonnet.pm,v 1.345 2003/03/22 21:23:35 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -47,23 +47,18 @@
 # 09/01 Guy Albertelli
 # 09/01,10/01,11/01 Gerd Kortemeyer
 # YEAR=2001
-# 02/27/01 Scott Harrison
 # 3/2 Gerd Kortemeyer
-# 3/15,3/19 Scott Harrison
 # 3/19,3/20 Gerd Kortemeyer
-# 3/22,3/27,4/2,4/16,4/17 Scott Harrison
 # 5/26,5/28 Gerd Kortemeyer
 # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer
 # July Guy Albertelli
 # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,
 # 10/2 Gerd Kortemeyer
-# 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
 # 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
@@ -77,15 +72,18 @@ use Apache::File;
 use LWP::UserAgent();
 use HTTP::Headers;
 use vars 
-qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom 
-   %libserv %pr %prp %metacache %packagetab 
+qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom 
+   %libserv %pr %prp %metacache %packagetab %titlecache 
    %courselogs %accesshash $processmarker $dumpcount 
-   %coursedombuf %coursehombuf %courseresdatacache %domaindescription);
+   %coursedombuf %coursehombuf %courseresdatacache 
+   %domaindescription %domain_auth_def %domain_auth_arg_def $tmpdir);
 use IO::Socket;
 use GDBM_File;
 use Apache::Constants qw(:common :http);
 use HTML::LCParser;
 use Fcntl qw(:flock);
+use Apache::loncoursedata;
+
 my $readit;
 
 # --------------------------------------------------------------------- Logging
@@ -140,9 +138,9 @@ sub reply {
     unless (defined($hostname{$server})) { return 'no_such_host'; }
     my $answer=subreply($cmd,$server);
     if ($answer eq 'con_lost') {
-       #sleep 5; 
-       #$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",
@@ -213,7 +211,8 @@ sub critical {
             $middlename=substr($middlename,0,16);
             $middlename=~s/\W//g;
             my $dfilename=
-             "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server";
+      "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";
+            $dumpcount++;
             {
              my $dfh;
              if ($dfh=Apache::File->new(">$dfilename")) {
@@ -348,12 +347,36 @@ sub delenv {
     return 'ok';
 }
 
+# ------------------------------------------ Fight off request when overloaded
+
+sub overloaderror {
+    my ($r,$checkserver)=@_;
+    unless ($checkserver) { $checkserver=$perlvar{'lonHostID'}; }
+    my $loadavg;
+    if ($checkserver eq $perlvar{'lonHostID'}) {
+       my $loadfile=Apache::File->new('/proc/loadavg');
+       $loadavg=<$loadfile>;
+       $loadavg =~ s/\s.*//g;
+       $loadavg = 100*$loadavg/$perlvar{'lonLoadLim'};
+    } else {
+       $loadavg=&reply('load',$checkserver);
+    }
+    my $overload=$loadavg-100;
+    if ($overload>0) {
+	$r->err_headers_out->{'Retry-After'}=$overload;
+        $r->log_error('Overload of '.$overload.' on '.$checkserver);
+        return 413;
+    }    
+    return '';
+}
+
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
+    my $loadpercent = shift;
     my $tryserver;
     my $spareserver='';
-    my $lowestserver=100;
+    my $lowestserver=$loadpercent; 
     foreach $tryserver (keys %spareid) {
        my $answer=reply('load',$tryserver);
        if (($answer =~ /\d/) && ($answer<$lowestserver)) {
@@ -565,8 +588,147 @@ sub idput {
     }
 }
 
+# --------------------------------------------------- Assign a key to a student
+
+sub assign_access_key {
+    my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
+    $cdom=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
+    $cnum=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
+    $udom=$ENV{'user.name'} unless (defined($udom));
+    $uname=$ENV{'user.domain'} unless (defined($uname));
+    my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
+    if (($existing{$ckey}=~/^\d+$/) || # has time - new key
+        ($existing{$ckey} eq $udom.':'.$uname)) { # this should not happen,
+                                                  # unless something went wrong
+                                                  # the first time around
+# ready to assign
+    } elsif (!$existing{$ckey}) {
+        if (&put('accesskey',{$ckey=>$udom.':'.$uname},$cdom,$cnum) eq 'ok') {
+# key now belongs to user
+	    my $envkey='key.'.$cdom.'.'.$cnum;
+            if (&put('environment',{$envkey => $ckey}) eq 'ok') {
+                &appenv('environment.'.$envkey => $ckey);
+                return 'ok';
+            } else {
+                return 
+  'error: Count not permanently assign key, will need to be re-entered later.';
+	    }
+        } else {
+            return 'error: Could not assign key, try again later.';
+        }
+# the key does not exist
+	return 'error: The key does not exist';
+    } else {
+# the key is somebody else's
+	return 'error: The key is already in use';
+    }
+}
+
+# ------------------------------------------------------ Generate a set of keys
+
+sub generate_access_keys {
+    my ($number,$cdom,$cnum)=@_;
+    $cdom=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
+    $cnum=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
+    unless (&allowed('ccc',$cdom)) { return 0; }
+    unless (($cdom) && ($cnum)) { return 0; }
+    if ($number>10000) { return 0; }
+    sleep(2); # make sure don't get same seed twice
+    srand(time()^($$+($$<<15))); # from "Programming Perl"
+    my $total=0;
+    for (my $i=1;$i<=$number;$i++) {
+       my $newkey=sprintf("%lx",int(100000*rand)).'-'.
+                  sprintf("%lx",int(100000*rand)).'-'.
+                  sprintf("%lx",int(100000*rand));
+       $newkey=~s/1/g/g; # folks mix up 1 and l
+       $newkey=~s/0/h/g; # and also 0 and O
+       my %existing=&get('accesskeys',[$newkey],$cdom,$cnum);
+       if ($existing{$newkey}) {
+           $i--;
+       } else {
+	  if (&put('accesskeys',{ $newkey => time() },$cdom,$cnum) eq 'ok') {
+              $total++;
+	  }
+       }
+    }
+    &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
+         'Generated '.$total.' keys for '.$cnum.' at '.$cdom);
+    return $total;
+}
+
+# ------------------------------------------------------- Validate an accesskey
+
+sub validate_access_key {
+    my ($ckey,$cdom,$cnum,$udom,$uname)=@_;
+    $cdom=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($cdom));
+    $cnum=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($cnum));
+    $udom=$ENV{'user.name'} unless (defined($udom));
+    $uname=$ENV{'user.domain'} unless (defined($uname));
+    my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
+    return ($existing{$ckey} eq $udom.':'.$uname);
+}
+
 # ------------------------------------- Find the section of student in a course
 
+sub getsection {
+    my ($udom,$unam,$courseid)=@_;
+    $courseid=~s/\_/\//g;
+    $courseid=~s/^(\w)/\/$1/;
+    my %Pending; 
+    my %Expired;
+    #
+    # Each role can either have not started yet (pending), be active, 
+    #    or have expired.
+    #
+    # If there is an active role, we are done.
+    #
+    # If there is more than one role which has not started yet, 
+    #     choose the one which will start sooner
+    # If there is one role which has not started yet, return it.
+    #
+    # If there is more than one expired role, choose the one which ended last.
+    # If there is a role which has expired, return it.
+    #
+    foreach (split(/\&/,&reply('dump:'.$udom.':'.$unam.':roles',
+                        &homeserver($unam,$udom)))) {
+        my ($key,$value)=split(/\=/,$_);
+        $key=&unescape($key);
+        next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/);
+        my $section=$1;
+        if ($key eq $courseid.'_st') { $section=''; }
+        my ($dummy,$end,$start)=split(/\_/,&unescape($value));
+        my $now=time;
+        if (defined($end) && ($now > $end)) {
+            $Expired{$end}=$section;
+            next;
+        }
+        if (defined($start) && ($now < $start)) {
+            $Pending{$start}=$section;
+            next;
+        }
+        return $section;
+    }
+    #
+    # Presumedly there will be few matching roles from the above
+    # loop and the sorting time will be negligible.
+    if (scalar(keys(%Pending))) {
+        my ($time) = sort {$a <=> $b} keys(%Pending);
+        return $Pending{$time};
+    } 
+    if (scalar(keys(%Expired))) {
+        my @sorted = sort {$a <=> $b} keys(%Expired);
+        my $time = pop(@sorted);
+        return $Expired{$time};
+    }
+    return '-1';
+}
+
 sub usection {
     my ($udom,$unam,$courseid)=@_;
     $courseid=~s/\_/\//g;
@@ -608,16 +770,53 @@ sub userenvironment {
     return %returnhash;
 }
 
+# -------------------------------------------------------------------- New chat
+
+sub chatsend {
+    my ($newentry,$anon)=@_;
+    my $cnum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+    my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+    my $chome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+    &reply('chatsend:'.$cdom.':'.$cnum.':'.
+	   &escape($ENV{'user.domain'}.':'.$ENV{'user.name'}.':'.$anon.':'.
+		   &escape($newentry)),$chome);
+}
+
+# ------------------------------------------ Find current version of a resource
+
+sub getversion {
+    my $fname=&clutter(shift);
+    unless ($fname=~/^\/res\//) { return -1; }
+    return &currentversion(&filelocation('',$fname));
+}
+
+sub currentversion {
+    my $fname=shift;
+    my $author=$fname;
+    $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+    my ($udom,$uname)=split(/\//,$author);
+    my $home=homeserver($uname,$udom);
+    if ($home eq 'no_host') { 
+        return -1; 
+    }
+    my $answer=reply("currentversion:$fname",$home);
+    if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
+	return -1;
+    }
+    return $answer;
+}
+
 # ----------------------------- Subscribe to a resource, return URL if possible
 
 sub subscribe {
     my $fname=shift;
+    if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }
     my $author=$fname;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
     my ($udom,$uname)=split(/\//,$author);
     my $home=homeserver($uname,$udom);
-    if (($home eq 'no_host') || ($home eq $perlvar{'lonHostID'})) { 
-        return 'not_found'; 
+    if ($home eq 'no_host') {
+        return 'not_found';
     }
     my $answer=reply("sub:$fname",$home);
     if (($answer eq 'con_lost') || ($answer eq 'rejected')) {
@@ -647,6 +846,11 @@ sub repcopy {
     } elsif ($remoteurl eq 'directory') {
            return OK;
     } else {
+        my $author=$filename;
+        $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
+        my ($udom,$uname)=split(/\//,$author);
+        my $home=homeserver($uname,$udom);
+        unless ($home eq $perlvar{'lonHostID'}) {
            my @parts=split(/\//,$filename);
            my $path="/$parts[1]/$parts[2]/$parts[3]/$parts[4]";
            if ($path ne "$perlvar{'lonDocRoot'}/res") {
@@ -682,9 +886,22 @@ sub repcopy {
                rename($transname,$filename);
                return OK;
            }
+       }
     }
 }
 
+# ------------------------------------------------ Get server side include body
+sub ssi_body {
+    my $filelink=shift;
+    my $output=($filelink=~/^http\:/?&externalssi($filelink):
+                                     &ssi($filelink));
+    $output=~s/^.*\<body[^\>]*\>//si;
+    $output=~s/\<\/body\s*\>.*$//si;
+    $output=~
+            s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
+    return $output;
+}
+
 # --------------------------------------------------------- Server Side Include
 
 sub ssi {
@@ -708,15 +925,99 @@ sub ssi {
     return $response->content;
 }
 
+sub externalssi {
+    my ($url)=@_;
+    my $ua=new LWP::UserAgent;
+    my $request=new HTTP::Request('GET',$url);
+    my $response=$ua->request($request);
+    return $response->content;
+}
+
 # ------- Add a token to a remote URI's query string to vouch for access rights
 
 sub tokenwrapper {
     my $uri=shift;
-    my $token=&reply('tmpput:'.&escape($uri),$perlvar{'lonHostID'});
-    return $uri.(($uri=~/\?/)?'&':'?').
-	'token='.$token.'&server='.$perlvar{'lonHostID'};
+    $uri=~s/^http\:\/\/([^\/]+)//;
+    $uri=~s/^\///;
+    $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
+    my $token=$1;
+    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+	&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
+        return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
+               (($uri=~/\?/)?'&':'?').'token='.$token.
+                               '&tokenissued='.$perlvar{'lonHostID'};
+    } else {
+	return '/adm/notfound.html';
+    }
 }
     
+# --------------- Take an uploaded file and put it into the userfiles directory
+# input: name of form element, coursedoc=1 means this is for the course
+# output: url of file in userspace
+
+sub userfileupload {
+    my ($formname,$coursedoc)=@_;
+    my $fname=$ENV{'form.'.$formname.'.filename'};
+# Replace Windows backslashes by forward slashes
+    $fname=~s/\\/\//g;
+# Get rid of everything but the actual filename
+    $fname=~s/^.*\/([^\/]+)$/$1/;
+# Replace spaces by underscores
+    $fname=~s/\s+/\_/g;
+# Replace all other weird characters by nothing
+    $fname=~s/[^\w\.\-]//g;
+# See if there is anything left
+    unless ($fname) { return 'error: no uploaded file'; }
+    chop($ENV{'form.'.$formname});
+# Create the directory if not present
+    my $docuname='';
+    my $docudom='';
+    my $docuhome='';
+    if ($coursedoc) {
+	$docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+	$docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+	$docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+    } else {
+        $docuname=$ENV{'user.name'};
+        $docudom=$ENV{'user.domain'};
+        $docuhome=$ENV{'user.home'};
+    }
+    return 
+        &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);
+}
+
+sub finishuserfileupload {
+    my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
+    my $path=$docudom.'/'.$docuname.'/';
+    my $filepath=$perlvar{'lonDocRoot'};
+    my @parts=split(/\//,$filepath.'/userfiles/'.$path);
+    my $count;
+    for ($count=4;$count<=$#parts;$count++) {
+        $filepath.="/$parts[$count]";
+        if ((-e $filepath)!=1) {
+	    mkdir($filepath,0777);
+        }
+    }
+# Save the file
+    {
+       my $fh=Apache::File->new('>'.$filepath.'/'.$fname);
+       print $fh $ENV{'form.'.$formname};
+    }
+# Notify homeserver to grep it
+#
+    
+    my $fetchresult= 
+ &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome);
+    if ($fetchresult eq 'ok') {
+#
+# Return the URL to it
+        return '/uploaded/'.$path.$fname;
+    } else {
+        &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname.
+         ' to host '.$docuhome.': '.$fetchresult);
+        return '/adm/notfound.html';
+    }    
+}
 
 # ------------------------------------------------------------------------- Log
 
@@ -749,7 +1050,7 @@ sub flushcourselogs {
         my $entry=$_;
         $entry=~/\_\_\_(\w+)\/(\w+)\/(.*)\_\_\_(\w+)$/;
         my %temphash=($entry => $accesshash{$entry});
-        if (&Apache::lonnet::put('resevaldata',\%temphash,$1,$2) eq 'ok') {
+        if (&Apache::lonnet::put('nohist_resevaldata',\%temphash,$1,$2) eq 'ok') {
 	    delete $accesshash{$entry};
         }
     }
@@ -794,7 +1095,7 @@ 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';
+    my $key=$$.$processmarker.'_'.$dumpcount.'___'.$url.'___count';
     if (defined($accesshash{$key})) {
 	$accesshash{$key}++;
     } else {
@@ -909,12 +1210,16 @@ sub expirespread {
 # ----------------------------------------------------- Devalidate Spreadsheets
 
 sub devalidate {
-    my $symb=shift;
+    my ($symb,$uname,$udom)=@_;
     my $cid=$ENV{'request.course.id'}; 
     if ($cid) {
-	my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
+# delete the stored spreadsheets for
+# - the student level sheet of this user in course's homespace
+# - the assessment level sheet for this resource 
+#   for this user in user's homespace
+	my $key=$uname.':'.$udom.':';
         my $status=
-	    &del('nohist_calculatedsheet',
+	    &del('nohist_calculatedsheets',
 		 [$key.'studentcalc'],
 		 $ENV{'course.'.$cid.'.domain'},
 		 $ENV{'course.'.$cid.'.num'})
@@ -923,103 +1228,201 @@ sub devalidate {
 		 [$key.'assesscalc:'.$symb]);
         unless ($status eq 'ok ok') {
            &logthis('Could not devalidate spreadsheet '.
-                    $ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.
+                    $uname.' at '.$udom.' for '.
 		    $symb.': '.$status);
         }
     }
 }
 
+sub get_scalar {
+    my ($string,$end) = @_;
+    my $value;
+    if ($$string =~ s/^([^&]*?)($end)/$2/) {
+	$value = $1;
+    } elsif ($$string =~ s/^([^&]*?)&//) {
+	$value = $1;
+    }
+    return &unescape($value);
+}
+
+sub array2str {
+  my (@array) = @_;
+  my $result=&arrayref2str(\@array);
+  $result=~s/^__ARRAY_REF__//;
+  $result=~s/__END_ARRAY_REF__$//;
+  return $result;
+}
+
 sub arrayref2str {
   my ($arrayref) = @_;
-  my $result='_ARRAY_REF__';
+  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.");
+    if(ref($elem) eq 'ARRAY') {
+      $result.=&arrayref2str($elem).'&';
+    } elsif(ref($elem) eq 'HASH') {
+      $result.=&hashref2str($elem).'&';
+    } elsif(ref($elem)) {
+      #print("Got a ref of ".(ref($elem))." skipping.");
     } else {
       $result.=&escape($elem).'&';
     }
   }
   $result=~s/\&$//;
+  $result .= '__END_ARRAY_REF__';
   return $result;
 }
 
 sub hash2str {
   my (%hash) = @_;
   my $result=&hashref2str(\%hash);
-  $result=~s/^_HASH_REF__//;
+  $result=~s/^__HASH_REF__//;
+  $result=~s/__END_HASH_REF__$//;
   return $result;
 }
 
 sub hashref2str {
   my ($hashref)=@_;
-  my $result='_HASH_REF__';
+  my $result='__HASH_REF__';
   foreach (keys(%$hashref)) {
     if (ref($_) eq 'ARRAY') {
-      $result.=&escape(&arrayref2str($_)).'=';
+      $result.=&arrayref2str($_).'=';
     } elsif (ref($_) eq 'HASH') {
-      $result.=&escape(&hashref2str($_)).'=';
+      $result.=&hashref2str($_).'=';
     } elsif (ref($_)) {
-      &logthis("Got a ref of ".(ref($_))." skipping.");
+      $result.='=';
+      #print("Got a ref of ".(ref($_))." skipping.");
     } else {
-      $result.=&escape($_).'=';
+	if ($_) {$result.=&escape($_).'=';} else { last; }
     }
 
-    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.");
+    if(ref($hashref->{$_}) eq 'ARRAY') {
+      $result.=&arrayref2str($hashref->{$_}).'&';
+    } elsif(ref($hashref->{$_}) eq 'HASH') {
+      $result.=&hashref2str($hashref->{$_}).'&';
+    } elsif(ref($hashref->{$_})) {
+       $result.='&';
+      #print("Got a ref of ".(ref($hashref->{$_}))." skipping.");
     } else {
-      $result.=&escape($$hashref{$_}).'&';
+      $result.=&escape($hashref->{$_}).'&';
     }
   }
   $result=~s/\&$//;
+  $result .= '__END_HASH_REF__';
   return $result;
 }
 
 sub str2hash {
+    my ($string)=@_;
+    my ($hash)=&str2hashref('__HASH_REF__'.$string.'__END_HASH_REF__');
+    return %$hash;
+}
+
+sub str2hashref {
   my ($string) = @_;
-  my %returnhash;
-  foreach (split(/\&/,$string)) {
-    my ($name,$value)=split(/\=/,$_);
-    $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;
+
+  my %hash;
+
+  if($string !~ /^__HASH_REF__/) {
+      if (! ($string eq '' || !defined($string))) {
+	  $hash{'error'}='Not hash reference';
+      }
+      return (\%hash, $string);
   }
-  return (%returnhash);
+
+  $string =~ s/^__HASH_REF__//;
+
+  while($string !~ /^__END_HASH_REF__/) {
+      #key
+      my $key='';
+      if($string =~ /^__HASH_REF__/) {
+          ($key, $string)=&str2hashref($string);
+          if(defined($key->{'error'})) {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($key, $string)=&str2arrayref($string);
+          if($key->[0] eq 'Array reference error') {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } else {
+          $string =~ s/^(.*?)=//;
+	  $key=&unescape($1);
+      }
+      $string =~ s/^=//;
+
+      #value
+      my $value='';
+      if($string =~ /^__HASH_REF__/) {
+          ($value, $string)=&str2hashref($string);
+          if(defined($value->{'error'})) {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($value, $string)=&str2arrayref($string);
+          if($value->[0] eq 'Array reference error') {
+              $hash{'error'}='Bad data';
+              return (\%hash, $string);
+          }
+      } else {
+	  $value=&get_scalar(\$string,'__END_HASH_REF__');
+      }
+      $string =~ s/^&//;
+
+      $hash{$key}=$value;
+  }
+
+  $string =~ s/^__END_HASH_REF__//;
+
+  return (\%hash, $string);
 }
 
 sub str2array {
+    my ($string)=@_;
+    my ($array)=&str2arrayref('__ARRAY_REF__'.$string.'__END_ARRAY_REF__');
+    return @$array;
+}
+
+sub str2arrayref {
   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);
+  my @array;
+
+  if($string !~ /^__ARRAY_REF__/) {
+      if (! ($string eq '' || !defined($string))) {
+	  $array[0]='Array reference error';
+      }
+      return (\@array, $string);
+  }
+
+  $string =~ s/^__ARRAY_REF__//;
+
+  while($string !~ /^__END_ARRAY_REF__/) {
+      my $value='';
+      if($string =~ /^__HASH_REF__/) {
+          ($value, $string)=&str2hashref($string);
+          if(defined($value->{'error'})) {
+              $array[0] ='Array reference error';
+              return (\@array, $string);
+          }
+      } elsif($string =~ /^__ARRAY_REF__/) {
+          ($value, $string)=&str2arrayref($string);
+          if($value->[0] eq 'Array reference error') {
+              $array[0] ='Array reference error';
+              return (\@array, $string);
+          }
+      } else {
+	  $value=&get_scalar(\$string,'__END_ARRAY_REF__');
+      }
+      $string =~ s/^&//;
+
+      push(@array, $value);
   }
-  return (@returnarray);
+
+  $string =~ s/^__END_ARRAY_REF__//;
+
+  return (\@array, $string);
 }
 
 # -------------------------------------------------------------------Temp Store
@@ -1043,7 +1446,7 @@ sub tmpreset {
   my %hash;
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
-	  &GDBM_WRCREAT,0640)) {
+	  &GDBM_WRCREAT(),0640)) {
     foreach my $key (keys %hash) {
       if ($key=~ /:$symb/) {
 	delete($hash{$key});
@@ -1079,7 +1482,7 @@ sub tmpstore {
   my $path=$perlvar{'lonDaemons'}.'/tmp';
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
-	  &GDBM_WRCREAT,0640)) {
+	  &GDBM_WRCREAT(),0640)) {
     $hash{"version:$symb"}++;
     my $version=$hash{"version:$symb"};
     my $allkeys=''; 
@@ -1123,7 +1526,7 @@ sub tmprestore {
   my $path=$perlvar{'lonDaemons'}.'/tmp';
   if (tie(%hash,'GDBM_File',
 	  $path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
-	  &GDBM_READER,0640)) {
+	  &GDBM_READER(),0640)) {
     my $version=$hash{"version:$symb"};
     $returnhash{'version'}=$version;
     my $scope;
@@ -1157,7 +1560,10 @@ sub store {
     $symb=&symbclean($symb);
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }
 
-    &devalidate($symb);
+    if (!$domain) { $domain=$ENV{'user.domain'}; }
+    if (!$stuname) { $stuname=$ENV{'user.name'}; }
+
+    &devalidate($symb,$stuname,$domain);
 
     $symb=escape($symb);
     if (!$namespace) { 
@@ -1165,8 +1571,6 @@ sub store {
           return ''; 
        } 
     }
-    if (!$domain) { $domain=$ENV{'user.domain'}; }
-    if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }
     my $namevalue='';
     foreach (keys %$storehash) {
@@ -1188,7 +1592,10 @@ sub cstore {
     $symb=&symbclean($symb);
     if (!$symb) { unless ($symb=&symbread()) { return ''; } }
 
-    &devalidate($symb);
+    if (!$domain) { $domain=$ENV{'user.domain'}; }
+    if (!$stuname) { $stuname=$ENV{'user.name'}; }
+
+    &devalidate($symb,$stuname,$domain);
 
     $symb=escape($symb);
     if (!$namespace) { 
@@ -1196,8 +1603,6 @@ sub cstore {
           return ''; 
        } 
     }
-    if (!$domain) { $domain=$ENV{'user.domain'}; }
-    if (!$stuname) { $stuname=$ENV{'user.name'}; }
     if (!$home) { $home=$ENV{'user.home'}; }
 
     my $namevalue='';
@@ -1255,29 +1660,31 @@ sub coursedescription {
     $courseid=~s/\_/\//g;
     my ($cdomain,$cnum)=split(/\//,$courseid);
     my $chome=&homeserver($cnum,$cdomain);
+    my $normalid=$cdomain.'_'.$cnum;
+    # need to always cache even if we get errors otherwise we keep 
+    # trying and trying and trying to get the course description.
+    my %envhash=();
+    my %returnhash=();
+    $envhash{'course.'.$normalid.'.last_cache'}=time;
     if ($chome ne 'no_host') {
-       my %returnhash=&dump('environment',$cdomain,$cnum);
+       %returnhash=&dump('environment',$cdomain,$cnum);
        if (!exists($returnhash{'con_lost'})) {
-           my $normalid=$cdomain.'_'.$cnum;
-           my %envhash=();
            $returnhash{'home'}= $chome;
 	   $returnhash{'domain'} = $cdomain;
 	   $returnhash{'num'} = $cnum;
            while (my ($name,$value) = each %returnhash) {
                $envhash{'course.'.$normalid.'.'.$name}=$value;
            }
-           $returnhash{'url'}='/res/'.declutter($returnhash{'url'});
+           $returnhash{'url'}=&clutter($returnhash{'url'});
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
 	       $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
-           $envhash{'course.'.$normalid.'.last_cache'}=time;
            $envhash{'course.'.$normalid.'.home'}=$chome;
            $envhash{'course.'.$normalid.'.domain'}=$cdomain;
            $envhash{'course.'.$normalid.'.num'}=$cnum;
-           &appenv(%envhash);
-           return %returnhash;
        }
     }
-    return ();
+    &appenv(%envhash);
+    return %returnhash;
 }
 
 # -------------------------------------------------------- Get user privileges
@@ -1394,6 +1801,9 @@ sub get {
 
    my $rep=&reply("get:$udomain:$uname:$namespace:$items",$uhome);
    my @pairs=split(/\&/,$rep);
+   if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
+     return @pairs;
+   }
    my %returnhash=();
    my $i=0;
    foreach (@$storearr) {
@@ -1441,6 +1851,58 @@ sub dump {
    return %returnhash;
 }
 
+# --------------------------------------------------------------- currentdump
+sub currentdump {
+   my ($courseid,$sdom,$sname)=@_;
+   $courseid = $ENV{'request.course.id'} if (! defined($courseid));
+   $sdom     = $ENV{'user.domain'}       if (! defined($sdom));
+   $sname    = $ENV{'user.name'}         if (! defined($sname));
+   my $uhome = &homeserver($sname,$sdom);
+   my $rep=reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome);
+   return if ($rep =~ /^(error:|no_such_host)/);
+   #
+   my %returnhash=();
+   #
+   if ($rep eq "unknown_cmd") { 
+       # an old lond will not know currentdump
+       # Do a dump and make it look like a currentdump
+       my @tmp = &dump($courseid,$sdom,$sname,'.');
+       return if ($tmp[0] =~ /^(error:|no_such_host)/);
+       my %hash = @tmp;
+       @tmp=();
+       # Code ripped from lond, essentially.  The only difference
+       # here is the unescaping done by lonnet::dump().  Conceivably
+       # we might run in to problems with parameter names =~ /^v\./
+       while (my ($key,$value) = each(%hash)) {
+           my ($v,$symb,$param) = split(/:/,$key);
+           next if ($v eq 'version' || $symb eq 'keys');
+           next if (exists($returnhash{$symb}) &&
+                    exists($returnhash{$symb}->{$param}) &&
+                    $returnhash{$symb}->{'v.'.$param} > $v);
+           $returnhash{$symb}->{$param}=$value;
+           $returnhash{$symb}->{'v.'.$param}=$v;
+       }
+       #
+       # Remove all of the keys in the hashes which keep track of
+       # the version of the parameter.
+       while (my ($symb,$param_hash) = each(%returnhash)) {
+           # use a foreach because we are going to delete from the hash.
+           foreach my $key (keys(%$param_hash)) {
+               delete($param_hash->{$key}) if ($key =~ /^v\./);
+           }
+       }
+   } else {
+       my @pairs=split(/\&/,$rep);
+       foreach (@pairs) {
+           my ($key,$value)=split(/=/,$_);
+           my ($symb,$param) = split(/:/,$key);
+           $returnhash{&unescape($symb)}->{&unescape($param)} = 
+                                                          &unescape($value);
+       }
+   }
+   return %returnhash;
+}
+
 # --------------------------------------------------------------- put interface
 
 sub put {
@@ -1494,6 +1956,37 @@ sub eget {
    return %returnhash;
 }
 
+# ---------------------------------------------- Custom access rule evaluation
+
+sub customaccess {
+    my ($priv,$uri)=@_;
+    my ($urole,$urealm)=split(/\./,$ENV{'request.role'});
+    $urealm=~s/^\W//;
+    my ($udom,$ucrs,$usec)=split(/\//,$urealm);
+    my $access=0;
+    foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
+	my ($effect,$realm,$role)=split(/\:/,$_);
+        if ($role) {
+	   if ($role ne $urole) { next; }
+        }
+        foreach (split(/\s*\,\s*/,$realm)) {
+            my ($tdom,$tcrs,$tsec)=split(/\_/,$_);
+            if ($tdom) {
+		if ($tdom ne $udom) { next; }
+            }
+            if ($tcrs) {
+		if ($tcrs ne $ucrs) { next; }
+            }
+            if ($tsec) {
+		if ($tsec ne $usec) { next; }
+            }
+            $access=($effect eq 'allow');
+            last;
+        }
+    }
+    return $access;
+}
+
 # ------------------------------------------------- Check for a user privilege
 
 sub allowed {
@@ -1512,7 +2005,9 @@ sub allowed {
 
     if ($priv eq 'bre') {
         my $copyright=&metadata($uri,'copyright');
-	if ($copyright eq 'public') { return 'F'; }
+	if (($copyright eq 'public') && (!$ENV{'request.course.id'})) { 
+           return 'F'; 
+        }
         if ($copyright eq 'priv') {
             $uri=~/([^\/]+)\/([^\/]+)\//;
 	    unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) {
@@ -1526,6 +2021,20 @@ sub allowed {
 		return '';
             }
         }
+        if ($ENV{'request.role'}=~ /li\.\//) {
+            # Library role, so allow browsing of resources in this domain.
+            return 'F';
+        }
+        if ($copyright eq 'custom') {
+	    unless (&customaccess($priv,$uri)) { return ''; }
+        }
+    }
+    # Domain coordinator is trying to create a course
+    if (($priv eq 'ccc') && ($ENV{'request.role'} =~ /^dc\./)) {
+        # uri is the requested domain in this case.
+        # comparison to 'request.role.domain' shows if the user has selected
+        # a role of dc for the domain in question. 
+        return 'F' if ($uri eq $ENV{'request.role.domain'});
     }
 
     my $thisallowed='';
@@ -1555,6 +2064,12 @@ sub allowed {
        $thisallowed.=$1;
     }
 
+# URI is an uploaded document for this course
+
+    if (($priv eq 'bre') && 
+        ($uri=~/^uploaded\/$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}\/$ENV{'course.'.$ENV{'request.course.id'}.'.num'}/)) {
+        return 'F';
+    }
 # Full access at system, domain or course-wide level? Exit.
 
     if ($thisallowed=~/F/) {
@@ -1730,20 +2245,10 @@ sub allowed {
 
    if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
-       my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
-       if (-e $filename) {
-           my @content;
-           {
-	     my $fh=Apache::File->new($filename);
-             @content=<$fh>;
-	   }
-           if (join('',@content)=~
-                    /\<roledeny[^\>]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) {
-	       &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
+       if (&metadata($uri,'roledeny')=~/$rolecode/) {
+	  &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
                     'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
-           return '';
-
-           }
+          return '';
        }
    }
 
@@ -1773,14 +2278,16 @@ sub is_on_map {
     my @uriparts=split(/\//,$uri);
     my $filename=$uriparts[$#uriparts];
     my $pathname=$uri;
-    $pathname=~s/\/$filename$//;
+    $pathname=~s|/\Q$filename\E$||;
+    $pathname=~s/^adm\/wrapper\///;    
+    #Trying to find the conditional for the file
     my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
-	       /\&$filename\:([\d\|]+)\&/);
+	       /\&\Q$filename\E\:([\d\|]+)\&/);
     if ($match) {
-       return (1,$1);
-   } else {
-       return (0,0);
-   }
+	return (1,$1);
+    } else {
+	return (0,0);
+    }
 }
 
 # ----------------------------------------------------------------- Define Role
@@ -1957,7 +2464,8 @@ sub modifyuserauth {
     my $uhome=&homeserver($uname,$udom);
     unless (&allowed('mau',$udom)) { return 'refused'; }
     &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
-             $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});  
+             $umode.' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+             ' in domain '.$ENV{'request.role.domain'});  
     my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
 		     &escape($upass),$uhome);
     &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.home'},
@@ -1988,7 +2496,8 @@ sub modifyuser {
 	     $last.', '.$gene.'(forceid: '.$forceid.')'.
              (defined($desiredhome) ? ' desiredhome = '.$desiredhome :
                                      ' desiredhome not specified'). 
-             ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
+             ' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
+             ' in domain '.$ENV{'request.role.domain'});
     my $uhome=&homeserver($uname,$udom,'true');
 # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') && ($umode) && ($upass)) {
@@ -2038,10 +2547,15 @@ sub modifyuser {
        }
     }
 # -------------------------------------------------------------- Add names, etc
-    my %names=&get('environment',
+    my @tmp=&get('environment',
 		   ['firstname','middlename','lastname','generation'],
 		   $udom,$uname);
-    if ($names{'firstname'} =~ m/^error:.*/) { %names=(); }
+    my %names;
+    if ($tmp[0] =~ m/^error:.*/) { 
+        %names=(); 
+    } else {
+        %names = @tmp;
+    }
     if ($first)  { $names{'firstname'}  = $first; }
     if ($middle) { $names{'middlename'} = $middle; }
     if ($last)   { $names{'lastname'}   = $last; }
@@ -2069,20 +2583,59 @@ sub modifystudent {
 	($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$forceid,
          $desiredhome);
     unless ($reply eq 'ok') { return $reply; }
+    # This will cause &modify_student_enrollment to get the uid from the
+    # students environment
+    $uid = undef if (!$forceid);
+    $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,
+                                        $last,$gene,$usec,$end,$start);
+    return $reply;
+}
+
+sub modify_student_enrollment {
+    my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start) = @_;
+    # Get the course id from the environment
+    my $cid='';
+    unless ($cid=$ENV{'request.course.id'}) {
+	return 'not_in_class';
+    }
+    # Make sure the user exists
     my $uhome=&homeserver($uname,$udom);
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such user';
     }
-# -------------------------------------------------- Add student to course list
-    $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+    #
+    # Get student data if we were not given enough information
+    if (!defined($first)  || $first  eq '' || 
+        !defined($last)   || $last   eq '' || 
+        !defined($uid)    || $uid    eq '' || 
+        !defined($middle) || $middle eq '' || 
+        !defined($gene)   || $gene   eq '') {
+        # They did not supply us with enough data to enroll the student, so
+        # we need to pick up more information.
+        my %tmp = &get('environment',
+                       ['firstname','middlename','lastname', 'generation','id']
+                       ,$udom,$uname);
+
+        foreach (keys(%tmp)) {
+            &logthis("key $_ = ".$tmp{$_});
+        }
+        $first  = $tmp{'firstname'}  if (!defined($first)  || $first  eq '');
+        $middle = $tmp{'middlename'} if (!defined($middle) || $middle eq '');
+        $last   = $tmp{'lastname'}   if (!defined($last)   || $last eq '');
+        $gene   = $tmp{'generation'} if (!defined($gene)   || $gene eq '');
+        $uid    = $tmp{'id'}         if (!defined($uid)    || $uid  eq '');
+    }
+    my $fullname = &Apache::loncoursedata::ProcessFullName($last,$gene,
+                                                           $first,$middle);
+    my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
 	              $ENV{'course.'.$cid.'.num'}.':classlist:'.
                       &escape($uname.':'.$udom).'='.
-                      &escape($end.':'.$start),
+                      &escape(join(':',$end,$start,$uid,$usec,$fullname)),
 	              $ENV{'course.'.$cid.'.home'});
     unless (($reply eq 'ok') || ($reply eq 'delayed')) {
 	return 'error: '.$reply;
     }
-# ---------------------------------------------------- Add student role to user
+    # Add student role to user
     my $uurl='/'.$cid;
     $uurl=~s/\_/\//g;
     if ($usec) {
@@ -2113,13 +2666,10 @@ sub writecoursepref {
 # ---------------------------------------------------------- Make/modify course
 
 sub createcourse {
-    my ($udom,$description,$url)=@_;
+    my ($udom,$description,$url,$course_server,$nonstandard)=@_;
     $url=&declutter($url);
     my $cid='';
-    unless (&allowed('ccc',$ENV{'user.domain'})) {
-        return 'refused';
-    }
-    unless ($udom eq $ENV{'user.domain'}) {
+    unless (&allowed('ccc',$udom)) {
         return 'refused';
     }
 # ------------------------------------------------------------------- Create ID
@@ -2135,17 +2685,42 @@ sub createcourse {
            return 'error: unable to generate unique course-ID';
        } 
    }
+# ------------------------------------------------ Check supplied server name
+    $course_server = $ENV{'user.homeserver'} if (! defined($course_server));
+    if (! exists($libserv{$course_server})) {
+        return 'error:bad server name '.$course_server;
+    }
 # ------------------------------------------------------------- Make the course
     my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
-                      $ENV{'user.home'});
+                      $course_server);
     unless ($reply eq 'ok') { return 'error: '.$reply; }
     $uhome=&homeserver($uname,$udom,'true');
     if (($uhome eq '') || ($uhome eq 'no_host')) { 
 	return 'error: no such course';
     }
+# ----------------------------------------------------------------- Course made
+    my $topurl=$url;
+    unless ($nonstandard) {
+# ------------------------------------------ For standard courses, make top url
+        my $mapurl=&clutter($url);
+        if ($mapurl eq '/res/') { $mapurl=''; }
+        $ENV{'form.initmap'}=(<<ENDINITMAP);
+<map>
+<resource id="1" type="start"></resource>
+<resource id="2" src="$mapurl"></resource>
+<resource id="3" type="finish"></resource>
+<link index="1" from="1" to="2"></link>
+<link index="2" from="2" to="3"></link>
+</map>
+ENDINITMAP
+        $topurl=&declutter(
+        &finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')
+                          );
+    }
+# ----------------------------------------------------------- Write preferences
     &writecoursepref($udom.'_'.$uname,
                      ('description' => $description,
-                      'url'         => $url));
+                      'url'         => $topurl));
     return '/'.$udom.'/'.$uname;
 }
 
@@ -2246,6 +2821,30 @@ sub dirlist {
     }
 }
 
+# --------------------------------------------- GetFileTimestamp
+# This function utilizes dirlist and returns the date stamp for
+# when it was last modified.  It will also return an error of -1
+# if an error occurs
+
+sub GetFileTimestamp {
+    my ($studentDomain,$studentName,$filename,$root)=@_;
+    $studentDomain=~s/\W//g;
+    $studentName=~s/\W//g;
+    my $subdir=$studentName.'__';
+    $subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
+    my $proname="$studentDomain/$subdir/$studentName";
+    $proname .= '/'.$filename;
+    my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
+                                       $root);
+    my $fileStat = $dir[0];
+    my @stats = split('&', $fileStat);
+    if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
+        return $stats[9];
+    } else {
+        return -1;
+    }
+}
+
 # -------------------------------------------------------- Value of a Condition
 
 sub directcondval {
@@ -2298,6 +2897,14 @@ sub condval {
     return $result;
 }
 
+# ---------------------------------------------------- Devalidate courseresdata
+
+sub devalidatecourseresdata {
+    my ($coursenum,$coursedomain)=@_;
+    my $hashid=$coursenum.':'.$coursedomain;
+    delete $courseresdatacache{$hashid.'.time'};
+}
+
 # --------------------------------------------------- Course Resourcedata Query
 
 sub courseresdata {
@@ -2316,23 +2923,24 @@ sub courseresdata {
 	if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
 	    $courseresdatacache{$hashid.'.time'}=time;
 	    $courseresdatacache{$hashid}=\%dumpreply;
+	} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
+	    return $tmp;
 	}
     }
     foreach my $item (@which) {
-	if ($courseresdatacache{$hashid}->{$item}) {
+	if (defined($courseresdatacache{$hashid}->{$item})) {
 	    return $courseresdatacache{$hashid}->{$item};
 	}
     }
-    return '';
+    return undef;
 }
 
 # --------------------------------------------------------- Value of a Variable
 
 sub EXT {
-    my ($varname,$symbparm,$udom,$uname)=@_;
+    my ($varname,$symbparm,$udom,$uname,)=@_;
 
     unless ($varname) { return ''; }
-
     #get real user name/domain, courseid and symb
     my $courseid;
     if (!($uname && $udom)) {
@@ -2341,14 +2949,14 @@ sub EXT {
     } else {
 	$courseid=$ENV{'request.course.id'};
     }
-
     my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
     my $rest;
-    if ($therest[0]) {
+    if (defined($therest[0])) {
        $rest=join('.',@therest);
     } else {
        $rest='';
     }
+
     my $qualifierrest=$qualifier;
     if ($rest) { $qualifierrest.='.'.$rest; }
     my $spacequalifierrest=$space;
@@ -2356,8 +2964,12 @@ sub EXT {
     if ($realm eq 'user') {
 # --------------------------------------------------------------- user.resource
 	if ($space eq 'resource') {
-	    my %restored=&restore(undef,undef,$udom,$uname);
-            return $restored{$qualifierrest};
+	    if (defined($Apache::lonhomework::parsing_a_problem)) {
+		return $Apache::lonhomework::history{$qualifierrest};
+	    } else {
+		my %restored=&restore($symbparm,$courseid,$udom,$uname);
+		return $restored{$qualifierrest};
+	    }
 # ----------------------------------------------------------------- user.access
         } elsif ($space eq 'access') {
 	    # FIXME - not supporting calls for a specific user
@@ -2392,9 +3004,8 @@ sub EXT {
             return $uname;
 # ---------------------------------------------------- Any other user namespace
         } else {
-            my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
-            my %reply=&get($space,[$item]);
-            return $reply{$item};
+            my %reply=&get($space,[$qualifierrest],$udom,$uname);
+            return $reply{$qualifierrest};
         }
     } elsif ($realm eq 'query') {
 # ---------------------------------------------- pull stuff out of query string
@@ -2442,24 +3053,35 @@ sub EXT {
 	    my $courselevelm=$courseid.'.'.$mapparm;
 
 # ----------------------------------------------------------- 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>");
+	    #most student don't have any data set, check if there is some data
+            #every thirty minutes
+	    if (!
+		(exists($ENV{'cache.studentresdata'})
+		    && (($ENV{'cache.studentresdata'}+1800) > time))) {
+		my %resourcedata=&get('resourcedata',
+				      [$courselevelr,$courselevelm,$courselevel],
+				      $udom,$uname);
+		my ($tmp)=keys(%resourcedata);
+		if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
+		    if ($resourcedata{$courselevelr}) {
+			return $resourcedata{$courselevelr}; }
+		    if ($resourcedata{$courselevelm}) {
+			return $resourcedata{$courselevelm}; }
+		    if ($resourcedata{$courselevel}) {
+			return $resourcedata{$courselevel}; }
+		} else {
+		    if ($tmp!~/No such file/) {
+			&logthis("<font color=blue>WARNING:".
+				 " Trying to get resource data for ".
+				 $uname." at ".$udom.": ".
+				 $tmp."</font>");
+		    } elsif ($tmp=~/error:No such file/) {
+			$ENV{'cache.studentresdata'}=time;
+			&appenv(('cache.studentresdata'=>
+				 $ENV{'cache.studentresdata'}));
+		    } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
+			return $tmp;
+		    }
 		}
 	    }
 
@@ -2470,14 +3092,14 @@ sub EXT {
 					  ($seclevelr,$seclevelm,$seclevel,
 					   $courselevelr,$courselevelm,
 					   $courselevel));
-	    if ($coursereply) { return $coursereply; }
+	    if (defined($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)) {
+		    &GDBM_READER(),0640)) {
 		$thisparm=$parmhash{$symbparm};
 		untie(%parmhash);
 	    }
@@ -2486,24 +3108,27 @@ sub EXT {
 # --------------------------------------------- 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; }
+	my $filename;
+	if (!$symbparm) { $symbparm=&symbread(); }
+	if ($symbparm) {
+	    $filename=(split(/\_\_\_/,$symbparm))[2];
+	} else {
+	    $filename=$ENV{'request.filename'};
+	}
+	my $metadata=&metadata($filename,$spacequalifierrest);
+	if (defined($metadata)) { return $metadata; }
+	$metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
+	if (defined($metadata)) { return $metadata; }
 
 # ------------------------------------------------------------------ Cascade up
 	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; }
-	    }
+	    my @parts=split(/_/,$space);
+	    my $id=pop(@parts);
+	    my $part=join('_',@parts);
+	    if ($part eq '') { $part='0'; }
+	    my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
+				 $symbparm,$udom,$uname);
+	    if (defined($partgeneral)) { return $partgeneral; }
 	}
 
 # ---------------------------------------------------- Any other user namespace
@@ -2525,12 +3150,33 @@ sub EXT {
     return '';
 }
 
+sub add_prefix_and_part {
+    my ($prefix,$part)=@_;
+    my $keyroot;
+    if (defined($prefix) && $prefix !~ /^__/) {
+	# prefix that has a part already
+	$keyroot=$prefix;
+    } elsif (defined($prefix)) {
+	# prefix that is missing a part
+	if (defined($part)) { $keyroot='_'.$part.substr($prefix,1); }
+    } else {
+	# no prefix at all
+	if (defined($part)) { $keyroot='_'.$part; }
+    }
+    return $keyroot;
+}
+
 # ---------------------------------------------------------------- Get metadata
 
 sub metadata {
     my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
 
     $uri=&declutter($uri);
+    # if it is a non metadata possible uri return quickly
+    if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
+        ($uri =~ m|/$|) || ($uri =~ m|/.meta$|)) {
+	return '';
+    }
     my $filename=$uri;
     $uri=~s/\.meta$//;
 #
@@ -2538,7 +3184,7 @@ sub metadata {
 # Look at timestamp of caching
 # Everything is cached by the main uri, libraries are never directly cached
 #
-    unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600) {
+    unless (abs($metacache{$uri.':cachedtimestamp'}-time)<600 && !defined($liburi)) {
 #
 # Is this a recursive call for a library?
 #
@@ -2548,114 +3194,189 @@ sub metadata {
         }
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
-	my $metastring=&getfile($perlvar{'lonDocRoot'}.'/res/'.$filename);
+	my $metastring=&getfile(&filelocation('',&clutter($filename)));
         my $parser=HTML::LCParser->new(\$metastring);
         my $token;
         undef %metathesekeys;
         while ($token=$parser->get_token) {
-           if ($token->[0] eq 'S') {
-	     if (defined($token->[2]->{'package'})) {
+	    if ($token->[0] eq 'S') {
+		if (defined($token->[2]->{'package'})) {
 #
 # This is a package - get package info
 #
-	      my $package=$token->[2]->{'package'};
-	      my $keyroot='';
-              if ($prefix) {
-		  $keyroot.='_'.$prefix;
-              } else {
-                if (defined($token->[2]->{'part'})) { 
-                   $keyroot.='_'.$token->[2]->{'part'}; 
-	        }
-	      }
-              if (defined($token->[2]->{'id'})) { 
-                 $keyroot.='_'.$token->[2]->{'id'}; 
-	      }
-              if ($metacache{$uri.':packages'}) {
-                 $metacache{$uri.':packages'}.=','.$package.$keyroot;
-              } else {
-                 $metacache{$uri.':packages'}=$package.$keyroot;
-	      }
-              foreach (keys %packagetab) {
-		  if ($_=~/^$package\&/) {
-		      my ($pack,$name,$subp)=split(/\&/,$_);
-                      my $value=$packagetab{$_};
-		      my $part=$keyroot;
-                      $part=~s/^\_//;
-                      if ($subp eq 'display') {
-			  $value.=' [Part: '.$part.']';
-                      }
-                      my $unikey='parameter'.$keyroot.'_'.$name;
-                      $metathesekeys{$unikey}=1;
-                      $metacache{$uri.':'.$unikey.'.part'}=$part;
-                      unless 
-                       (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
-                         $metacache{$uri.':'.$unikey.'.'.$subp}=$value;
-		      }
-                  }
-              }
-             } else {
+		    my $package=$token->[2]->{'package'};
+		    my $keyroot=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+		    if (defined($token->[2]->{'id'})) { 
+			$keyroot.='_'.$token->[2]->{'id'}; 
+		    }
+		    if ($metacache{$uri.':packages'}) {
+			$metacache{$uri.':packages'}.=','.$package.$keyroot;
+		    } else {
+			$metacache{$uri.':packages'}=$package.$keyroot;
+		    }
+		    foreach (keys %packagetab) {
+			if ($_=~/^$package\&/) {
+			    my ($pack,$name,$subp)=split(/\&/,$_);
+			    my $value=$packagetab{$_};
+			    my $part=$keyroot;
+			    $part=~s/^\_//;
+			    if ($subp eq 'display') {
+				$value.=' [Part: '.$part.']';
+			    }
+			    my $unikey='parameter'.$keyroot.'_'.$name;
+			    if ($subp eq 'default') { $unikey='parameter_0_'.$name; }
+			    $metathesekeys{$unikey}=1;
+			    $metacache{$uri.':'.$unikey.'.part'}=$part;
+			    unless (defined($metacache{$uri.':'.$unikey.'.'.$subp})) {
+				$metacache{$uri.':'.$unikey.'.'.$subp}=$value;
+			    }
+			    if (defined($metacache{$uri.':'.$unikey.'.default'})) {
+				$metacache{$uri.':'.$unikey}=
+				    $metacache{$uri.':'.$unikey.'.default'}
+				}
+			}
+		    }
+		} else {
 #
 # This is not a package - some other kind of start tag
-# 
-              my $entry=$token->[1];
-              my $unikey;
-              if ($entry eq 'import') {
-                 $unikey='';
-              } else {
-                 $unikey=$entry;
-	      }
-              if ($prefix) {
-		  $unikey.=$prefix;
-              } else {
-                if (defined($token->[2]->{'part'})) { 
-                   $unikey.='_'.$token->[2]->{'part'}; 
-	        }
-	      }
-              if (defined($token->[2]->{'id'})) { 
-                 $unikey.='_'.$token->[2]->{'id'}; 
-	      }
+#
+		    my $entry=$token->[1];
+		    my $unikey;
+		    if ($entry eq 'import') {
+			$unikey='';
+		    } else {
+			$unikey=$entry;
+		    }
+		    $unikey.=&add_prefix_and_part($prefix,$token->[2]->{'part'});
+
+		    if (defined($token->[2]->{'id'})) { 
+			$unikey.='_'.$token->[2]->{'id'}; 
+		    }
 
-             if ($entry eq 'import') {
+		    if ($entry eq 'import') {
 #
 # Importing a library here
-#                
-		 if (defined($depthcount)) { $depthcount++; } else 
-                                           { $depthcount=0; }
-                 if ($depthcount<20) {
-		     foreach (split(/\,/,&metadata($uri,'keys',
-                                  $parser->get_text('/import'),$unikey,
-                                  $depthcount))) {
-                         $metathesekeys{$_}=1;
-		     }
-		 }
-             } else { 
-
-              if (defined($token->[2]->{'name'})) { 
-                 $unikey.='_'.$token->[2]->{'name'}; 
-	      }
-              $metathesekeys{$unikey}=1;
-              foreach (@{$token->[3]}) {
-		  $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
-              }
-              unless (
-                 $metacache{$uri.':'.$unikey}=&HTML::Entities::decode($parser->get_text('/'.$entry))
-		      ) { $metacache{$uri.':'.$unikey}=
-			      $metacache{$uri.':'.$unikey.'.default'};
-		      }
+#
+			if ($depthcount<20) {
+			    my $location=$parser->get_text('/import');
+			    my $dir=$filename;
+			    $dir=~s|[^/]*$||;
+			    $location=&filelocation($dir,$location);
+			    foreach (sort(split(/\,/,&metadata($uri,'keys',
+							       $location,$unikey,
+							       $depthcount+1)))) {
+				$metathesekeys{$_}=1;
+			    }
+			}
+		    } else { 
+			
+			if (defined($token->[2]->{'name'})) { 
+			    $unikey.='_'.$token->[2]->{'name'}; 
+			}
+			$metathesekeys{$unikey}=1;
+			foreach (@{$token->[3]}) {
+			    $metacache{$uri.':'.$unikey.'.'.$_}=$token->[2]->{$_};
+			}
+			my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
+			my $default=$metacache{$uri.':'.$unikey.'.default'};
+			if ( $internaltext =~ /^\s*$/ && $default !~ /^\s*$/) {
+		 # only ws inside the tag, and not in default, so use default
+		 # as value
+			    $metacache{$uri.':'.$unikey}=$default;
+			} else {
+		  # either something interesting inside the tag or default
+                  # uninteresting
+			    $metacache{$uri.':'.$unikey}=$internaltext;
+			}
 # end of not-a-package not-a-library import
-	   }
+		    }
 # end of not-a-package start tag
-	  }
+		}
 # the next is the end of "start tag"
-	 }
-       }
-       $metacache{$uri.':keys'}=join(',',keys %metathesekeys);
-       $metacache{$uri.':cachedtimestamp'}=time;
+	    }
+	}
+# are there custom rights to evaluate
+	if ($metacache{$uri.':copyright'} eq 'custom') {
+
+    #
+    # Importing a rights file here
+    #
+	    unless ($depthcount) {
+		my $location=$metacache{$uri.':customdistributionfile'};
+		my $dir=$filename;
+		$dir=~s|[^/]*$||;
+		$location=&filelocation($dir,$location);
+		foreach (sort(split(/\,/,&metadata($uri,'keys',
+						   $location,'_rights',
+						   $depthcount+1)))) {
+		    $metathesekeys{$_}=1;
+		}
+	    }
+	}
+	$metacache{$uri.':keys'}=join(',',keys %metathesekeys);
+	&metadata_generate_part0(\%metathesekeys,\%metacache,$uri);
+	$metacache{$uri.':allpossiblekeys'}=join(',',keys %metathesekeys);
+	$metacache{$uri.':cachedtimestamp'}=time;
 # this is the end of "was not already recently cached
     }
     return $metacache{$uri.':'.$what};
 }
 
+sub metadata_generate_part0 {
+    my ($metadata,$metacache,$uri) = @_;
+    my %allnames;
+    foreach my $metakey (sort keys %$metadata) {
+	if ($metakey=~/^parameter\_(.*)/) {
+	  my $part=$$metacache{$uri.':'.$metakey.'.part'};
+	  my $name=$$metacache{$uri.':'.$metakey.'.name'};
+	  if (! exists($$metadata{'parameter_0_'.$name})) {
+	    $allnames{$name}=$part;
+	  }
+	}
+    }
+    foreach my $name (keys(%allnames)) {
+      $$metadata{"parameter_0_$name"}=1;
+      my $key="$uri:parameter_0_$name";
+      $$metacache{"$key.part"}='0';
+      $$metacache{"$key.name"}=$name;
+      $$metacache{"$key.type"}=$$metacache{$uri.':parameter_'.
+					   $allnames{$name}.'_'.$name.
+					   '.type'};
+      my $olddis=$$metacache{$uri.':parameter_'.$allnames{$name}.'_'.$name.
+			     '.display'};
+      my $expr='\\[Part: '.$allnames{$name}.'\\]';
+      $olddis=~s/$expr/\[Part: 0\]/;
+      $$metacache{"$key.display"}=$olddis;
+    }
+}
+
+# ------------------------------------------------- Get the title of a resource
+
+sub gettitle {
+    my $urlsymb=shift;
+    my $symb=&symbread($urlsymb);
+    unless ($symb) {
+	unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
+        return &metadata($urlsymb,'title'); 
+    }
+    if ($titlecache{$symb}) { return $titlecache{$symb}; }
+    my ($map,$resid,$url)=split(/\_\_\_/,$symb);
+    my $title='';
+    my %bighash;
+    if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+                            &GDBM_READER(),0640)) {
+        my $mapid=$bighash{'map_pc_'.&clutter($map)};
+        $title=$bighash{'title_'.$mapid.'.'.$resid};
+        untie %bighash;
+    }
+    if ($title) {
+        $titlecache{$symb}=$title;
+        return $title;
+    } else {
+	return &metadata($urlsymb,'title');
+    }
+}
+    
 # ------------------------------------------------- Update symbolic store links
 
 sub symblist {
@@ -2664,7 +3385,7 @@ sub symblist {
     my %hash;
     if (($ENV{'request.course.fn'}) && (%newhash)) {
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
-                      &GDBM_WRCREAT,0640)) {
+                      &GDBM_WRCREAT(),0640)) {
 	    foreach (keys %newhash) {
                 $hash{declutter($_)}=$mapname.'___'.$newhash{$_};
             }
@@ -2692,8 +3413,8 @@ sub symbverify {
     my %bighash;
     my $okay=0;
     if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
-                            &GDBM_READER,0640)) {
-        my $ids=$bighash{'ids_/res/'.$thisfn};
+                            &GDBM_READER(),0640)) {
+        my $ids=$bighash{'ids_'.&clutter($thisfn)};
         unless ($ids) { 
            $ids=$bighash{'ids_/'.$thisfn};
         }
@@ -2746,7 +3467,7 @@ sub symbread {
     my $syval='';
     if (($ENV{'request.course.fn'}) && ($thisfn)) {
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
-                      &GDBM_READER,0640)) {
+                      &GDBM_READER(),0640)) {
 	    $syval=$hash{$thisfn};
             untie(%hash);
         }
@@ -2762,9 +3483,9 @@ sub symbread {
         } else {
 # ------------------------------------------------------- Was not in symb table
            if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
-                            &GDBM_READER,0640)) {
+                            &GDBM_READER(),0640)) {
 # ---------------------------------------------- Get ID(s) for current resource
-              my $ids=$bighash{'ids_/res/'.$thisfn};
+              my $ids=$bighash{'ids_'.&clutter($thisfn)};
               unless ($ids) { 
                  $ids=$bighash{'ids_/'.$thisfn};
               }
@@ -2864,20 +3585,31 @@ sub ireceipt {
 }
 
 sub receipt {
-    return &ireceipt($ENV{'user.name'},$ENV{'user.domain'},
-                     $ENV{'request.course.id'},&symbread());
+  my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+  return &ireceipt($name,$domain,$courseid,$symb);
 }
-  
+
 # ------------------------------------------------------------ Serves up a file
 # returns either the contents of the file or a -1
 sub getfile {
-  my $file=shift;
+ my $file=shift;
+ if ($file=~/^\/*uploaded\//) { # user file
+    my $ua=new LWP::UserAgent;
+    my $request=new HTTP::Request('GET',&tokenwrapper($file));
+    my $response=$ua->request($request);
+    if ($response->is_success()) {
+       return $response->content;
+    } else { 
+       return -1; 
+    }
+ } else { # normal file from res space
   &repcopy($file);
   if (! -e $file ) { return -1; };
   my $fh=Apache::File->new($file);
   my $a='';
   while (<$fh>) { $a .=$_; }
-  return $a
+  return $a;
+ }
 }
 
 sub filelocation {
@@ -2887,6 +3619,8 @@ sub filelocation {
   if ($file=~m:^/~:) { # is a contruction space reference
     $location = $file;
     $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:;
+  } elsif ($file=~/^\/*uploaded/) { # is an uploaded file
+    $location=$file;
   } else {
     $file=~s/^$perlvar{'lonDocRoot'}//;
     $file=~s:^/*res::;
@@ -2924,6 +3658,16 @@ sub declutter {
     return $thisfn;
 }
 
+# ------------------------------------------------------------- Clutter up URLs
+
+sub clutter {
+    my $thisfn='/'.&declutter(shift);
+    unless ($thisfn=~/^\/(uploaded|adm|userfiles|ext|raw|priv)\//) { 
+       $thisfn='/res'.$thisfn; 
+    }
+    return $thisfn;
+}
+
 # -------------------------------------------------------- Escape Special Chars
 
 sub escape {
@@ -2974,18 +3718,42 @@ BEGIN {
     }
 }
 
+# ------------------------------------------------------------ Read domain file
+{
+    my $fh=Apache::File->new($Apache::lonnet::perlvar{'lonTabDir'}.
+                            '/domain.tab');
+    %domaindescription = ();
+    %domain_auth_def = ();
+    %domain_auth_arg_def = ();
+    if ($fh) {
+       while (<$fh>) {
+           next if /^\#/;
+           chomp;
+           my ($domain, $domain_description, $def_auth, $def_auth_arg)
+               = split(/:/,$_,4);
+           $domain_auth_def{$domain}=$def_auth;
+           $domain_auth_arg_def{$domain}=$def_auth_arg;
+           $domaindescription{$domain}=$domain_description;
+#          &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
+#          &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
+       }
+    }
+}
+
+
 # ------------------------------------------------------------- Read hosts file
 {
     my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
 
     while (my $configline=<$config>) {
+       next if ($configline =~ /^(\#|\s*$)/);
        chomp($configline);
        my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
        if ($id && $domain && $role && $name && $ip) {
 	 $hostname{$id}=$name;
 	 $hostdom{$id}=$domain;
 	 $hostip{$id}=$ip;
-	 if ($domdescr) { $domaindescription{$domain}=$domdescr; }
+	 $iphost{$ip}=$id;
 	 if ($role eq 'library') { $libserv{$id}=$name; }
        } else {
 	 if ($configline) {
@@ -3001,7 +3769,7 @@ BEGIN {
 
     while (my $configline=<$config>) {
        chomp($configline);
-       if (($configline) && ($configline ne $perlvar{'lonHostID'})) {
+       if ($configline) {
           $spareid{$configline}=1;
        }
     }
@@ -3047,9 +3815,15 @@ BEGIN {
     }
 }
 
+# ------------- set up temporary directory
+{
+    $tmpdir = $perlvar{'lonDaemons'}.'/tmp/';
+
+}
+
 %metacache=();
 
-$processmarker=$$.'_'.time.'_'.$perlvar{'lonHostID'};
+$processmarker='_'.time.'_'.$perlvar{'lonHostID'};
 $dumpcount=0;
 
 &logtouch();
@@ -3265,7 +4039,83 @@ modify user
 
 =item *
 
-modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,$end,$start) : modify student
+modifystudent
+
+modify a students enrollment and identification information.
+The course id is resolved based on the current users environment.  
+This means the envoking user must be a course coordinator or otherwise
+associated with a course.
+
+This call is essentially a wrapper for lonnet::modifyuser and
+lonnet::modify_student_enrollment
+
+Inputs: 
+
+=over 4
+
+=item B<$udom> Students loncapa domain
+
+=item B<$uname> Students loncapa login name
+
+=item B<$uid> Students id/student number
+
+=item B<$umode> Students authentication mode
+
+=item B<$upass> Students password
+
+=item B<$first> Students first name
+
+=item B<$middle> Students middle name
+
+=item B<$last> Students last name
+
+=item B<$gene> Students generation
+
+=item B<$usec> Students section in course
+
+=item B<$end> Unix time of the roles expiration
+
+=item B<$start> Unix time of the roles start date
+
+=item B<$forceid> If defined, allow $uid to be changed
+
+=item B<$desiredhome> server to use as home server for student
+
+=back
+
+=item *
+
+modify_student_enrollment
+
+Change a students enrollment status in a class.  The environment variable
+'role.request.course' must be defined for this function to proceed.
+
+Inputs:
+
+=over 4
+
+=item $udom, students domain
+
+=item $uname, students name
+
+=item $uid, students user id
+
+=item $first, students first name
+
+=item $middle
+
+=item $last
+
+=item $gene
+
+=item $usec
+
+=item $end
+
+=item $start
+
+=back
+
 
 =item *