--- loncom/auth/lonroles.pm 2000/10/05 19:15:34 1.12
+++ loncom/auth/lonroles.pm 2009/02/09 04:14:03 1.216
@@ -1,300 +1,1676 @@
# The LearningOnline Network with CAPA
# User Roles Screen
-# (Directory Indexer
-# (Login Screen
-# 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14 Gerd Kortemeyer)
-# 11/23 Gerd Kortemeyer)
-# 1/14,03/06,06/01,07/22,07/24,07/25,
-# 09/04,09/06,09/28,09/29,09/30,10/2,10/5 Gerd Kortemeyer
#
+# $Id: lonroles.pm,v 1.216 2009/02/09 04:14:03 raeburn Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
+#
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+#
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+###
+
+=pod
+
+=head1 NAME
+
+Apache::lonroles - User Roles Screen
+
+=head1 SYNOPSIS
+
+Invoked by /etc/httpd/conf/srm.conf:
+
+
+ PerlAccessHandler Apache::lonacc
+ SetHandler perl-script
+ PerlHandler Apache::lonroles
+ ErrorDocument 403 /adm/login
+ ErrorDocument 500 /adm/errorhandler
+
+
+=head1 OVERVIEW
+
+=head2 Choosing Roles
+
+C is a handler that allows a user to switch roles in
+mid-session. LON-CAPA attempts to work with "No Role Specified", the
+default role that a user has before selecting a role, as widely as
+possible, but certain handlers for example need specification which
+course they should act on, etc. Both in this scenario, and when the
+handler determines via C's C<&allowed> function that a certain
+action is not allowed, C is used as error handler. This
+allows the user to select another role which may have permission to do
+what they were trying to do. C can also be accessed via the
+B button in the Remote Control.
+
+=begin latex
+
+\begin{figure}
+\begin{center}
+\includegraphics[width=0.45\paperwidth,keepaspectratio]{Sample_Roles_Screen}
+ \caption{\label{Sample_Roles_Screen}Sample Roles Screen}
+\end{center}
+\end{figure}
+
+=end latex
+
+=head2 Role Initialization
+
+The privileges for a user are established at login time and stored in the session environment. As a consequence, a new role does not become active till the next login. Handlers are able to query for privileges using C's C<&allowed> function. When a user first logs in, their role is the "common" role, which means that they have the sum of all of their privileges. During a session it might become necessary to choose a particular role, which as a consequence also limits the user to only the privileges in that particular role.
+
+=head1 INTRODUCTION
+
+This module enables a user to select what role he wishes to
+operate under (instructor, student, teaching assistant, course
+coordinator, etc). These roles are pre-established by the actions
+of upper-level users.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+=head1 HANDLER SUBROUTINE
+
+This routine is called by Apache and mod_perl.
+
+=over 4
+
+=item *
+
+Roles Initialization (yes/no)
+
+=item *
+
+Get Error Message from Environment
+
+=item *
+
+Who is this?
+
+=item *
+
+Generate Page Output
+
+=item *
+
+Choice or no choice
+
+=item *
+
+Table
+
+=item *
+
+Privileges
+
+=back
+
+=cut
+
+
package Apache::lonroles;
use strict;
-use Apache::lonnet();
+use Apache::lonnet;
use Apache::lonuserstate();
use Apache::Constants qw(:common);
use Apache::File();
+use Apache::lonmenu;
+use Apache::loncommon;
+use Apache::lonhtmlcommon;
+use Apache::lonannounce;
+use Apache::lonlocal;
+use Apache::lonpageflip();
+use Apache::lonnavdisplay();
+use GDBM_File;
+use LONCAPA qw(:DEFAULT :match);
+use HTML::Entities;
+
+
+sub redirect_user {
+ my ($r,$title,$url,$msg,$launch_nav) = @_;
+ $msg = $title if (! defined($msg));
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ my $swinfo=&Apache::lonmenu::rawconfig();
+ my $navwindow;
+ if ($launch_nav eq 'on') {
+ $navwindow.=&Apache::lonnavdisplay::launch_win('now',undef,undef,
+ ($url =~ m-^/adm/whatsnew-));
+ } else {
+ $navwindow.=&Apache::lonnavmaps::close();
+ }
+ my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
+ {'redirect' => [1,$url],});
+ my $end_page = &Apache::loncommon::end_page();
+
+# Note to style police:
+# This must only replace the spaces, nothing else, or it bombs elsewhere.
+ $url=~s/ /\%20/g;
+ $r->print(<
+$swinfo
+
+$navwindow
+
$msg
+$end_page
+ENDREDIR
+ return;
+}
+
+sub error_page {
+ my ($r,$error,$dest)=@_;
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ return OK if $r->header_only;
+ $r->print(&Apache::loncommon::start_page('Problems during Course Initialization').
+ ''.
+ '
'.&mt('The following problems occurred:').
+ $error.
+ '
'.&mt('Continue').''.
+ &Apache::loncommon::end_page());
+}
sub handler {
my $r = shift;
my $now=time;
- my $then=$ENV{'user.login.time'};
+ my $then=$env{'user.login.time'};
my $envkey;
-
+ my %dcroles = ();
+ my $numdc = &check_fordc(\%dcroles,$then);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
# ================================================================== Roles Init
+ if ($env{'form.selectrole'}) {
- if ($ENV{'form.selectrole'}) {
- foreach $envkey (keys %ENV) {
- if ($envkey=~/^user\.role\./) {
- my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
- my $where=join('.',@pwhere);
- my $trolecode=$role.'.'.$where;
- if ($ENV{'form.'.$trolecode}) {
- my ($tstart,$tend)=split(/\./,$ENV{$envkey});
- my $tstatus='is';
- if ($tstart) {
- if ($tstart>$then) {
- $tstatus='future';
- }
- }
- if ($tend) {
- if ($tend<$then) { $tstatus='expired'; }
- if ($tend>$now) { $tstatus='will_not'; }
- }
- if ($tstatus eq 'is') {
- &Apache::lonnet::appenv('request.role' => $trolecode);
- my ($cdom,$cnum)=split(/\//,$where);
- if ($cnum) {
- &Apache::lonuserstate::readmap($where);
- if ($ENV{'form.orgurl'}) {
- $r->internal_redirect($ENV{'form.orgurl'});
- return OK;
- }
- }
- }
- }
- }
+ my $locknum=&Apache::lonnet::get_locks();
+ if ($locknum) { return 409; }
+
+ if ($env{'form.newrole'}) {
+ $env{'form.'.$env{'form.newrole'}}=1;
+ }
+ if ($env{'request.course.id'}) {
+ # Check if user is CC trying to select a course role
+ if ($env{'form.switchrole'}) {
+ if (!defined($env{'user.role.'.$env{'form.switchrole'}})) {
+ &adhoc_course_role($then);
+ }
+ }
+ my %temp=('logout_'.$env{'request.course.id'} => time);
+ &Apache::lonnet::put('email_status',\%temp);
+ &Apache::lonnet::delenv('user.state.'.$env{'request.course.id'});
+ }
+ &Apache::lonnet::appenv({"request.course.id" => '',
+ "request.course.fn" => '',
+ "request.course.uri" => '',
+ "request.course.sec" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.role.domain" => $env{'user.domain'}});
+# Check if user is a DC trying to enter a course or author space and needs privs to be created
+ if ($numdc > 0) {
+ foreach my $envkey (keys %env) {
+# Is this an ad-hoc CC-role?
+ if (my ($domain,$coursenum) =
+ ($envkey =~ m-^form\.cc\./($match_domain)/($match_courseid)$-)) {
+ if ($dcroles{$domain}) {
+ &check_privs($domain,$coursenum,$then,$now,'cc');
+ }
+ last;
+ }
+# Is this an ad-hoc CA-role?
+ if (my ($domain,$user) =
+ ($envkey =~ m-^form\.ca\./($match_domain)/($match_username)$-)) {
+ if (($domain eq $env{'user.domain'}) && ($user eq $env{'user.name'})) {
+ delete($env{$envkey});
+ $env{'form.au./'.$domain.'/'} = 1;
+ my ($server_status,$home) = &check_author_homeserver($user,$domain);
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'au./'.$domain.'/';
+ my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ last;
+ }
+ if (my ($castart,$caend) = ($env{'user.role.ca./'.$domain.'/'.$user} =~ /^(\d*)\.(\d*)$/)) {
+ if (((($castart) && ($castart < $now)) || !$castart) &&
+ ((!$caend) || (($caend) && ($caend > $now)))) {
+ my ($server_status,$home) = &check_author_homeserver($user,$domain);
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'ca./'.$domain.'/'.$user;
+ my $switchserver = '/adm/switchserver?otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ last;
+ }
+ }
+ # Check if author blocked ca-access
+ my %blocked=&Apache::lonnet::get('environment',['domcoord.author'],$domain,$user);
+ if ($blocked{'domcoord.author'} eq 'blocked') {
+ delete($env{$envkey});
+ $env{'user.error.msg'}=':::1:User '.$user.' in domain '.$domain.' blocked domain coordinator access';
+ last;
+ }
+ 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');
+ if ($server_status eq 'switchserver') {
+ my $trolecode = 'ca./'.$domain.'/'.$user;
+ my $switchserver = '/adm/switchserver?'
+ .'otherserver='.$home.'&role='.$trolecode;
+ $r->internal_redirect($switchserver);
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ last;
+ }
+ }
+ }
+
+ 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);
+ if ($env{'form.'.$trolecode}) {
+ if ($tstatus eq 'is') {
+ $where=~s/^\///;
+ my ($cdom,$cnum,$csec)=split(/\//,$where);
+# check for course groups
+ my %coursegroups = &Apache::lonnet::get_active_groups(
+ $env{'user.domain'},$env{'user.name'},$cdom, $cnum);
+ my $cgrps = join(':',keys(%coursegroups));
+
+# store role if recent_role list being kept
+ if ($env{'environment.recentroles'}) {
+ my %frozen_roles =
+ &Apache::lonhtmlcommon::get_recent_frozen('roles',$env{'environment.recentrolesn'});
+ &Apache::lonhtmlcommon::store_recent('roles',
+ $trolecode,' ',$frozen_roles{$trolecode});
+ }
+
+
+# check for keyed access
+ if (($role eq 'st') &&
+ ($env{'course.'.$cdom.'_'.$cnum.'.keyaccess'} eq 'yes')) {
+# who is key authority?
+ my $authdom=$cdom;
+ my $authnum=$cnum;
+ if ($env{'course.'.$cdom.'_'.$cnum.'.keyauth'}) {
+ ($authnum,$authdom)=
+ split(/:/,$env{'course.'.$cdom.'_'.$cnum.'.keyauth'});
+ }
+# check with key authority
+ unless (&Apache::lonnet::validate_access_key(
+ $env{'environment.key.'.$cdom.'_'.$cnum},
+ $authdom,$authnum)) {
+# there is no valid key
+ if ($env{'form.newkey'}) {
+# student attempts to register a new key
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ my $swinfo=&Apache::lonmenu::rawconfig();
+ my $start_page=&Apache::loncommon::start_page
+ ('Verifying Access Key to Unlock this Course');
+ my $end_page=&Apache::loncommon::end_page();
+ my $buttontext=&mt('Enter Course');
+ my $message=&mt('Successfully registered key');
+ my $assignresult=
+ &Apache::lonnet::assign_access_key(
+ $env{'form.newkey'},
+ $authdom,$authnum,
+ $cdom,$cnum,
+ $env{'user.domain'},
+ $env{'user.name'},
+ &mt('Assigned from [_1] at [_2] for [_3]'
+ ,$ENV{'REMOTE_ADDR'}
+ ,&Apache::lonlocal::locallocaltime()
+ ,$trolecode)
+ );
+ unless ($assignresult eq 'ok') {
+ $assignresult=~s/^error\:\s*//;
+ $message=&mt($assignresult).
+ ' '.
+ &mt('Logout').'';
+ $buttontext=&mt('Re-Enter Key');
+ }
+ $r->print(<
+$swinfo
+
+
+$end_page
+ENDENTEREDKEY
+ return OK;
+ } else {
+# print form to enter a new key
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ my $swinfo=&Apache::lonmenu::rawconfig();
+ my $start_page=&Apache::loncommon::start_page
+ ('Enter Access Key to Unlock this Course');
+ my $end_page=&Apache::loncommon::end_page();
+ $r->print(<
+$swinfo
+
+
+$end_page
+ENDENTERKEY
+ return OK;
+ }
+ }
+ }
+ &Apache::lonnet::log($env{'user.domain'},
+ $env{'user.name'},
+ $env{'user.home'},
+ "Role ".$trolecode);
+
+ &Apache::lonnet::appenv(
+ {'request.role' => $trolecode,
+ 'request.role.domain' => $cdom,
+ 'request.course.sec' => $csec,
+ 'request.course.groups' => $cgrps});
+ my $tadv=0;
+
+ if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
+ my $msg;
+ my ($furl,$ferr)=
+ &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
+ if (($env{'form.orgurl'}) &&
+ ($env{'form.orgurl'}!~/^\/adm\/flip/)) {
+ my $dest=$env{'form.orgurl'};
+ if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
+ &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
+ if (($ferr) && ($tadv)) {
+ &error_page($r,$ferr,$dest);
+ } else {
+ $r->internal_redirect($dest);
+ }
+ return OK;
+ } else {
+ if (!$env{'request.course.id'}) {
+ &Apache::lonnet::appenv(
+ {"request.course.id" => $cdom.'_'.$cnum});
+ $furl='/adm/roles?tryagain=1';
+ $msg=
+ '
'.
+ &mt('Could not initialize [_1] at this time.',
+ $env{'course.'.$cdom.'_'.$cnum.'.description'}).
+ '
'.&mt('Please try again.').'
'.$ferr;
+ }
+ if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; }
+ &Apache::lonnet::appenv({'request.role.adv'=>$tadv});
+
+ if (($ferr) && ($tadv)) {
+ &error_page($r,$ferr,$furl);
+ } else {
+ # Check to see if the user is a CC entering a course
+ # for the first time
+ my (undef, undef, $role, $courseid) = split(/\./, $envkey);
+ if (substr($courseid, 0, 1) eq '/') {
+ $courseid = substr($courseid, 1);
+ }
+ $courseid =~ s/\//_/;
+ if ($role eq 'cc' && $env{'course.' . $courseid .
+ '.course.helper.not.run'}) {
+ $furl = "/adm/helper/course.initialization.helper";
+ # Send the user to the course they selected
+ } elsif ($env{'request.course.id'}) {
+ if ($env{'form.destinationurl'}) {
+ my $dest = $env{'form.destinationurl'};
+ if ($env{'form.destsymb'} ne '') {
+ my $esc_symb = &HTML::Entities::encode($env{'form.destsymb'},'"<>&');
+ $dest .= '?symb='.$esc_symb;
+ }
+ &redirect_user($r,&mt('Entering [_1]',
+ $env{'course.'.$courseid.'.description'}),
+ $dest,$msg,
+ $env{'environment.remotenavmap'});
+ return OK;
+ }
+ if (&Apache::lonnet::allowed('whn',
+ $env{'request.course.id'})
+ || &Apache::lonnet::allowed('whn',
+ $env{'request.course.id'}.'/'
+ .$env{'request.course.sec'})
+ ) {
+ my $startpage = &courseloadpage($courseid);
+ unless ($startpage eq 'firstres') {
+ $msg = &mt('Entering [_1] ...',
+ $env{'course.'.$courseid.'.description'});
+ &redirect_user($r,&mt('New in course'),
+ '/adm/whatsnew?refpage=start',$msg,
+ $env{'environment.remotenavmap'});
+ return OK;
+ }
+ }
+ }
+# Are we allowed to look at the first resource?
+ if ($furl !~ m|^/adm/|) {
+# Guess not ...
+ $furl=&Apache::lonpageflip::first_accessible_resource();
+ }
+ $msg = &mt('Entering [_1] ...',
+ $env{'course.'.$courseid.'.description'});
+ &redirect_user($r,&mt('Entering [_1]',
+ $env{'course.'.$courseid.'.description'}),
+ $furl,$msg,
+ $env{'environment.remotenavmap'});
+ }
+ return OK;
+ }
+ }
+ #
+ # Send the user to the construction space they selected
+ if ($role =~ /^(au|ca|aa)$/) {
+ my $redirect_url = '/priv/';
+ if ($role eq 'au') {
+ $redirect_url.=$env{'user.name'};
+ } else {
+ $where =~ /\/(.*)$/;
+ $redirect_url .= $1;
+ }
+ $redirect_url .= '/';
+ &redirect_user($r,&mt('Entering Construction Space'),
+ $redirect_url);
+ return OK;
+ }
+ if ($role eq 'dc') {
+ my $redirect_url = '/adm/menu/';
+ &redirect_user($r,&mt('Loading Domain Coordinator Menu'),
+ $redirect_url);
+ return OK;
+ }
+ }
+ }
}
}
-
+
# =============================================================== No Roles Init
- $r->content_type('text/html');
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
$r->send_http_header;
return OK if $r->header_only;
+ my $brcrum =[{href=>"/admm/roles",text=>"User Roles"}];
+ my $swinfo=&Apache::lonmenu::rawconfig();
+ my $start_page=&Apache::loncommon::start_page('User Roles',undef,{bread_crumbs=>$brcrum});
+ my $standby=&mt('Role selected. Please stand by.');
+ $standby=~s/\n/\\n/g;
+ my $noscript=''.&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.').' '.&mt('As this is not the case, most functionality in the system will be unavailable.').' ';
+
$r->print(<
-
-LON-CAPA User Roles
-
+$start_page
+
+
+
ENDHEADER
# ------------------------------------------ Get Error Message from Environment
- my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
- if ($ENV{'user.error.msg'}) {
- $r->log_reason(
- "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
+ my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$env{'user.error.msg'});
+ if ($env{'user.error.msg'}) {
+ $r->log_reason(
+ "$msg for $env{'user.name'} domain $env{'user.domain'} access $priv",$fn);
}
-# ---------------------------------------------------------------- Who is this?
+# ------------------------------------------------- Can this user re-init, etc?
- my $advanced=0;
- foreach $envkey (keys %ENV) {
- if ($envkey=~/^user\.role\./) {
- my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey);
- if ($role ne 'st') { $advanced=1; }
- }
- }
-
-# ---------------------------------------------- Get cached course descriptions
-
- my %cdes=Apache::lonnet::dump('coursedescriptions');
+ my $advanced=$env{'user.adv'};
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['tryagain']);
+ my $tryagain=$env{'form.tryagain'};
+ my $reinit=$env{'user.reinit'};
+ delete $env{'user.reinit'};
# -------------------------------------------------------- Generate Page Output
# --------------------------------------------------------------- Error Header?
if ($error) {
- $r->print("