--- loncom/lonnet/perl/lonnet.pm	2004/04/30 23:10:11	1.493
+++ loncom/lonnet/perl/lonnet.pm	2004/05/19 17:13:39	1.502
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.493 2004/04/30 23:10:11 albertel Exp $
+# $Id: lonnet.pm,v 1.502 2004/05/19 17:13:39 matthew Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -434,7 +434,7 @@ sub overloaderror {
     if ($overload>0) {
 	$r->err_headers_out->{'Retry-After'}=$overload;
         $r->log_error('Overload of '.$overload.' on '.$checkserver);
-        return 413;
+        return 409;
     }    
     return '';
 }
@@ -642,14 +642,18 @@ sub assign_access_key {
 # a valid key looks like uname:udom#comments
 # comments are being appended
 #
-    my ($ckey,$cdom,$cnum,$udom,$uname,$logentry)=@_;
+    my ($ckey,$kdom,$knum,$cdom,$cnum,$udom,$uname,$logentry)=@_;
+    $kdom=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'} unless (defined($kdom));
+    $knum=
+   $ENV{'course.'.$ENV{'request.course.id'}.'.num'} unless (defined($knum));
     $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);
+    my %existing=&get('accesskeys',[$ckey],$kdom,$knum);
     if (($existing{$ckey}=~/^\#(.*)$/) || # - new key
         ($existing{$ckey}=~/^\Q$uname\E\:\Q$udom\E\#(.*)$/)) { 
                                                   # assigned to this person
@@ -658,8 +662,8 @@ sub assign_access_key {
                                                   # the first time around
 # ready to assign
         $logentry=$1.'; '.$logentry;
-        if (&put('accesskey',{$ckey=>$uname.':'.$udom.'#'.$logentry},
-                                                 $cdom,$cnum) eq 'ok') {
+        if (&put('accesskeys',{$ckey=>$uname.':'.$udom.'#'.$logentry},
+                                                 $kdom,$knum) eq 'ok') {
 # key now belongs to user
 	    my $envkey='key.'.$cdom.'_'.$cnum;
             if (&put('environment',{$envkey => $ckey}) eq 'ok') {
@@ -755,8 +759,8 @@ sub validate_access_key {
    $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));
+    $udom=$ENV{'user.domain'} unless (defined($udom));
+    $uname=$ENV{'user.name'} unless (defined($uname));
     my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
     return ($existing{$ckey}=~/^\Q$uname\E\:\Q$udom\E\#/);
 }
@@ -1178,10 +1182,6 @@ sub allowuploaded {
     &Apache::lonnet::appenv(%httpref);
 }
 
-sub tokenwrapper {
-    &FIXME_blow_up;
-}
-
 # --------- 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.
@@ -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,21 +1325,21 @@ 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';
     }    
 }
@@ -1810,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') {
@@ -4456,7 +4462,7 @@ sub numval2 {
 }
 
 sub latest_rnd_algorithm_id {
-    return '64bit2';
+    return '64bit3';
 }
 
 sub getCODE {
@@ -4481,6 +4487,8 @@ sub rndseed {
     my $which=$ENV{"course.$courseid.rndseed"};
     if (defined(&getCODE())) {
 	return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+    } elsif ($which eq '64bit3') {
+	return &rndseed_64bit3($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit2') {
 	return &rndseed_64bit2($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit') {
@@ -4540,6 +4548,28 @@ sub rndseed_64bit2 {
 	my $domainseed=unpack("%32S*",$domain.' ') << 10;
 	my $courseseed=unpack("%32S*",$courseid.' ');
 	
+	my $num1=$symbchck+$symbseed+$namechck;
+	my $num2=$nameseed+$domainseed+$courseseed;
+	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");
+	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	return "$num1,$num2";
+    }
+}
+
+sub rndseed_64bit3 {
+    my ($symb,$courseid,$domain,$username)=@_;
+    {
+	use integer;
+	# strings need to be an even # of cahracters long, it it is odd the
+        # last characters gets thrown away
+	my $symbchck=unpack("%32S*",$symb.' ') << 21;
+	my $symbseed=numval2($symb) << 10;
+	my $namechck=unpack("%32S*",$username.' ');
+	
+	my $nameseed=numval2($username) << 21;
+	my $domainseed=unpack("%32S*",$domain.' ') << 10;
+	my $courseseed=unpack("%32S*",$courseid.' ');
+	
 	my $num1=$symbchck+$symbseed+$namechck;
 	my $num2=$nameseed+$domainseed+$courseseed;
 	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck");