--- loncom/auth/lonroles.pm 2012/02/09 01:11:52 1.256.2.6.2.3
+++ loncom/auth/lonroles.pm 2014/03/25 10:18:04 1.256.2.7
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.256.2.6.2.3 2012/02/09 01:11:52 raeburn Exp $
+# $Id: lonroles.pm,v 1.256.2.7 2014/03/25 10:18:04 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,7 +57,8 @@ course they should act on, etc. Both in
handler determines via C".&mt('Sorry ...')."
\n".
- &mt('This action is currently not authorized.').''.
- &Apache::loncommon::end_page());
- return OK;
+ $r->print("".&mt('Sorry ...')."
\n".
+ &mt('This action is currently not authorized.').''.
+ &Apache::loncommon::end_page());
+ return OK;
} else {
- $r->print($updateresult);
if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) {
- $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
+ $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'};
}
$r->print('\n");
- $r->rflush();
- $r->print('');
- $r->print(&Apache::loncommon::end_page());
- return OK;
- }
- if ($needs_switchserver) {
- $r->print("".&mt('Server Switch Required')."
\n".
- &mt('Construction Space access is only available from '.
- 'the home server of the corresponding Author.').'
'.
- &mt("Click the 'Switch Server' link to go there.").'
');
- }
}
# ----------------------------------------------------------------------- Table
@@ -1017,7 +941,7 @@ ENDHEADER
}
sub gather_roles {
- my ($update,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones,$loncaparev) = @_;
+ my ($then,$refresh,$now,$reinit,$nochoose,$roletext,$sortrole,$roleclass,$futureroles,$timezones,$loncaparev) = @_;
my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,'');
my $advanced = $env{'user.adv'};
my $tryagain = $env{'form.tryagain'};
@@ -1029,7 +953,7 @@ sub gather_roles {
my ($role_text,$role_text_end,$sortkey);
if ($envkey=~/^user\.role\./) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
+ &Apache::lonnet::role_status($envkey,$then,$refresh,$now,\$role,\$where,
\$trolecode,\$tstatus,\$tstart,\$tend);
next if (!defined($role) || $role eq '' || $role =~ /^gr/);
$tremark='';
@@ -1573,7 +1497,7 @@ sub check_author_homeserver {
}
sub check_fordc {
- my ($dcroles,$update,$then) = @_;
+ my ($dcroles,$then) = @_;
my $numdc = 0;
if ($env{'user.adv'}) {
foreach my $envkey (sort keys %env) {
@@ -1581,12 +1505,8 @@ sub check_fordc {
my $dcdom = $1;
my $livedc = 1;
my ($tstart,$tend)=split(/\./,$env{$envkey});
- my $limit = $update;
- if ($env{'request.role'} eq 'dc./'.$dcdom.'/') {
- $limit = $then;
- }
- if ($tstart && $tstart>$limit) { $livedc = 0; }
- if ($tend && $tend <$limit) { $livedc = 0; }
+ if ($tstart && $tstart>$then) { $livedc = 0; }
+ if ($tend && $tend <$then) { $livedc = 0; }
if ($livedc) {
$$dcroles{$dcdom} = $envkey;
$numdc++;
@@ -1598,19 +1518,19 @@ sub check_fordc {
}
sub adhoc_course_role {
- my ($refresh,$update,$then) = @_;
+ my ($refresh,$then) = @_;
my ($cdom,$cnum,$crstype);
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
$cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
$crstype = &Apache::loncommon::course_type();
- if (&check_forcc($cdom,$cnum,$refresh,$update,$then,$crstype)) {
+ if (&check_forcc($cdom,$cnum,$refresh,$then,$crstype)) {
my $setprivs;
if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
$setprivs = 1;
} else {
my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
if (($start && ($start>$refresh || $start == -1)) ||
- ($end && $end<$update)) {
+ ($end && $end<$then)) {
$setprivs = 1;
}
}
@@ -1653,7 +1573,7 @@ sub adhoc_course_role {
}
sub check_forcc {
- my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
+ my ($cdom,$cnum,$refresh,$then,$crstype) = @_;
my ($is_cc,$ccrole);
if ($crstype eq 'Community') {
$ccrole = 'co';
@@ -1666,12 +1586,8 @@ sub check_forcc {
if (defined($env{$envkey})) {
$is_cc = 1;
my ($tstart,$tend)=split(/\./,$env{$envkey});
- my $limit = $update;
- if ($env{'request.role'} eq $ccrole.'./'.$cdom.'/'.$cnum) {
- $limit = $then;
- }
if ($tstart && $tstart>$refresh) { $is_cc = 0; }
- if ($tend && $tend <$limit) { $is_cc = 0; }
+ if ($tend && $tend <$then) { $is_cc = 0; }
}
}
}
@@ -1688,7 +1604,7 @@ sub check_release_required {
my $otherserver;
if (($major eq '' && $minor eq '') ||
(($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
- my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'});
+ my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'},undef,$required);
my $switchlcrev =
&Apache::lonnet::get_server_loncaparev($env{'user.domain'},
$userdomserver);
@@ -1902,644 +1818,6 @@ sub courseloadpage {
return $startpage;
}
-sub update_session_roles {
- my $then=$env{'user.login.time'};
- my $refresh=$env{'user.refresh.time'};
- if (!$refresh) {
- $refresh = $then;
- }
- my $update = $env{'user.update.time'};
- if (!$update) {
- $update = $then;
- }
- my $now = time;
- my %roleshash =
- &Apache::lonnet::get_my_roles('','','userroles',
- ['active','future','previous'],
- undef,undef,1);
- my ($msg,@newsec,$oldsec,$currrole_expired,@changed_roles,
- %changed_groups,%dbroles,%deletedroles,%allroles,%allgroups,
- %userroles,%checkedgroup,%crprivs,$hasgroups,%rolechange,
- %groupchange,%newrole,%newgroup,%customprivchg,%groups_roles,
- @rolecodes);
- my @possroles = ('cr','st','ta','ad','ep','in','co','cc');
- my %courseroles;
- foreach my $item (keys(%roleshash)) {
- my ($uname,$udom,$role,$remainder) = split(/:/,$item,4);
- my ($tstart,$tend) = split(/:/,$roleshash{$item});
- my ($section,$group,@group_privs);
- if ($role =~ m{^gr/(\w*)$}) {
- $role = 'gr';
- my $priv = $1;
- next if ($tstart eq '-1');
- if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
- if ($priv ne '') {
- push(@group_privs,$priv);
- }
- }
- if ($remainder =~ /:/) {
- (my $additional_privs,$group) =
- ($remainder =~ /^([\w:]+):([^:]+)$/);
- if ($additional_privs ne '') {
- if (&curr_role_status($tstart,$tend,$refresh,$now) eq 'active') {
- push(@group_privs,split(/:/,$additional_privs));
- @group_privs = sort(@group_privs);
- }
- }
- } else {
- $group = $remainder;
- }
- } else {
- $section = $remainder;
- }
- my $where = "/$udom/$uname";
- if ($section ne '') {
- $where .= "/$section";
- } elsif ($group ne '') {
- $where .= "/$group";
- }
- my $rolekey = "$role.$where";
- my $envkey = "user.role.$rolekey";
- $dbroles{$envkey} = 1;
- if (($env{'request.role'} eq $rolekey) && ($role ne 'st')) {
- if (&curr_role_status($tstart,$tend,$refresh,$now) ne 'active') {
- $currrole_expired = 1;
- }
- }
- if ($env{$envkey} eq '') {
- my $status_in_db =
- &curr_role_status($tstart,$tend,$refresh,$now);
- &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
- if (($role eq 'st') && ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
- if ($status_in_db eq 'active') {
- if ($section eq '') {
- push(@newsec,'none');
- } else {
- push(@newsec,$section);
- }
- }
- } else {
- unless (grep(/^\Q$role\E$/,@changed_roles)) {
- push(@changed_roles,$role);
- }
- if ($status_in_db ne 'previous') {
- if ($role eq 'gr') {
- $newgroup{$rolekey} = $status_in_db;
- if ($status_in_db eq 'active') {
- unless (ref($courseroles{$udom}) eq 'HASH') {
- %{$courseroles{$udom}} =
- &Apache::lonnet::get_my_roles('','','userroles',
- ['active'],\@possroles,
- [$udom],1);
- }
- &Apache::lonnet::get_groups_roles($udom,$uname,
- $courseroles{$udom},
- \@rolecodes,\%groups_roles);
- }
- } else {
- $newrole{$rolekey} = $status_in_db;
- }
- }
- }
- } else {
- my ($currstart,$currend) = split(/\./,$env{$envkey});
- if ($role eq 'gr') {
- if (&curr_role_status($currstart,$currend,$refresh,$update) ne 'previous') {
- $hasgroups = 1;
- }
- }
- if (($currstart ne $tstart) || ($currend ne $tend)) {
- my $status_in_env =
- &curr_role_status($currstart,$currend,$refresh,$update);
- my $status_in_db =
- &curr_role_status($tstart,$tend,$refresh,$now);
- if ($status_in_env ne $status_in_db) {
- if ($status_in_env eq 'active') {
- if ($role eq 'st') {
- if ($env{'request.role'} eq $rolekey) {
- my $switchsection;
- unless (ref($courseroles{$udom}) eq 'HASH') {
- %{$courseroles{$udom}} =
- &Apache::lonnet::get_my_roles('','','userroles',
- ['active'],
- \@possroles,[$udom],1);
- }
- foreach my $crsrole (keys(%{$courseroles{$udom}})) {
- if ($crsrole =~ /^\Q$uname\E:\Q$udom\E:st/) {
- $switchsection = 1;
- last;
- }
- }
- if ($switchsection) {
- if ($section eq '') {
- $oldsec = 'none';
- } else {
- $oldsec = $section;
- }
- &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
- } else {
- $currrole_expired = 1;
- next;
- }
- }
- }
- unless ($rolekey eq $env{'request.role'}) {
- if ($role eq 'gr') {
- &Apache::lonnet::delete_env_groupprivs($where,\%courseroles,\@possroles);
- } else {
- &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
- &Apache::lonnet::delenv("user.priv.cm.$where",undef,['cm']);
- }
- &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
- }
- } elsif ($status_in_db eq 'active') {
- if (($role eq 'st') &&
- ($env{'request.role'} =~ m{^\Q$role\E\.\Q/$udom/$uname\E})) {
- if ($section eq '') {
- push(@newsec,'none');
- } else {
- push(@newsec,$section);
- }
- } elsif ($role eq 'gr') {
- unless (ref($courseroles{$udom}) eq 'HASH') {
- %{$courseroles{$udom}} =
- &Apache::lonnet::get_my_roles('','','userroles',
- ['active'],
- \@possroles,[$udom],1);
- }
- &Apache::lonnet::get_groups_roles($udom,$uname,
- $courseroles{$udom},
- \@rolecodes,\%groups_roles);
- }
- &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
- }
- unless (grep(/^\Q$role\E$/,@changed_roles)) {
- push(@changed_roles,$role);
- }
- if ($role eq 'gr') {
- $groupchange{"/$udom/$uname"}{$group} = $status_in_db;
- } else {
- $rolechange{$rolekey} = $status_in_db;
- }
- }
- } else {
- if ($role eq 'gr') {
- unless ($checkedgroup{$where}) {
- my $status_in_db =
- &curr_role_status($tstart,$tend,$refresh,$now);
- if ($tstart eq '-1') {
- $status_in_db = 'deleted';
- }
- unless (ref($courseroles{$udom}) eq 'HASH') {
- %{$courseroles{$udom}} =
- &Apache::lonnet::get_my_roles('','','userroles',
- ['active'],
- \@possroles,[$udom],1);
- }
- if (ref($courseroles{$udom}) eq 'HASH') {
- foreach my $item (keys(%{$courseroles{$udom}})) {
- next unless ($item =~ /^\Q$uname\E/);
- my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);
- my $area = '/'.$cdom.'/'.$cnum;
- if ($crssec ne '') {
- $area .= '/'.$crssec;
- }
- my $crsrolekey = $crsrole.'.'.$area;
- my $currprivs = $env{'user.priv.'.$crsrole.'.'.$area.'.'.$where};
- $currprivs =~ s/^://;
- $currprivs =~ s/\&F$//;
- my @curr_grp_privs = split(/\&F:/,$currprivs);
- @curr_grp_privs = sort(@curr_grp_privs);
- my @diffs;
- if (@group_privs > 0 || @curr_grp_privs > 0) {
- @diffs = &Apache::loncommon::compare_arrays(\@group_privs,\@curr_grp_privs);
- }
- if (@diffs == 0) {
- last;
- } else {
- unless(grep(/^\Qgr\E$/,@rolecodes)) {
- push(@rolecodes,'gr');
- }
- &gather_roleprivs(\%allroles,\%allgroups,
- \%userroles,$where,$role,
- $tstart,$tend,$status_in_db);
- if ($status_in_db eq 'active') {
- &Apache::lonnet::get_groups_roles($udom,$uname,
- $courseroles{$udom},
- \@rolecodes,\%groups_roles);
- }
- $changed_groups{$udom.'_'.$uname}{$group} = $status_in_db;
- last;
- }
- }
- }
- $checkedgroup{$where} = 1;
- }
- } elsif ($role =~ /^cr/) {
- my $status_in_db =
- &curr_role_status($tstart,$tend,$refresh,$now);
- my ($rdummy,$rest) = split(/\//,$role,2);
- my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role);
- my %currpriv;
- unless (exists($crprivs{$rest})) {
- my ($rdomain,$rauthor,$rrole)=split(/\//,$rest);
- my $homsvr=&Apache::lonnet::homeserver($rauthor,$rdomain);
- if (&Apache::lonnet::hostname($homsvr) ne '') {
- my ($rdummy,$roledef)=
- &Apache::lonnet::get('roles',["rolesdef_$rrole"],
- $rdomain,$rauthor);
- if (($rdummy ne 'con_lost') && ($roledef ne '')) {
- my $i = 0;
- my @scopes = ('sys','dom','crs');
- my @privs = split(/\_/,$roledef);
- foreach my $priv (@privs) {
- my ($blank,@prv) = split(/:/,$priv);
- @prv = map { $_ .= (/\&\w+$/ ? '':'&F') } @prv;
- if (@prv) {
- $priv = ':'.join(':',sort(@prv));
- }
- $crprivs{$rest}{$scopes[$i]} = $priv;
- $i++;
- }
- }
- }
- }
- $currpriv{sys} = $env{"user.priv.$rolekey./"};
- $currpriv{dom} = $env{"user.priv.$rolekey./$udom/"};
- $currpriv{crs} = $env{"user.priv.$rolekey.$where"};
- if (keys(%crprivs)) {
- if (($crprivs{$rest}{sys} ne $currpriv{sys}) ||
- ($crprivs{$rest}{dom} ne $currpriv{dom})
- ||
- ($crprivs{$rest}{crs} ne $currpriv{crs})) {
- &gather_roleprivs(\%allroles,\%allgroups,\%userroles,$where,$role,$tstart,$tend,$status_in_db);
- unless (grep(/^\Q$role\E$/,@changed_roles)) {
- push(@changed_roles,$role);
- }
- my $status_in_env =
- &curr_role_status($currstart,$currend,$refresh,$update);
- if ($status_in_env eq 'active') {
- $customprivchg{$rolekey} = $status_in_env;
- }
- }
- }
- }
- }
- }
- }
- foreach my $envkey (keys(%env)) {
- next unless ($envkey =~ /^user\.role\./);
- next if ($dbroles{$envkey});
- next if ($envkey eq 'user.role.'.$env{'request.role'});
- my ($currstart,$currend) = split(/\./,$env{$envkey});
- my $status_in_env =
- &curr_role_status($currstart,$currend,$refresh,$update);
- my ($rolekey) = ($envkey =~ /^user\.role\.(.+)$/);
- my ($role,$rest)=split(/\./,$rolekey,2);
- if (&Apache::lonnet::delenv($envkey,undef,[$role])) {
- if ($status_in_env eq 'active') {
- if ($role eq 'gr') {
- &Apache::lonnet::delete_env_groupprivs($rest,\%courseroles,
- \@possroles);
- } else {
- &Apache::lonnet::delenv("user.priv.$rolekey",undef,[$role]);
- &Apache::lonnet::delenv("user.priv.cm.$rest",undef,['cm']);
- }
- unless (grep(/^\Q$role\E$/,@changed_roles)) {
- push(@changed_roles,$role);
- }
- $deletedroles{$rolekey} = 1;
- }
- }
- }
- if (($oldsec) && (@newsec > 0)) {
- if (@newsec > 1) {
- $msg = '
';
- my $button = '';
- if ($newsec[0] eq 'none') {
- $msg .= &mt('[_1] to continue with your new section-less role.',$button);
- } else {
- $msg .= &mt('[_1] to continue with your new role in section ([_2]).',$button,$newsec[0]);
- }
- $msg .= '