[LON-CAPA-cvs] cvs: loncom(loncapaMITrelate_1) /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Tue Feb 7 20:05:21 EST 2012
raeburn Wed Feb 8 01:05:21 2012 EDT
Modified files: (Branch: loncapaMITrelate_1)
/loncom/lonnet/perl lonnet.pm
Log:
- Customization for MITrelate
- Backport 1.1104.
-------------- next part --------------
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1056.4.33.2.1 loncom/lonnet/perl/lonnet.pm:1.1056.4.33.2.2
--- loncom/lonnet/perl/lonnet.pm:1.1056.4.33.2.1 Wed Feb 1 18:27:09 2012
+++ loncom/lonnet/perl/lonnet.pm Wed Feb 8 01:05:20 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1056.4.33.2.1 2012/02/01 18:27:09 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.33.2.2 2012/02/08 01:05:20 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -636,11 +636,20 @@
# ----------------------------------------------------- Delete from Environment
sub delenv {
- my ($delthis,$regexp) = @_;
- if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
- &logthis("<font color=\"blue\">WARNING: ".
- "Attempt to delete from environment ".$delthis);
- return 'error';
+ my ($delthis,$regexp,$roles) = @_;
+ if (($delthis=~/^user\.role/) || ($delthis=~/^user\.priv/)) {
+ my $refused = 1;
+ if (ref($roles) eq 'ARRAY') {
+ my ($type,$role) = ($delthis =~ /^user\.(role|priv)\.([^.]+)\./);
+ if (grep(/^\Q$role\E$/,@{$roles})) {
+ $refused = 0;
+ }
+ }
+ if ($refused) {
+ &logthis("<font color=\"blue\">WARNING: ".
+ "Attempt to delete from environment ".$delthis);
+ return 'error';
+ }
}
my $opened = open(my $env_file,'+<',$env{'user.environment'});
if ($opened
@@ -3225,6 +3234,10 @@
if (!grep(/^cr$/,@{$roles})) {
next;
}
+ } elsif ($role =~ /^gr\//) {
+ if (!grep(/^gr$/,@{$roles})) {
+ next;
+ }
} else {
next;
}
@@ -4237,7 +4250,6 @@
}
my %allroles=();
my %allgroups=();
- my $group_privs;
if ($rolesdump ne '') {
foreach my $entry (split(/&/,$rolesdump)) {
@@ -4254,6 +4266,7 @@
}
} elsif ($role =~ m|^gr/|) {
($trole,$tend,$tstart) = split(/_/,$role);
+ next if ($tstart eq '-1');
($trole,$group_privs) = split(/\//,$trole);
$group_privs = &unescape($group_privs);
} else {
@@ -4406,7 +4419,7 @@
}
}
my $thesestr='';
- foreach my $priv (keys(%thesepriv)) {
+ foreach my $priv (sort(keys(%thesepriv))) {
$thesestr.=':'.$priv.'&'.$thesepriv{$priv};
}
$userroles->{'user.priv.'.$role} = $thesestr;
@@ -4415,7 +4428,7 @@
}
sub role_status {
- my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+ my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
my @pwhere = ();
if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
(undef,undef,$$role, at pwhere)=split(/\./,$rolekey);
@@ -4424,7 +4437,7 @@
$$trolecode=$$role.'.'.$$where;
($$tstart,$$tend)=split(/\./,$env{$rolekey});
$$tstatus='is';
- if ($$tstart && $$tstart>$then) {
+ if ($$tstart && $$tstart>$update) {
$$tstatus='future';
if ($$tstart<$now) {
if ($$tstart && $$tstart>$refresh) {
@@ -4449,32 +4462,9 @@
$group_privs = &unescape($group_privs);
&group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);
- if (keys(%course_roles) > 0) {
- my ($tnum) = ($trest =~ /^($match_courseid)/);
- if ($tdomain ne '' && $tnum ne '') {
- foreach my $key (keys(%course_roles)) {
- if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) {
- my $crsrole = $1;
- my $crssec = $2;
- if ($crsrole =~ /^cr/) {
- unless (grep(/^cr$/, at rolecodes)) {
- push(@rolecodes,'cr');
- }
- } else {
- unless(grep(/^\Q$crsrole\E$/, at rolecodes)) {
- push(@rolecodes,$crsrole);
- }
- }
- my $rolekey = $crsrole.'./'.$tdomain.'/'.$tnum;
- if ($crssec ne '') {
- $rolekey .= '/'.$crssec;
- }
- $rolekey .= './';
- $groups_roles{$rolekey} = \@rolecodes;
- }
- }
- }
- }
+ &get_groups_roles($tdomain,$trest,
+ \%course_roles,\@rolecodes,
+ \%groups_roles);
} else {
push(@rolecodes,$$role);
&standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
@@ -4488,7 +4478,7 @@
}
}
if ($$tend) {
- if ($$tend<$then) {
+ if ($$tend<$update) {
$$tstatus='expired';
} elsif ($$tend<$now) {
$$tstatus='will_not';
@@ -4498,12 +4488,70 @@
}
}
+sub get_groups_roles {
+ my ($cdom,$rest,$cdom_courseroles,$rolecodes,$groups_roles) = @_;
+ return unless((ref($cdom_courseroles) eq 'HASH') &&
+ (ref($rolecodes) eq 'ARRAY') &&
+ (ref($groups_roles) eq 'HASH'));
+ if (keys(%{$cdom_courseroles}) > 0) {
+ my ($cnum) = ($rest =~ /^($match_courseid)/);
+ if ($cdom ne '' && $cnum ne '') {
+ foreach my $key (keys(%{$cdom_courseroles})) {
+ if ($key =~ /^\Q$cnum\E:\Q$cdom\E:([^:]+):?([^:]*)/) {
+ my $crsrole = $1;
+ my $crssec = $2;
+ if ($crsrole =~ /^cr/) {
+ unless (grep(/^cr$/,@{$rolecodes})) {
+ push(@{$rolecodes},'cr');
+ }
+ } else {
+ unless(grep(/^\Q$crsrole\E$/,@{$rolecodes})) {
+ push(@{$rolecodes},$crsrole);
+ }
+ }
+ my $rolekey = "$crsrole./$cdom/$cnum";
+ if ($crssec ne '') {
+ $rolekey .= "/$crssec";
+ }
+ $rolekey .= './';
+ $groups_roles->{$rolekey} = $rolecodes;
+ }
+ }
+ }
+ }
+ return;
+}
+
+sub delete_env_groupprivs {
+ my ($where,$courseroles,$possroles) = @_;
+ return unless((ref($courseroles) eq 'HASH') && (ref($possroles) eq 'ARRAY'));
+ my ($dummy,$udom,$uname,$group) = split(/\//,$where);
+ unless (ref($courseroles->{$udom}) eq 'HASH') {
+ %{$courseroles->{$udom}} =
+ &get_my_roles('','','userroles',['active'],
+ $possroles,[$udom],1);
+ }
+ if (ref($courseroles->{$udom}) eq 'HASH') {
+ foreach my $item (keys(%{$courseroles->{$udom}})) {
+ my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
+ my $area = '/'.$cdom.'/'.$cnum;
+ my $privkey = "user.priv.$crsrole.$area";
+ if ($crssec ne '') {
+ $privkey .= '/'.$crssec;
+ }
+ $privkey .= ".$area/$group";
+ &Apache::lonnet::delenv($privkey,undef,[$crsrole]);
+ }
+ }
+ return;
+}
+
sub check_adhoc_privs {
- my ($cdom,$cnum,$then,$refresh,$now,$checkrole,$caller) = @_;
+ my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
if ($env{$cckey}) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller);
}
More information about the LON-CAPA-cvs
mailing list