--- loncom/lonnet/perl/lonnet.pm 2004/12/06 18:08:39 1.574 +++ loncom/lonnet/perl/lonnet.pm 2004/12/07 16:19:37 1.575 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.574 2004/12/06 18:08:39 banghart Exp $ +# $Id: lonnet.pm,v 1.575 2004/12/07 16:19:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4699,7 +4699,9 @@ sub gettitle { my $symb=&symbread($urlsymb); if ($symb) { my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600); - if (defined($cached)) { return $result; } + if (defined($cached)) { + return $result; + } my ($map,$resid,$url)=&decode_symb($symb); my $title=''; my %bighash; @@ -4971,8 +4973,25 @@ sub numval2 { return int($total); } +sub numval3 { + use integer; + my $txt=shift; + $txt=~tr/A-J/0-9/; + $txt=~tr/a-j/0-9/; + $txt=~tr/K-T/0-9/; + $txt=~tr/k-t/0-9/; + $txt=~tr/U-Z/0-5/; + $txt=~tr/u-z/0-5/; + $txt=~s/\D//g; + my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt); + my $total; + foreach my $val (@txts) { $total+=$val; } + if ($_64bit) { $total=(($total<<32)>>32); } + return $total; +} + sub latest_rnd_algorithm_id { - return '64bit3'; + return '64bit4'; } sub get_rand_alg { @@ -5011,7 +5030,13 @@ sub rndseed { if (!$username) { $username=$wusername } my $which=&get_rand_alg(); if (defined(&getCODE())) { - return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); + if ($which eq '64bit4') { + return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username); + } else { + return &rndseed_CODE_64bit($symb,$courseid,$domain,$username); + } + } elsif ($which eq '64bit4') { + return &rndseed_64bit4($symb,$courseid,$domain,$username); } elsif ($which eq '64bit3') { return &rndseed_64bit3($symb,$courseid,$domain,$username); } elsif ($which eq '64bit2') { @@ -5108,6 +5133,30 @@ sub rndseed_64bit3 { } } +sub rndseed_64bit4 { + 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=numval3($symb) << 10; + my $namechck=unpack("%32S*",$username.' '); + + my $nameseed=numval3($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 :$num1:$num2:$_64bit"); + if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } + + return "$num1:$num2"; + } +} + sub rndseed_CODE_64bit { my ($symb,$courseid,$domain,$username)=@_; { @@ -5119,6 +5168,25 @@ sub rndseed_CODE_64bit { my $courseseed=unpack("%32S*",$courseid.' '); my $num1=$symbseed+$CODEchck; my $num2=$CODEseed+$courseseed+$symbchck; + #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); + #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); + if ($_64bit) { $num1=(($num1<<32)>>32); } + if ($_64bit) { $num2=(($num2<<32)>>32); } + return "$num1:$num2"; + } +} + +sub rndseed_CODE_64bit4 { + my ($symb,$courseid,$domain,$username)=@_; + { + use integer; + my $symbchck=unpack("%32S*",$symb.' ') << 16; + my $symbseed=numval3($symb); + my $CODEchck=unpack("%32S*",&getCODE().' ') << 16; + my $CODEseed=numval3(&getCODE()); + my $courseseed=unpack("%32S*",$courseid.' '); + my $num1=$symbseed+$CODEchck; + my $num2=$CODEseed+$courseseed+$symbchck; #&Apache::lonxml::debug("$symbseed:$CODEchck|$CODEseed:$courseseed:$symbchck"); #&Apache::lonxml::debug("rndseed :$num1:$num2:$symb"); if ($_64bit) { $num1=(($num1<<32)>>32); }