--- loncom/lonnet/perl/lonnet.pm	2004/04/23 19:36:46	1.488
+++ loncom/lonnet/perl/lonnet.pm	2004/04/29 17:25:11	1.492
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.488 2004/04/23 19:36:46 albertel Exp $
+# $Id: lonnet.pm,v 1.492 2004/04/29 17:25:11 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1165,23 +1165,21 @@ sub externalssi {
     return $response->content;
 }
 
-# ------- Add a token to a remote URI's query string to vouch for access rights
+# -------------------------------- Allow a /uploaded/ URI to be vouched for
+
+sub allowuploaded {
+    my ($srcurl,$url)=@_;
+    $url=&clutter(&declutter($url));
+    my $dir=$url;
+    $dir=~s/\/[^\/]+$//;
+    my %httpref=();
+    my $httpurl=&hreflocation('',$url);
+    $httpref{'httpref.'.$httpurl}=$srcurl;
+    &Apache::lonnet::appenv(%httpref);
+}
 
 sub tokenwrapper {
-    my $uri=shift;
-    $uri=~s/^http\:\/\/([^\/]+)//;
-    $uri=~s/^\///;
-    $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
-    my $token=$1;
-#    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
-    if ($uri=~m|^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';
-    }
+    &FIXME_blow_up;
 }
 
 # --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
@@ -1338,6 +1336,12 @@ sub finishuserfileupload {
     }    
 }
 
+sub removeuserfile {
+    my ($docuname,$docudom,$fname)=@_;
+    my $home=&homeserver($docuname,$docudom);
+    return &reply("removeuserfile:$docudom/$docuname/$fname",$home);
+}
+
 # ------------------------------------------------------------------------- Log
 
 sub log {
@@ -2682,10 +2686,15 @@ sub allowed {
 
 # 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';
+    if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) {
+	my $refuri=$ENV{'httpref.'.$orguri};
+	if ($refuri) {
+	    if ($refuri =~ m|^/adm/|) {
+		$thisallowed='F';
+	    }
+	}
     }
+
 # Full access at system, domain or course-wide level? Exit.
 
     if ($thisallowed=~/F/) {
@@ -3938,7 +3947,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|)) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^~/) ||
-	($uri =~ m|home/[^/]+/public_html/|) || ($uri =~ m|^uploaded/|)) {
+	($uri =~ m|home/[^/]+/public_html/|)) {
 	return undef;
     }
     my $filename=$uri;
@@ -3967,7 +3976,10 @@ sub metadata {
 	}
         my %metathesekeys=();
         unless ($filename=~/\.meta$/) { $filename.='.meta'; }
-	my $metastring=&getfile(&filelocation('',&clutter($filename)));
+	my $metastring;
+	if ($uri !~ m|^uploaded/|) {
+	    $metastring=&getfile(&filelocation('',&clutter($filename)));
+	}
         my $parser=HTML::LCParser->new(\$metastring);
         my $token;
         undef %metathesekeys;
@@ -4439,6 +4451,15 @@ sub latest_rnd_algorithm_id {
     return '64bit2';
 }
 
+sub getCODE {
+    if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
+    if (defined($Apache::lonhomework::parsing_a_problem) &&
+	defined($Apache::lonhomework::history{'resource.CODE'})) {
+	return $Apache::lonhomework::history{'resource.CODE'};
+    }
+    return undef;
+}
+
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
 
@@ -4450,8 +4471,7 @@ sub rndseed {
     if (!$domain) { $domain=$wdomain; }
     if (!$username) { $username=$wusername }
     my $which=$ENV{"course.$courseid.rndseed"};
-    my $CODE=$ENV{'form.CODE'};
-    if (defined($CODE)) {
+    if (defined(&getCODE())) {
 	return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit2') {
 	return &rndseed_64bit2($symb,$courseid,$domain,$username);
@@ -4526,8 +4546,8 @@ sub rndseed_CODE_64bit {
 	use integer;
 	my $symbchck=unpack("%32S*",$symb.' ') << 16;
 	my $symbseed=numval2($symb);
-	my $CODEchck=unpack("%32S*",$ENV{'form.CODE'}.' ') << 16;
-	my $CODEseed=numval($ENV{'form.CODE'});
+	my $CODEchck=unpack("%32S*",&getCODE().' ') << 16;
+	my $CODEseed=numval(&getCODE());
 	my $courseseed=unpack("%32S*",$courseid.' ');
 	my $num1=$symbseed+$CODEchck;
 	my $num2=$CODEseed+$courseseed+$symbchck;