--- loncom/lonnet/perl/lonnet.pm 2004/11/08 18:04:17 1.563
+++ loncom/lonnet/perl/lonnet.pm 2004/11/11 22:39:05 1.569
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.563 2004/11/08 18:04:17 banghart Exp $
+# $Id: lonnet.pm,v 1.569 2004/11/11 22:39:05 albertel 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*<!--)? BEGIN LON-CAPA Internal.+// END LON-CAPA Internal\s*(-->)?\s||gs;
$output=~s/^.*?\<body[^\>]*\>//si;
$output=~s/(.*)\<\/body\s*\>.*?$/$1/si;
return $output;
@@ -2388,10 +2387,8 @@ sub rolesinit {
my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
if (($rolesdump eq 'con_lost') || ($rolesdump eq '')) { return ''; }
my %allroles=();
- my %thesepriv=();
my $now=time;
my $userroles="user.login.time=$now\n";
- my $thesestr;
if ($rolesdump ne '') {
foreach (split(/&/,$rolesdump)) {
@@ -2399,94 +2396,21 @@ sub rolesinit {
my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;
my ($trole,$tend,$tstart)=split(/_/,$role);
- $userroles.='user.role.'.$trole.'.'.$area.'='.
- $tstart.'.'.$tend."\n";
-# log the associated role with the area
- &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
- if ($tend!=0) {
- if ($tend<$now) {
- $trole='';
- }
- }
- if ($tstart!=0) {
- if ($tstart>$now) {
- $trole='';
- }
- }
+ $userroles.=&set_arearole($trole,$area,$tstart,$tend);
+ if (($tend!=0) && ($tend<$now)) { $trole=''; }
+ if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
if (($area ne '') && ($trole ne '')) {
my $spec=$trole.'.'.$area;
my ($tdummy,$tdomain,$trest)=split(/\//,$area);
if ($trole =~ /^cr\//) {
- my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
- my $homsvr=homeserver($rauthor,$rdomain);
- if ($hostname{$homsvr} ne '') {
- my ($rdummy,$roledef)=
- &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
-
- if (($rdummy ne 'con_lost') && ($roledef ne '')) {
- my ($syspriv,$dompriv,$coursepriv)=
- split(/\_/,$roledef);
- if (defined($syspriv)) {
- $allroles{'cm./'}.=':'.$syspriv;
- $allroles{$spec.'./'}.=':'.$syspriv;
- }
- if ($tdomain ne '') {
- if (defined($dompriv)) {
- $allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
- $allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
- }
- if ($trest ne '') {
- if (defined($coursepriv)) {
- $allroles{'cm.'.$area}.=':'.$coursepriv;
- $allroles{$spec.'.'.$area}.=':'.$coursepriv;
- }
- }
- }
- }
- }
+ &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
} else {
- if (defined($pr{$trole.':s'})) {
- $allroles{'cm./'}.=':'.$pr{$trole.':s'};
- $allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
- }
- if ($tdomain ne '') {
- if (defined($pr{$trole.':d'})) {
- $allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
- $allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
- }
- if ($trest ne '') {
- if (defined($pr{$trole.':c'})) {
- $allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
- $allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
- }
- }
- }
+ &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
}
}
}
}
- my $adv=0;
- my $author=0;
- foreach (keys %allroles) {
- %thesepriv=();
- if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
- foreach (split(/:/,$allroles{$_})) {
- if ($_ ne '') {
- my ($privilege,$restrictions)=split(/&/,$_);
- if ($restrictions eq '') {
- $thesepriv{$privilege}='F';
- } else {
- if ($thesepriv{$privilege} ne 'F') {
- $thesepriv{$privilege}.=$restrictions;
- }
- }
- if ($thesepriv{'adv'} eq 'F') { $adv=1; }
- }
- }
- $thesestr='';
- foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
- $userroles.='user.priv.'.$_.'='.$thesestr."\n";
- }
+ my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
$userroles.='user.adv='.$adv."\n".
'user.author='.$author."\n";
$ENV{'user.adv'}=$adv;
@@ -2494,6 +2418,84 @@ sub rolesinit {
return $userroles;
}
+sub set_arearole {
+ my ($trole,$area,$tstart,$tend,$domain,$username) = @_;
+# log the associated role with the area
+ &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
+ return 'user.role.'.$trole.'.'.$area.'='.$tstart.'.'.$tend."\n";
+}
+
+sub custom_roleprivs {
+ my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
+ my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
+ my $homsvr=homeserver($rauthor,$rdomain);
+ if ($hostname{$homsvr} ne '') {
+ my ($rdummy,$roledef)=
+ &get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
+ if (($rdummy ne 'con_lost') && ($roledef ne '')) {
+ my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
+ if (defined($syspriv)) {
+ $$allroles{'cm./'}.=':'.$syspriv;
+ $$allroles{$spec.'./'}.=':'.$syspriv;
+ }
+ if ($tdomain ne '') {
+ if (defined($dompriv)) {
+ $$allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
+ $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
+ }
+ if (($trest ne '') && (defined($coursepriv))) {
+ $$allroles{'cm.'.$area}.=':'.$coursepriv;
+ $$allroles{$spec.'.'.$area}.=':'.$coursepriv;
+ }
+ }
+ }
+ }
+}
+
+
+sub standard_roleprivs {
+ my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
+ if (defined($pr{$trole.':s'})) {
+ $$allroles{'cm./'}.=':'.$pr{$trole.':s'};
+ $$allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
+ }
+ if ($tdomain ne '') {
+ if (defined($pr{$trole.':d'})) {
+ $$allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
+ $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
+ }
+ if (($trest ne '') && (defined($pr{$trole.':c'}))) {
+ $$allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
+ $$allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
+ }
+ }
+}
+
+sub set_userprivs {
+ my ($userroles,$allroles) = @_;
+ my $author=0;
+ my $adv=0;
+ foreach (keys %{$allroles}) {
+ my %thesepriv=();
+ if (($_=~/^au/) || ($_=~/^ca/)) { $author=1; }
+ foreach (split(/:/,$$allroles{$_})) {
+ if ($_ ne '') {
+ my ($privilege,$restrictions)=split(/&/,$_);
+ if ($restrictions eq '') {
+ $thesepriv{$privilege}='F';
+ } elsif ($thesepriv{$privilege} ne 'F') {
+ $thesepriv{$privilege}.=$restrictions;
+ }
+ if ($thesepriv{'adv'} eq 'F') { $adv=1; }
+ }
+ }
+ my $thesestr='';
+ foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
+ $$userroles.='user.priv.'.$_.'='.$thesestr."\n";
+ }
+ return ($author,$adv);
+}
+
# --------------------------------------------------------------- get interface
sub get {
@@ -3781,6 +3783,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 {
@@ -3800,16 +3816,12 @@ sub get_marked_as_readonly {
my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
my @readonly_files;
while (my ($file_name,$value) = each(%current_permissions)) {
- &logthis("found $file_name");
if (ref($value) eq "ARRAY"){
- &logthis("found array");
foreach my $stored_what (@{$value}) {
if ($stored_what eq $what) {
push(@readonly_files, $file_name);
- &logthis("defined pushed $file_name");
} elsif (!defined($what)) {
push(@readonly_files, $file_name);
- &logthis("undef pushed $file_name");
}
}
}
@@ -4698,7 +4710,7 @@ sub symbverify {
sub symbclean {
my $symb=shift;
-
+ if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); }
# remove version from map
$symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/;
@@ -4719,7 +4731,9 @@ sub encode_symb {
}
sub decode_symb {
- my ($map,$resid,$url)=split(/\_\_\_/,shift);
+ my $symb=shift;
+ if ($symb=~m|^/enc/|) { $symb=&Apache::lonenc::unencrypted($symb); }
+ my ($map,$resid,$url)=split(/___/,$symb);
return (&fixversion($map),$resid,&fixversion($url));
}
@@ -4768,6 +4782,7 @@ sub symbread {
}
$thisfn=$ENV{'request.filename'};
}
+ if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
# is that filename actually a symb? Verify, clean, and return
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
if (&symbverify($thisfn,$1)) {
@@ -4858,6 +4873,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);
}
@@ -4873,6 +4889,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);
}
@@ -4940,6 +4957,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;
}
}
@@ -4960,6 +4978,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";
}
}
@@ -5003,7 +5023,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";
}
}
@@ -5021,6 +5043,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";
}
}
@@ -5309,6 +5333,7 @@ sub current_machine_ids {
sub declutter {
my $thisfn=shift;
+ if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$thisfn=~s/^\///;
$thisfn=~s/^res\///;
@@ -5541,6 +5566,12 @@ $dumpcount=0;
&logtouch();
&logthis('<font color=yellow>INFO: Read configuration</font>');
$readit=1;
+ {
+ use integer;
+ my $test=(2**32)+1;
+ if ($test != 0) { $_64bit=1; } else { $_64bit=0; }
+ &logthis(" Detected 64bit platform ($_64bit)");
+ }
}
}