--- loncom/lonnet/perl/lonnet.pm 2001/01/11 11:08:37 1.96 +++ loncom/lonnet/perl/lonnet.pm 2001/02/27 20:44:18 1.103 @@ -13,7 +13,7 @@ # 1: user needs to choose course # 2: browse allowed # definerole(rolename,sys,dom,cou) : define a custom role rolename -# set priviledges in format of lonTabs/roles.tab for +# set privileges in format of lonTabs/roles.tab for # system, domain and course level, # assignrole(udom,uname,url,role,end,start) : give a role to a user for the # level given by url. Optional start and end dates @@ -86,6 +86,7 @@ # 05/01,06/01,09/01 Gerd Kortemeyer # 09/01 Guy Albertelli # 09/01,10/01,11/01 Gerd Kortemeyer +# 02/27/01 Scott Harrison package Apache::lonnet; @@ -248,7 +249,7 @@ sub appenv { my $lockfh; unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) { - return 'error'; + return 'error: '.$!; } unless (flock($lockfh,LOCK_EX)) { &logthis("WARNING: ". @@ -261,7 +262,7 @@ sub appenv { { my $fh; unless ($fh=Apache::File->new("$ENV{'user.environment'}")) { - return 'error'; + return 'error: '.$!; } @oldenv=<$fh>; $fh->close(); @@ -719,7 +720,7 @@ sub coursedescription { return (); } -# -------------------------------------------------------- Get user priviledges +# -------------------------------------------------------- Get user privileges sub rolesinit { my ($domain,$username,$authhost)=@_; @@ -793,12 +794,12 @@ sub rolesinit { %thesepriv=(); map { if ($_ ne '') { - my ($priviledge,$restrictions)=split(/&/,$_); + my ($privilege,$restrictions)=split(/&/,$_); if ($restrictions eq '') { - $thesepriv{$priviledge}='F'; + $thesepriv{$privilege}='F'; } else { - if ($thesepriv{$priviledge} ne 'F') { - $thesepriv{$priviledge}.=$restrictions; + if ($thesepriv{$privilege} ne 'F') { + $thesepriv{$privilege}.=$restrictions; } } } @@ -908,7 +909,7 @@ sub eget { return %returnhash; } -# ------------------------------------------------- Check for a user priviledge +# ------------------------------------------------- Check for a user privilege sub allowed { my ($priv,$uri)=@_; @@ -959,7 +960,7 @@ sub allowed { return $thisallowed; } # -# Gathered so far: system, domain and course wide priviledges +# Gathered so far: system, domain and course wide privileges # # Course: See if uri or referer is an individual resource that is part of # the course @@ -1010,7 +1011,7 @@ sub allowed { } # -# Gathered now: all priviledges that could apply, and condition number +# Gathered now: all privileges that could apply, and condition number # # # Full or no access? @@ -1843,16 +1844,20 @@ sub numval { sub rndseed { my $symb; unless ($symb=&symbread()) { return time; } - my $symbchck=unpack("%32C*",$symb); - my $symbseed=numval($symb)%$symbchck; - my $namechck=unpack("%32C*",$ENV{'user.name'}); - my $nameseed=numval($ENV{'user.name'})%$namechck; - return int( $symbseed - .$nameseed - .unpack("%32C*",$ENV{'user.domain'}) - .unpack("%32C*",$ENV{'request.course.id'}) - .$namechck - .$symbchck); + { + use integer; + my $symbchck=unpack("%32C*",$symb) << 27; + my $symbseed=numval($symb) << 22; + my $namechck=unpack("%32C*",$ENV{'user.name'}) << 17; + my $nameseed=numval($ENV{'user.name'}) << 12; + my $domainseed=unpack("%32C*",$ENV{'user.domain'}) << 7; + my $courseseed=unpack("%32C*",$ENV{'request.course.id'}); + my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck; + #uncommenting these lines can break things! + #&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); + #&Apache::lonxml::debug("rndseed :$num:$symb"); + return $num; + } } sub ireceipt {