--- loncom/lonnet/perl/lonnet.pm 2004/11/04 23:43:07 1.561 +++ loncom/lonnet/perl/lonnet.pm 2004/11/10 06:02:11 1.566 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.561 2004/11/04 23:43:07 banghart Exp $ +# $Id: lonnet.pm,v 1.566 2004/11/10 06:02:11 banghart Exp $ # # Copyright Michigan State University Board of Trustees # @@ -40,7 +40,7 @@ qw(%perlvar %hostname %homecache %badSer %courselogs %accesshash %userrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache %userresdatacache %getsectioncache %domaindescription %domain_auth_def %domain_auth_arg_def - %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir); + %domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit); use IO::Socket; use GDBM_File; @@ -1188,8 +1188,7 @@ sub ssi_body { my ($filelink,%form)=@_; my $output=($filelink=~/^http\:/?&externalssi($filelink): &ssi($filelink,%form)); - $output=~ - s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs; + $output=~s|//(\s*)?\s||gs; $output=~s/^.*?\]*\>//si; $output=~s/(.*)\<\/body\s*\>.*?$/$1/si; return $output; @@ -3781,6 +3780,20 @@ sub diskusage { return $listing; } +sub is_locked { + my ($file_name, $domain, $user) = @_; + my @check; + my $is_locked; + push @check, $file_name; + my %locked = &Apache::lonnet::get('file_permissions',\@check, + $ENV{'user.domain'},$ENV{'user.name'}); + if (ref($locked{$file_name}) eq 'ARRAY') { + $is_locked = 'true'; + } else { + $is_locked = 'false'; + } +} + # ------------------------------------------------------------- Mark as Read Only sub mark_as_readonly { @@ -3798,12 +3811,14 @@ sub mark_as_readonly { sub get_marked_as_readonly { my ($domain,$user,$what) = @_; my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); - my @readonly_files = []; - while ((my $file_name, my $value) = each %current_permissions) { + my @readonly_files; + while (my ($file_name,$value) = each(%current_permissions)) { if (ref($value) eq "ARRAY"){ foreach my $stored_what (@{$value}) { if ($stored_what eq $what) { push(@readonly_files, $file_name); + } elsif (!defined($what)) { + push(@readonly_files, $file_name); } } } @@ -3820,7 +3835,23 @@ sub unmark_as_readonly { my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user); my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what); foreach my $file(@readonly_files){ - + my $current_locks = $current_permissions{$file}; + my @new_locks; + my @del_keys; + if (ref($current_locks) eq "ARRAY"){ + foreach my $locker (@{$current_locks}) { + unless ($locker eq $what) { + push(@new_locks, $what); + } + } + if (@new_locks > 0) { + $current_permissions{$file} = \@new_locks; + } else { + push(@del_keys, $file); + &Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user); + delete $current_permissions{$file}; + } + } } &Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user); return; @@ -4836,6 +4867,7 @@ sub numval { $txt=~tr/U-Z/0-5/; $txt=~tr/u-z/0-5/; $txt=~s/\D//g; + if ($_64bit) { if ($txt > 2**32) { return -1; } } return int($txt); } @@ -4851,6 +4883,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); } @@ -4867,10 +4900,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; @@ -4912,6 +4951,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; } } @@ -4932,6 +4972,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); $num2=(($num2<<32)>>32); } + if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } return "$num1,$num2"; } } @@ -4975,7 +5017,9 @@ sub rndseed_64bit3 { 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"); + #&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit"); + if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } + return "$num1:$num2"; } } @@ -4993,6 +5037,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"; } } @@ -5513,6 +5559,12 @@ $dumpcount=0; &logtouch(); &logthis('INFO: Read configuration'); $readit=1; + { + use integer; + my $test=(2**32)+1; + if ($test != 0) { $_64bit=1; } + &logthis(" Detected 64bit platform ($_64bit)"); + } } }