[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm

[albertel]

albertel		Mon Nov 10 15:27:32 2003 EDT

  Modified files:              
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - BUG#1988 random numbers not random for odd length usernames
  - removed some debug code spew
  - reorganized hash dump info
  
  
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.442 loncom/lonnet/perl/lonnet.pm:1.443
--- loncom/lonnet/perl/lonnet.pm:1.442	Sat Nov  8 00:45:50 2003
+++ loncom/lonnet/perl/lonnet.pm	Mon Nov 10 15:27:32 2003
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.442 2003/11/08 05:45:50 albertel Exp $
+# $Id: lonnet.pm,v 1.443 2003/11/10 20:27:32 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4182,7 +4182,7 @@
 }
 
 sub latest_rnd_algorithm_id {
-    return '64bit';
+    return '64bit2';
 }
 
 sub rndseed {
@@ -4199,6 +4199,8 @@
     my $CODE=$ENV{'scantron.CODE'};
     if (defined($CODE)) {
 	&rndseed_CODE_64bit($symb,$courseid,$domain,$username);
+    } elsif ($which eq '64bit2') {
+	return &rndseed_64bit2($symb,$courseid,$domain,$username);
     } elsif ($which eq '64bit') {
 	return &rndseed_64bit($symb,$courseid,$domain,$username);
     }
@@ -4242,14 +4244,36 @@
     }
 }
 
+sub rndseed_64bit2 {
+    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=numval($symb) << 10;
+	my $namechck=unpack("%32S*",$username.' ');
+	
+	my $nameseed=numval($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");
+	#&Apache::lonxml::debug("rndseed :$num:$symb");
+	return "$num1,$num2";
+    }
+}
+
 sub rndseed_CODE_64bit {
     my ($symb,$courseid,$domain,$username)=@_;
     {
 	use integer;
-	my $symbchck=unpack("%32S*",$symb) << 16;
+	my $symbchck=unpack("%32S*",$symb.' ') << 16;
 	my $symbseed=numval($symb);
 	my $CODEseed=numval($ENV{'scantron.CODE'}) << 16;
-	my $courseseed=unpack("%32S*",$courseid);
+	my $courseseed=unpack("%32S*",$courseid.' ');
 	my $num1=$symbseed+$CODEseed;
 	my $num2=$courseseed+$symbchck;
 	#&Apache::lonxml::debug("$symbseed:$CODEseed|$courseseed:$symbchck");
@@ -4393,7 +4417,6 @@
 
 sub correct_line_ends {
     my ($result)=@_;
-    &logthis("Wha $result");
     $$result =~s/\r\n/\n/mg;
     $$result =~s/\r/\n/mg;
 }
@@ -4401,11 +4424,11 @@
 
 sub goodbye {
    &logthis("Starting Shut down");
-#not converted to using infrastruture
-   &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
+#not converted to using infrastruture and probably shouldn't be
    &logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));
-   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
 #converted
+   &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
+   &logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));
    &logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));
    &logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));
 #1.1 only