--- loncom/lonnet/perl/lonnet.pm 2004/09/20 21:10:00 1.523.2.6 +++ loncom/lonnet/perl/lonnet.pm 2004/11/06 20:53:40 1.523.2.10 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.523.2.6 2004/09/20 21:10:00 albertel Exp $ +# $Id: lonnet.pm,v 1.523.2.10 2004/11/06 20:53:40 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -52,6 +52,7 @@ use Apache::lonlocal; use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw); use Time::HiRes qw( gettimeofday tv_interval ); my $readit; +my $_64bit=0; =pod @@ -795,11 +796,11 @@ sub getsection { if ($key eq $courseid.'_st') { $section=''; } my ($dummy,$end,$start)=split(/\_/,&unescape($value)); my $now=time; - if (defined($end) && ($now > $end)) { + if (defined($end) && $end && ($now > $end)) { $Expired{$end}=$section; next; } - if (defined($start) && ($now < $start)) { + if (defined($start) && $start && ($now < $start)) { $Pending{$start}=$section; next; } @@ -3132,8 +3133,10 @@ sub log_query { sub fetch_enrollment_query { my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; my $homeserver; + my $maxtries = 1; if ($context eq 'automated') { $homeserver = $perlvar{'lonHostID'}; + $maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout } else { $homeserver = &homeserver($cnum,$dom); } @@ -3148,6 +3151,16 @@ sub fetch_enrollment_query { my $queryid=&reply("querysend:".$query.':'.$dom.':'.$ENV{'user.name'}.':'.$cmd,$homeserver); unless ($queryid=~/^\Q$host\E\_/) { return 'error: '.$queryid; } my $reply = &get_query_reply($queryid); + my $tries = 1; + while (($reply=~/^timeout/) && ($tries < $maxtries)) { + $reply = &get_query_reply($queryid); + $tries++; + } + if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { + &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '. + $ENV{'user.name'}.' for '.$queryid.' context: '.$context.' '. + $cnum.' maxtries: '.$maxtries.' tries: '.$tries); + } unless ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { my @responses = split/:/,$reply; if ($homeserver eq $perlvar{'lonHostID'}) { @@ -4719,6 +4732,7 @@ sub numval { $txt=~tr/U-Z/0-5/; $txt=~tr/u-z/0-5/; $txt=~s/\D//g; + if ($_64bit) { if ($total > 2**32) { return -1; } } return int($txt); } @@ -4734,6 +4748,7 @@ sub numval2 { my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt); my $total; foreach my $val (@txts) { $total+=$val; } + if ($_64bit) { if ($total > 2**32) { return -1; } } return int($total); } @@ -4750,10 +4765,16 @@ sub get_rand_alg { return &latest_rnd_algorithm_id(); } +sub validCODE { + my ($CODE)=@_; + if (defined($CODE) && $CODE ne '' && $CODE =~ /^\w+$/) { return 1; } + return 0; +} + sub getCODE { - if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; } + if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; } if (defined($Apache::lonhomework::parsing_a_problem) && - defined($Apache::lonhomework::history{'resource.CODE'})) { + &validCODE($Apache::lonhomework::history{'resource.CODE'})) { return $Apache::lonhomework::history{'resource.CODE'}; } return undef; @@ -4795,6 +4816,7 @@ sub rndseed_32bit { my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck; #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&Apache::lonxml::debug("rndseed :$num:$symb"); + if ($_64bit) { $num=(($num<<32)>>32); } return $num; } } @@ -4815,6 +4837,8 @@ sub rndseed_64bit { my $num2=$nameseed+$domainseed+$courseseed; #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&Apache::lonxml::debug("rndseed :$num:$symb"); + if ($_64bit) { $num1=(($num1<<32)>>32); } + if ($_64bit) { $num2=(($num2<<32)>>32); } return "$num1,$num2"; } } @@ -4837,6 +4861,8 @@ sub rndseed_64bit2 { my $num2=$nameseed+$domainseed+$courseseed; #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&Apache::lonxml::debug("rndseed :$num:$symb"); + if ($_64bit) { $num1=(($num1<<32)>>32); } + if ($_64bit) { $num2=(($num2<<32)>>32); } return "$num1,$num2"; } } @@ -4859,6 +4885,8 @@ sub rndseed_64bit3 { my $num2=$nameseed+$domainseed+$courseseed; #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&Apache::lonxml::debug("rndseed :$num:$symb"); + if ($_64bit) { $num1=(($num1<<32)>>32); } + if ($_64bit) { $num2=(($num2<<32)>>32); } return "$num1:$num2"; } } @@ -4876,6 +4904,8 @@ sub rndseed_CODE_64bit { 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"; } } @@ -5217,6 +5247,11 @@ sub goodbye { } BEGIN { + { + use integer; + my $test=(2**32)+1; + if ($test != 0) { $_64bit=1; } + } # ----------------------------------- Read loncapa.conf and loncapa_apache.conf unless ($readit) { {