--- loncom/lonnet/perl/lonnet.pm	2004/02/11 00:10:01	1.472
+++ loncom/lonnet/perl/lonnet.pm	2004/03/16 21:29:31	1.478
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.472 2004/02/11 00:10:01 albertel Exp $
+# $Id: lonnet.pm,v 1.478 2004/03/16 21:29:31 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -377,7 +377,12 @@ sub delenv {
 	    return 'error: '.$!;
 	}
 	foreach (@oldenv) {
-	    unless ($_=~/^$delthis/) { print $fh $_; }
+	    if ($_=~/^$delthis/) { 
+                my ($key,undef) = split('=',$_);
+                delete($ENV{$key});
+            } else {
+                print $fh $_; 
+            }
 	}
 	close($fh);
     }
@@ -1166,7 +1171,8 @@ sub tokenwrapper {
     $uri=~s/^\///;
     $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;
-    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+#    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.
@@ -1175,7 +1181,65 @@ sub tokenwrapper {
 	return '/adm/notfound.html';
     }
 }
-    
+
+# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
+# input: action, courseID, current domain, home server for course, intended
+#        path to file, source of file.
+# output: ok if successful, diagnostic message otherwise
+#
+# Allows directory structure to be used within lonUsers/../userfiles/ for a 
+# course.
+#
+# action = propagate - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
+#          will be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles in
+#          course's home server.
+#
+# action = copy - /home/httpd/html/userfiles/$domain/1/2/3/$course/$file will
+#          be copied from $source (current location) to 
+#          /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
+#         and will then be copied to
+#          /home/httpd/lonUsers/$domain/1/2/3/$course/userfiles/$file in
+#         course's home server.
+
+sub process_coursefile {
+    my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;
+    my $fetchresult;
+    if ($action eq 'propagate') {
+        $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file
+                            ,$docuhome);
+    } elsif ($action eq 'copy') {
+        my $fetchresult = '';
+        my $fpath = '';
+        my $fname = $file;
+        ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|);
+        $fpath=$docudom.'/'.$docuname.'/'.$fpath;
+        my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
+        unless ($fpath eq '') {
+            my @parts=split('/',$fpath);
+            foreach my $part (@parts) {
+                $filepath.= '/'.$part;
+                if ((-e $filepath)!=1) {
+                    mkdir($filepath,0777);
+                }
+            }
+        }
+        if ($source eq '') {
+            $fetchresult = 'no source file';
+        } else {
+            my $destination = $filepath.'/'.$fname;
+            print STDERR "Getting ready to rename $source to $destination\n";
+            rename($source,$destination);
+            $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
+                                 $docuhome);
+        }
+    }
+    unless ( ($fetchresult eq 'ok') || ($fetchresult eq 'no source file') ) {
+        &logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
+             ' to host '.$docuhome.': '.$fetchresult);
+    }
+    return $fetchresult;
+}
+
 # --------------- 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
@@ -1231,7 +1295,6 @@ sub finishuserfileupload {
     }
 # Notify homeserver to grep it
 #
-    
     my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
 			    $docuhome);
     if ($fetchresult eq 'ok') {
@@ -4393,25 +4456,47 @@ sub setup_random_from_rndseed {
     }
 }
 
+sub latest_receipt_algorithm_id {
+    return 'receipt2';
+}
+
 sub ireceipt {
-    my ($funame,$fudom,$fucourseid,$fusymb)=@_;
+    my ($funame,$fudom,$fucourseid,$fusymb,$part)=@_;
     my $cuname=unpack("%32C*",$funame);
     my $cudom=unpack("%32C*",$fudom);
     my $cucourseid=unpack("%32C*",$fucourseid);
     my $cusymb=unpack("%32C*",$fusymb);
     my $cunique=unpack("%32C*",$perlvar{'lonReceipt'});
-    return unpack("%32C*",$perlvar{'lonHostID'}).'-'.
-           ($cunique%$cuname+
-            $cunique%$cudom+
-            $cusymb%$cuname+
-            $cusymb%$cudom+
-            $cucourseid%$cuname+
-            $cucourseid%$cudom);
+    my $cpart=unpack("%32S*",$part);
+    my $return =unpack("%32C*",$perlvar{'lonHostID'}).'-';
+    if ($ENV{"course.$fucourseid.receiptalg"} eq 'receipt2' ||
+	$ENV{'request.state'} eq 'construct') {
+	&Apache::lonxml::debug("doing receipt2  using parts $cpart, uname $cuname and udom $cudom gets  ".($cpart%$cuname).
+			       " and ".($cpart%$cudom));
+			       
+	$return.= ($cunique%$cuname+
+		   $cunique%$cudom+
+		   $cusymb%$cuname+
+		   $cusymb%$cudom+
+		   $cucourseid%$cuname+
+		   $cucourseid%$cudom+
+		   $cpart%$cuname+
+		   $cpart%$cudom);
+    } else {
+	$return.= ($cunique%$cuname+
+		   $cunique%$cudom+
+		   $cusymb%$cuname+
+		   $cusymb%$cudom+
+		   $cucourseid%$cuname+
+		   $cucourseid%$cudom);
+    }
+    return $return;
 }
 
 sub receipt {
-  my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
-  return &ireceipt($name,$domain,$courseid,$symb);
+    my ($part)=@_;
+    my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+    return &ireceipt($name,$domain,$courseid,$symb,$part);
 }
 
 # ------------------------------------------------------------ Serves up a file
@@ -4470,6 +4555,7 @@ sub filelocation {
   }
   $location=~s://+:/:g; # remove duplicate /
   while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
+  while ($location=~m:/\./:) {$location=~ s:/\./:/:g;} #remove /./
   return $location;
 }