--- loncom/lonnet/perl/lonnet.pm	2004/02/02 20:21:25	1.470
+++ loncom/lonnet/perl/lonnet.pm	2004/03/16 20:15:08	1.477
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.470 2004/02/02 20:21:25 www Exp $
+# $Id: lonnet.pm,v 1.477 2004/03/16 20:15:08 raeburn 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);
     }
@@ -524,38 +529,21 @@ 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'});
-        if ($answer =~ /authorized/) {
-              if ($answer eq 'authorized') {
-                 &logthis("User $uname at $udom authorized by local server"); 
-                 return $perlvar{'lonHostID'}; 
-              }
-              if ($answer eq 'non_authorized') {
-                 &logthis("User $uname at $udom rejected by local server"); 
-                 return 'no_host'; 
-              }
-	}
+    my $uhome=&homeserver($uname,$udom);
+    if (!$uhome) {
+	&logthis("User $uname at $udom is unknown in authenticate");
+	return 'no_host';
     }
-
-    my $tryserver;
-    foreach $tryserver (keys %libserv) {
-	if ($hostdom{$tryserver} eq $udom) {
-           my $answer=reply("encrypt:auth:$udom:$uname:$upass",$tryserver);
-           if ($answer =~ /authorized/) {
-              if ($answer eq 'authorized') {
-                 &logthis("User $uname at $udom authorized by $tryserver"); 
-                 return $tryserver; 
-              }
-              if ($answer eq 'non_authorized') {
-                 &logthis("User $uname at $udom rejected by $tryserver");
-                 return 'no_host';
-              } 
-	   }
-       }
+    my $answer=reply("encrypt:auth:$udom:$uname:$upass",$uhome);
+    if ($answer eq 'authorized') {
+	&logthis("User $uname at $udom authorized by $uhome"); 
+	return $uhome; 
+    }
+    if ($answer eq 'non_authorized') {
+	&logthis("User $uname at $udom rejected by $uhome");
+	return 'no_host'; 
     }
-    &logthis("User $uname at $udom could not be authenticated");    
+    &logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
     return 'no_host';
 }
 
@@ -1183,7 +1171,8 @@ sub tokenwrapper {
     $uri=~s/^\///;
     $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
     my $token=$1;
-    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+#    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+    if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/(.+)(\?\.*)*$/) {
 	&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
         return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
                (($uri=~/\?/)?'&':'?').'token='.$token.
@@ -1192,7 +1181,61 @@ 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/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
@@ -1248,9 +1291,8 @@ sub finishuserfileupload {
     }
 # Notify homeserver to grep it
 #
-    
-    my $fetchresult= 
- &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,$docuhome);
+    my $fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$fname,
+			    $docuhome);
     if ($fetchresult eq 'ok') {
 #
 # Return the URL to it
@@ -3861,7 +3903,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|home/[^/]+/public_html/|) || ($uri =~ m|^uploaded/|)) {
 	return undef;
     }
     my $filename=$uri;
@@ -4410,49 +4452,83 @@ 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
-# returns either the contents of the file or a -1
+# returns either the contents of the file or 
+# -1 if the file doesn't exist
+# -2 if an error occured when trying to aqcuire the file
+
 sub getfile {
- 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;
-  open($fh,"<$file");
-  my $a='';
-  while (<$fh>) { $a .=$_; }
-  return $a;
- }
+    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 { 
+	    #&logthis("Return Code is ".$response->code." for $file ".
+	    #         &tokenwrapper($file));
+	    # 500 for ISE when tokenwrapper can't figure out what server to
+            #  contact
+            # 503 when lonuploadacc can't contact the requested server
+	    if ($response->code eq 503 || $response->code eq 500) {
+		return -2;
+	    } else {
+		return -1;
+	    }
+	}
+    } else { # normal file from res space
+	&repcopy($file);
+	if (! -e $file ) { return -1; };
+	my $fh;
+	open($fh,"<$file");
+	my $a='';
+	while (<$fh>) { $a .=$_; }
+	return $a;
+    }
 }
 
 sub filelocation {
@@ -4475,6 +4551,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;
 }