--- loncom/lonnet/perl/lonnet.pm	2004/04/29 07:18:10	1.490
+++ loncom/lonnet/perl/lonnet.pm	2004/05/07 17:17:50	1.495
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.490 2004/04/29 07:18:10 albertel Exp $
+# $Id: lonnet.pm,v 1.495 2004/05/07 17:17:50 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
@@ -1270,7 +1268,8 @@ sub process_coursefile {
 # output: url of file in userspace
 
 sub userfileupload {
-    my ($formname,$coursedoc)=@_;
+    my ($formname,$coursedoc,$subdir)=@_;
+    if (!defined($subdir)) { $subdir='unknown'; }
     my $fname=$ENV{'form.'.$formname.'.filename'};
 # Replace Windows backslashes by forward slashes
     $fname=~s/\\/\//g;
@@ -1287,6 +1286,7 @@ sub userfileupload {
     my $docuname='';
     my $docudom='';
     my $docuhome='';
+    $fname="$subdir/$fname";
     if ($coursedoc) {
 	$docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
 	$docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
@@ -1309,6 +1309,12 @@ sub finishuserfileupload {
     my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;
     my $path=$docudom.'/'.$docuname.'/';
     my $filepath=$perlvar{'lonDocRoot'};
+    my ($fnamepath,$file);
+    $file=$fname;
+    if ($fname=~m|/|) {
+        ($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|);
+	$path.=$fnamepath.'/';
+    }
     my @parts=split(/\//,$filepath.'/userfiles/'.$path);
     my $count;
     for ($count=4;$count<=$#parts;$count++) {
@@ -1319,25 +1325,31 @@ sub finishuserfileupload {
     }
 # Save the file
     {
-       open(my $fh,'>'.$filepath.'/'.$fname);
+	&Apache::lonnet::logthis("Saving to $filepath $file");
+       open(my $fh,'>'.$filepath.'/'.$file);
        print $fh $ENV{'form.'.$formname};
        close($fh);
     }
 # Notify homeserver to grep it
 #
-    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
-			    $docuhome);
+    my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
     if ($fetchresult eq 'ok') {
 #
 # Return the URL to it
-        return '/uploaded/'.$path.$fname;
+        return '/uploaded/'.$path.$file;
     } else {
-        &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$fname.
-         ' to host '.$docuhome.': '.$fetchresult);
+        &logthis('Failed to transfer '.$path.$file.' to host '.$docuhome.
+		 ': '.$fetchresult);
         return '/adm/notfound.html';
     }    
 }
 
+sub removeuploadedurl {
+    my ($url)=@_;
+    my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
+    return &Apache::lonnet::removeuserfile($uname,$udom,$fname);
+}
+
 sub removeuserfile {
     my ($docuname,$docudom,$fname)=@_;
     my $home=&homeserver($docuname,$docudom);
@@ -1804,7 +1816,7 @@ sub hash2str {
 sub hashref2str {
   my ($hashref)=@_;
   my $result='__HASH_REF__';
-  foreach (keys(%$hashref)) {
+  foreach (sort(keys(%$hashref))) {
     if (ref($_) eq 'ARRAY') {
       $result.=&arrayref2str($_).'=';
     } elsif (ref($_) eq 'HASH') {
@@ -2688,10 +2700,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/) {
@@ -4448,6 +4465,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)=@_;
 
@@ -4459,8 +4485,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);
@@ -4535,8 +4560,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;