[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Sun Oct 23 08:21:49 EDT 2016
raeburn Sun Oct 23 12:21:49 2016 EDT
Modified files: (Branch: version_2_11_X)
/loncom/lonnet/perl lonnet.pm
Log:
- For 2.11
- Backport 1.1326, 1.1327
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1172.2.83 loncom/lonnet/perl/lonnet.pm:1.1172.2.84
--- loncom/lonnet/perl/lonnet.pm:1.1172.2.83 Tue Sep 27 18:09:06 2016
+++ loncom/lonnet/perl/lonnet.pm Sun Oct 23 12:21:47 2016
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.83 2016/09/27 18:09:06 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.84 2016/10/23 12:21:47 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3908,7 +3908,7 @@
}
}
#
-# Reverse lookup of domain roles (dc, ad, li, sc, au)
+# Reverse lookup of domain roles (dc, ad, li, sc, dh, au)
#
my %domrolebuffer = ();
foreach my $entry (keys(%domainrolehash)) {
@@ -4055,7 +4055,7 @@
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
=$tend.':'.$tstart;
}
- if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) {
+ if ($trole =~ /^(dc|ad|li|au|dg|sc|dh)/ ) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$domainrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
@@ -5736,15 +5736,19 @@
}
sub set_adhoc_privileges {
-# role can be cc or ca
+# role can be cc, ca, or cr/<dom>/<dom>-domainconfig/role
my ($dcdom,$pickedcourse,$role,$caller) = @_;
my $area = '/'.$dcdom.'/'.$pickedcourse;
my $spec = $role.'.'.$area;
my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
$env{'user.name'},1);
- my %ccrole = ();
- &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
- my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+ my %rolehash = ();
+ if ($role =~ m{^cr/$dcdom/$dcdom\Q-domainconfig\E/}) {
+ &custom_roleprivs(\%rolehash,$role,$dcdom,$pickedcourse,$spec,$area);
+ } else {
+ &standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area);
+ }
+ my ($author,$adv)= &set_userprivs(\%userroles,\%rolehash);
&appenv(\%userroles,[$role,'cm']);
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
@@ -7655,7 +7659,7 @@
sub definerole {
if (allowed('mcr','/')) {
- my ($rolename,$sysrole,$domrole,$courole)=@_;
+ my ($rolename,$sysrole,$domrole,$courole,$uname,$udom)=@_;
foreach my $role (split(':',$sysrole)) {
my ($crole,$cqual)=split(/\&/,$role);
if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }
@@ -7683,11 +7687,19 @@
}
}
}
+ my $uhome;
+ if (($uname ne '') && ($udom ne '')) {
+ $uhome = &homeserver($uname,$udom);
+ return $uhome if ($uhome eq 'no_host');
+ } else {
+ $uname = $env{'user.name'};
+ $udom = $env{'user.domain'};
+ $uhome = $env{'user.home'};
+ }
my $command="encrypt:rolesput:$env{'user.domain'}:$env{'user.name'}:".
- "$env{'user.domain'}:$env{'user.name'}:".
- "rolesdef_$rolename=".
+ "$udom:$uname:rolesdef_$rolename=".
escape($sysrole.'_'.$domrole.'_'.$courole);
- return reply($command,$env{'user.home'});
+ return reply($command,$uhome);
} else {
return 'refused';
}
@@ -8734,7 +8746,7 @@
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$selfenroll,$context);
} elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
- ($role eq 'au') || ($role eq 'dc')) {
+ ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh')) {
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$context);
} elsif (($role eq 'ca') || ($role eq 'aa')) {
@@ -13226,9 +13238,10 @@
=item *
-definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom
-role rolename set privileges in format of lonTabs/roles.tab for system, domain,
-and course level
+definerole($rolename,$sysrole,$domrole,$courole,$uname,$udom) : define role;
+define a custom role rolename set privileges in format of lonTabs/roles.tab
+for system, domain, and course level. $uname and $udom are optional (current
+user's username and domain will be used when either of $uname or $udom are absent.
=item *
More information about the LON-CAPA-cvs
mailing list