[LON-CAPA-cvs] cvs: loncom /auth loncacc.pm lonroles.pm /lonnet/perl lonnet.pm
raeburn
raeburn@source.lon-capa.org
Sat, 11 Apr 2009 21:43:02 -0000
This is a MIME encoded message
--raeburn1239486182
Content-Type: text/plain
raeburn Sat Apr 11 21:43:02 2009 EDT
Modified files:
/loncom/auth loncacc.pm lonroles.pm
/loncom/lonnet/perl lonnet.pm
Log:
Bug 5842.
- "Edit this resource" link is displayed in inline menu if user is a DC in domain of resource author, and author has not blocked DC access to CSTR.
- request for /priv/$author sets ad hoc co-author privs for user (if no existing privs) if user is a DC in author's CSTR, and if DC access is not blocked by author's user prefs.
&check_privs(), &set_privileges(), and &role_status() moved from lonroles.pm to lonnet.pm -- first two renamed as: check_adhoc_privs(), set_adhoc_privileges().
&is_active_dc() added to loncacc.pm to check if user has active DC role in resource author's domain.
--raeburn1239486182
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20090411214302.txt"
Index: loncom/auth/loncacc.pm
diff -u loncom/auth/loncacc.pm:1.48 loncom/auth/loncacc.pm:1.49
--- loncom/auth/loncacc.pm:1.48 Wed Nov 19 17:38:21 2008
+++ loncom/auth/loncacc.pm Sat Apr 11 21:42:58 2009
@@ -2,7 +2,7 @@
# Cookie Based Access Handler for Construction Area
# (lonacc: 5/21/99,5/22,5/29,5/31 Gerd Kortemeyer)
#
-# $Id: loncacc.pm,v 1.48 2008/11/19 17:38:21 jms Exp $
+# $Id: loncacc.pm,v 1.49 2009/04/11 21:42:58 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -97,7 +97,7 @@
use LONCAPA qw(:DEFAULT :match);
sub constructaccess {
- my ($url,$ownerdomain)=@_;
+ my ($url,$ownerdomain,$setpriv)=@_;
my ($ownername)=($url=~/\/(?:\~|priv\/|home\/)($match_username)\//);
unless (($ownername) && ($ownerdomain)) { return ''; }
# We do not allow editing of previous versions of files.
@@ -117,9 +117,42 @@
return ($ownername,$domain);
}
}
+
+ my $then=$env{'user.login.time'};
+ my %dcroles = ();
+ if (&is_active_dc($ownerdomain,$then)) {
+ my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],
+ $ownerdomain,$ownername);
+ unless ($blocked{'domcoord.author'} eq 'blocked') {
+ if (grep(/^$ownerdomain$/,@possibledomains)) {
+ if ($setpriv) {
+ my $now = time;
+ &Apache::lonnet::check_adhoc_privs($ownerdomain,$ownername,
+ $then,$now,'ca');
+ }
+ return($ownername,$ownerdomain);
+ }
+ }
+ }
return '';
}
+sub is_active_dc {
+ my ($ownerdomain,$then) = @_;
+ my $livedc;
+ if ($env{'user.adv'}) {
+ my $domrole = $env{'user.role.dc./'.$ownerdomain.'/'};
+ if ($domrole) {
+ my ($tstart,$tend)=split(/\./,$domrole);
+ $livedc = 1;
+ if ($tstart && $tstart>$then) { undef($livedc); }
+ if ($tend && $tend <$then) { undef($livedc); }
+ }
+ }
+ return $livedc;
+}
+
+
sub handler {
my $r = shift;
my $requrl=$r->uri;
@@ -141,7 +174,7 @@
$env{'request.state'} = "construct";
$env{'request.filename'} = $r->filename;
- unless (&constructaccess($requrl,$r->dir_config('lonDefDomain'))) {
+ unless (&constructaccess($requrl,$r->dir_config('lonDefDomain')),'setpriv') {
$r->log_reason("Unauthorized $requrl", $r->filename);
return HTTP_NOT_ACCEPTABLE;
}
Index: loncom/auth/lonroles.pm
diff -u loncom/auth/lonroles.pm:1.217 loncom/auth/lonroles.pm:1.218
--- loncom/auth/lonroles.pm:1.217 Thu Feb 26 16:17:33 2009
+++ loncom/auth/lonroles.pm Sat Apr 11 21:42:58 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.217 2009/02/26 16:17:33 schafran Exp $
+# $Id: lonroles.pm,v 1.218 2009/04/11 21:42:58 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -236,7 +236,8 @@
if (my ($domain,$coursenum) =
($envkey =~ m-^form\.cc\./($match_domain)/($match_courseid)$-)) {
if ($dcroles{$domain}) {
- &check_privs($domain,$coursenum,$then,$now,'cc');
+ &Apache::lonnet::check_adhoc_privs($domain,$coursenum,
+ $then,$now,'cc');
}
last;
}
@@ -276,7 +277,8 @@
if ($dcroles{$domain}) {
my ($server_status,$home) = &check_author_homeserver($user,$domain);
if (($server_status eq 'ok') || ($server_status eq 'switchserver')) {
- &check_privs($domain,$user,$then,$now,'ca');
+ &Apache::lonnet::check_adhoc_privs($domain,$user,$then,
+ $now,'ca');
if ($server_status eq 'switchserver') {
my $trolecode = 'ca./'.$domain.'/'.$user;
my $switchserver = '/adm/switchserver?'
@@ -297,7 +299,8 @@
foreach $envkey (keys %env) {
next if ($envkey!~/^user\.role\./);
my ($where,$trolecode,$role,$tstatus,$tend,$tstart);
- &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &Apache::lonnet::role_status($envkey,$then,$now,\$role,\$where,
+ \$trolecode,\$tstatus,\$tstart,\$tend);
if ($env{'form.'.$trolecode}) {
if ($tstatus eq 'is') {
$where=~s/^\///;
@@ -654,7 +657,8 @@
my $sortkey;
if ($envkey=~/^user\.role\./) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &role_status($envkey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &Apache::lonnet::role_status($envkey,$then,$now,\$role,\$where,
+ \$trolecode,\$tstatus,\$tstart,\$tend);
next if (!defined($role) || $role eq '' || $role =~ /^gr/);
my $timezone = &role_timezone($where,\%timezones);
$tremark='';
@@ -1181,31 +1185,6 @@
return $output;
}
-sub role_status {
- my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
- my @pwhere = ();
- if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
- (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
- unless (!defined($$role) || $$role eq '') {
- $$where=join('.',@pwhere);
- $$trolecode=$$role.'.'.$$where;
- ($$tstart,$$tend)=split(/\./,$env{$rolekey});
- $$tstatus='is';
- if ($$tstart && $$tstart>$then) {
- $$tstatus='future';
- if ($$tstart<$now) { $$tstatus='will'; }
- }
- if ($$tend) {
- if ($$tend<$then) {
- $$tstatus='expired';
- } elsif ($$tend<$now) {
- $$tstatus='will_not';
- }
- }
- }
- }
-}
-
sub build_roletext {
my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere,$tpstart,$tpend,$nochoose,$button,$switchserver,$reinit) = @_;
my $roletext=&Apache::loncommon::start_data_table_row();
@@ -1310,20 +1289,6 @@
}
}
-sub check_privs {
- my ($cdom,$cnum,$then,$now,$checkrole) = @_;
- my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
- if ($env{$cckey}) {
- my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
- unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
- &set_privileges($cdom,$cnum,$checkrole);
- }
- } else {
- &set_privileges($cdom,$cnum,$checkrole);
- }
-}
-
sub check_fordc {
my ($dcroles,$then) = @_;
my $numdc = 0;
@@ -1535,32 +1500,6 @@
return 'nohist_recent_'.&escape($area);
}
-sub set_privileges {
-# role can be cc or ca
- my ($dcdom,$pickedcourse,$role) = @_;
- my $area = '/'.$dcdom.'/'.$pickedcourse;
- my $spec = $role.'.'.$area;
- my %userroles = &Apache::lonnet::set_arearole($role,$area,'','',
- $env{'user.domain'},
- $env{'user.name'});
- my %ccrole = ();
- &Apache::lonnet::standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
- my ($author,$adv)= &Apache::lonnet::set_userprivs(\%userroles,\%ccrole);
- &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
-
- &Apache::lonnet::log($env{'user.domain'},
- $env{'user.name'},
- $env{'user.home'},
- "Role ".$role);
- &Apache::lonnet::appenv(
- {'request.role' => $spec,
- 'request.role.domain' => $dcdom,
- 'request.course.sec' => ''});
- my $tadv=0;
- if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
- &Apache::lonnet::appenv({'request.role.adv' => $tadv});
-}
-
sub courseloadpage {
my ($courseid) = @_;
my $startpage;
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.993 loncom/lonnet/perl/lonnet.pm:1.994
--- loncom/lonnet/perl/lonnet.pm:1.993 Sat Apr 11 14:47:51 2009
+++ loncom/lonnet/perl/lonnet.pm Sat Apr 11 21:43:02 2009
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.993 2009/04/11 14:47:51 raeburn Exp $
+# $Id: lonnet.pm,v 1.994 2009/04/11 21:43:02 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3880,6 +3880,67 @@
return ($author,$adv);
}
+sub role_status {
+ my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+ my @pwhere = ();
+ if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
+ (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
+ unless (!defined($$role) || $$role eq '') {
+ $$where=join('.',@pwhere);
+ $$trolecode=$$role.'.'.$$where;
+ ($$tstart,$$tend)=split(/\./,$env{$rolekey});
+ $$tstatus='is';
+ if ($$tstart && $$tstart>$then) {
+ $$tstatus='future';
+ if ($$tstart<$now) { $$tstatus='will'; }
+ }
+ if ($$tend) {
+ if ($$tend<$then) {
+ $$tstatus='expired';
+ } elsif ($$tend<$now) {
+ $$tstatus='will_not';
+ }
+ }
+ }
+ }
+}
+
+sub check_adhoc_privs {
+ my ($cdom,$cnum,$then,$now,$checkrole) = @_;
+ my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
+ if ($env{$cckey}) {
+ my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
+ &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
+ &set_adhoc_privileges($cdom,$cnum,$checkrole);
+ }
+ } else {
+ &set_adhoc_privileges($cdom,$cnum,$checkrole);
+ }
+}
+
+sub set_adhoc_privileges {
+# role can be cc or ca
+ my ($dcdom,$pickedcourse,$role) = @_;
+ my $area = '/'.$dcdom.'/'.$pickedcourse;
+ my $spec = $role.'.'.$area;
+ my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
+ $env{'user.name'});
+ my %ccrole = ();
+ &standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
+ my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
+ &appenv(\%userroles,[$role,'cm']);
+ &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+ &appenv( {'request.role' => $spec,
+ 'request.role.domain' => $dcdom,
+ 'request.course.sec' => ''
+ }
+ );
+ my $tadv=0;
+ if (&allowed('adv') eq 'F') { $tadv=1; }
+ &appenv({'request.role.adv' => $tadv});
+}
+
# --------------------------------------------------------------- get interface
sub get {
--raeburn1239486182--