[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
droeschl
droeschl at source.lon-capa.org
Fri May 18 12:26:06 EDT 2012
droeschl Fri May 18 16:26:06 2012 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
Use dump() routine in rolesinit instead of reply(“dumpâ€...) to benefit from
changes related to BZ 6585.
Removed $authhost argument from rolesinit. It’s equivalent to homeserver(),
which is called by dump() for the same purpose.
Code cleanup and comments.
-------------- next part --------------
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1168 loncom/lonnet/perl/lonnet.pm:1.1169
--- loncom/lonnet/perl/lonnet.pm:1.1168 Fri May 18 15:31:40 2012
+++ loncom/lonnet/perl/lonnet.pm Fri May 18 16:26:05 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1168 2012/05/18 15:31:40 www Exp $
+# $Id: lonnet.pm,v 1.1169 2012/05/18 16:26:05 droeschl Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3490,28 +3490,18 @@
sub userrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
- if (($trole=~/^ca/) || ($trole=~/^aa/) ||
- ($trole=~/^in/) || ($trole=~/^cc/) ||
- ($trole=~/^ep/) || ($trole=~/^cr/) ||
- ($trole=~/^ta/) || ($trole=~/^co/)) {
+ if ( $trole =~ /^(ca|aa|in|cc|ep|cr|ta|co)/ ) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$userrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
=$tend.':'.$tstart;
}
- if (($env{'request.role'} =~ /dc\./) &&
- (($trole=~/^au/) || ($trole=~/^in/) ||
- ($trole=~/^cc/) || ($trole=~/^ep/) ||
- ($trole=~/^cr/) || ($trole=~/^ta/) ||
- ($trole=~/^co/))) {
+ if ($env{'request.role'} =~ /dc\./ && $trole =~ /^(au|in|cc|ep|cr|ta|co)/) {
$userrolehash
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
=$tend.':'.$tstart;
}
- if (($trole=~/^dc/) || ($trole=~/^ad/) ||
- ($trole=~/^li/) || ($trole=~/^li/) ||
- ($trole=~/^au/) || ($trole=~/^dg/) ||
- ($trole=~/^sc/)) {
+ if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$domainrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -4645,102 +4635,108 @@
# -------------------------------------------------------- Get user privileges
sub rolesinit {
- my ($domain,$username,$authhost)=@_;
- my $now=time;
- my %userroles = ('user.login.time' => $now);
- my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
- if (($rolesdump eq 'con_lost') || ($rolesdump eq '') ||
- ($rolesdump =~ /^error:/)) {
- return \%userroles;
- }
- my %firstaccess = &dump('firstaccesstimes',$domain,$username);
- my %timerinterval = &dump('timerinterval',$domain,$username);
- my (%coursetimerstarts,%firstaccchk,%firstaccenv,
- %coursetimerintervals,%timerintchk,%timerintenv);
+ my ($domain, $username) = @_;
+ my %userroles = ('user.login.time' => time);
+ my %rolesdump = &dump("roles", $domain, $username) or return \%userroles;
+
+ # firstaccess and timerinterval are related to timed maps/resources.
+ # also, blocking can be triggered by an activating timer
+ # it's saved in the user's %env.
+ my %firstaccess = &dump('firstaccesstimes', $domain, $username);
+ my %timerinterval = &dump('timerinterval', $domain, $username);
+ my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,
+ %timerintchk, %timerintenv);
+
foreach my $key (keys(%firstaccess)) {
- my ($cid,$rest) = split(/\0/,$key);
+ my ($cid, $rest) = split(/\0/, $key);
$coursetimerstarts{$cid}{$rest} = $firstaccess{$key};
}
+
foreach my $key (keys(%timerinterval)) {
my ($cid,$rest) = split(/\0/,$key);
$coursetimerintervals{$cid}{$rest} = $timerinterval{$key};
}
+
my %allroles=();
my %allgroups=();
- if ($rolesdump ne '') {
- foreach my $entry (split(/&/,$rolesdump)) {
- if ($entry!~/^rolesdef_/) {
- my ($area,$role)=split(/=/,$entry);
- $area=~s/\_\w\w$//;
- my ($trole,$tend,$tstart,$group_privs);
- if ($role=~/^cr/) {
-# Custom role, defined by a user
-# e.g., user.role.cr/msu/smith/mynewrole
- if ($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) {
- ($trole,my $trest)=($role=~m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|);
- ($tend,$tstart)=split('_',$trest);
- } else {
- $trole=$role;
- }
- } elsif ($role =~ m|^gr/|) {
-# Role of member in a group, defined within a course/community
-# e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards
- ($trole,$tend,$tstart) = split(/_/,$role);
- next if ($tstart eq '-1');
- ($trole,$group_privs) = split(/\//,$trole);
- $group_privs = &unescape($group_privs);
- } else {
-# Just a normal role, defined in roles.tab
- ($trole,$tend,$tstart)=split(/_/,$role);
- }
- my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain,
- $username);
- @userroles{keys(%new_role)} = @new_role{keys(%new_role)};
- 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\//) {
-# Custom role, defined by a user
- &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
- } elsif ($trole eq 'gr') {
-# Role of a member in a group, defined within a course/community
- &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
- } else {
-# Normal role, defined in roles.tab
- &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
- }
- if ($trole ne 'gr') {
- my $cid = $tdomain.'_'.$trest;
- unless ($firstaccchk{$cid}) {
- if (ref($coursetimerstarts{$cid}) eq 'HASH') {
- foreach my $item (keys(%{$coursetimerstarts{$cid}})) {
- $firstaccenv{'course.'.$cid.'.firstaccess.'.$item} =
- $coursetimerstarts{$cid}{$item};
- }
- }
- $firstaccchk{$cid} = 1;
- }
- unless ($timerintchk{$cid}) {
- if (ref($coursetimerintervals{$cid}) eq 'HASH') {
- foreach my $item (keys(%{$coursetimerintervals{$cid}})) {
- $timerintenv{'course.'.$cid.'.timerinterval.'.$item} =
- $coursetimerintervals{$cid}{$item};
- }
- }
- $timerintchk{$cid} = 1;
- }
+ for my $area (grep { ! /^rolesdef_/ } keys %rolesdump) {
+ my $role = $rolesdump{$area};
+ $area =~ s/\_\w\w$//;
+
+ my ($trole, $tend, $tstart, $group_privs);
+
+ if ($role =~ /^cr/) {
+ # Custom role, defined by a user
+ # e.g., user.role.cr/msu/smith/mynewrole
+ if ($role =~ m|^(cr/$match_domain/$match_username/[a-zA-Z0-9]+)_(.*)$|) {
+ $trole = $1;
+ ($tend, $tstart) = split('_', $2);
+ } else {
+ $trole = $role;
+ }
+ } elsif ($role =~ m|^gr/|) {
+ # Role of member in a group, defined within a course/community
+ # e.g., user.role.gr/msu/04935610a19ee4a5fmsul1/leopards
+ ($trole, $tend, $tstart) = split(/_/, $role);
+ next if $tstart eq '-1';
+ ($trole, $group_privs) = split(/\//, $trole);
+ $group_privs = &unescape($group_privs);
+ } else {
+ # Just a normal role, defined in roles.tab
+ ($trole, $tend, $tstart) = split(/_/,$role);
+ }
+
+ my %new_role = &set_arearole($trole,$area,$tstart,$tend,$domain,
+ $username);
+ @userroles{keys(%new_role)} = @new_role{keys(%new_role)};
+
+ # role expired or not available yet?
+ $trole = '' if ($tend != 0 && $tend < $userroles{'user.login.time'}) or
+ ($tstart != 0 && $tstart > $userroles{'user.login.time'});
+
+ next if $area eq '' or $trole eq '';
+
+ my $spec = "$trole.$area";
+ my ($tdummy, $tdomain, $trest) = split(/\//, $area);
+
+ if ($trole =~ /^cr\//) {
+ # Custom role, defined by a user
+ &custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
+ } elsif ($trole eq 'gr') {
+ # Role of a member in a group, defined within a course/community
+ &group_roleprivs(\%allgroups,$area,$group_privs,$tend,$tstart);
+ next;
+ } else {
+ # Normal role, defined in roles.tab
+ &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
+ }
+
+ my $cid = $tdomain.'_'.$trest;
+ unless ($firstaccchk{$cid}) {
+ if (ref($coursetimerstarts{$cid}) eq 'HASH') {
+ foreach my $item (keys(%{$coursetimerstarts{$cid}})) {
+ $firstaccenv{'course.'.$cid.'.firstaccess.'.$item} =
+ $coursetimerstarts{$cid}{$item};
}
}
- }
+ $firstaccchk{$cid} = 1;
+ }
+ unless ($timerintchk{$cid}) {
+ if (ref($coursetimerintervals{$cid}) eq 'HASH') {
+ foreach my $item (keys(%{$coursetimerintervals{$cid}})) {
+ $timerintenv{'course.'.$cid.'.timerinterval.'.$item} =
+ $coursetimerintervals{$cid}{$item};
+ }
+ }
+ $timerintchk{$cid} = 1;
}
- my ($author,$adv) = &set_userprivs(\%userroles,\%allroles,\%allgroups);
- $userroles{'user.adv'} = $adv;
- $userroles{'user.author'} = $author;
- $env{'user.adv'}=$adv;
}
+
+ @userroles{'user.author', 'user.adv'} = &set_userprivs(\%userroles,
+ \%allroles, \%allgroups);
+ $env{'user.adv'} = $userroles{'user.adv'};
+
return (\%userroles,\%firstaccenv,\%timerintenv);
}
@@ -11696,7 +11692,8 @@
=item *
X<rolesinit()>
-B<rolesinit($udom,$username,$authhost)>: get user privileges
+B<rolesinit($udom,$username)>: get user privileges.
+returns user role, first access and timer interval hashes
=item *
X<getsection()>
More information about the LON-CAPA-cvs
mailing list