--- loncom/auth/lonroles.pm 2000/07/25 15:40:11 1.4
+++ loncom/auth/lonroles.pm 2012/08/14 15:45:25 1.270
@@ -1,184 +1,2740 @@
# 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 Gerd Kortemeyer
#
+# $Id: lonroles.pm,v 1.270 2012/08/14 15:45:25 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.
+
+=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 Apache::loncoursequeueadmin;
+use GDBM_File;
+use LONCAPA qw(:DEFAULT :match);
+use HTML::Entities;
+
+
+sub redirect_user {
+ my ($r,$title,$url,$msg) = @_;
+ $msg = $title if (! defined($msg));
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+
+ # Breadcrumbs
+ my $brcrum = [{'href' => $url,
+ 'text' => 'Switching Role'},];
+ my $start_page = &Apache::loncommon::start_page('Switching Role',undef,
+ {'redirect' => [1,$url],
+ 'bread_crumbs' => $brcrum,});
+ 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(<$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;
+ # Breadcrumbs
+ my $brcrum = [{'href' => $dest,
+ 'text' => 'Problems during Course Initialization'},];
+ $r->print(&Apache::loncommon::start_page('Problems during Course Initialization',
+ undef,
+ {'bread_crumbs' => $brcrum,})
+ );
+ $r->print(
+ ''.
+ ''.&mt('The following problems occurred:').
+ ' '.
+ $error.
+ '
'.&mt('Continue').' '
+ );
+ $r->print(&Apache::loncommon::end_page());
+}
sub handler {
+
my $r = shift;
- $r->content_type('text/html');
+
+ my $now=time;
+ my $then=$env{'user.login.time'};
+ my $refresh=$env{'user.refresh.time'};
+ my $update=$env{'user.update.time'};
+ if (!$refresh) {
+ $refresh = $then;
+ }
+ if (!$update) {
+ $update = $then;
+ }
+
+# -------------------------------------------------------- Check for new roles
+ my $updateresult;
+ if ($env{'form.doupdate'}) {
+ my $show_course=&Apache::loncommon::show_course();
+ my $checkingtxt;
+ if ($show_course) {
+ $checkingtxt = &mt('Checking for new courses ...');
+ } else {
+ $checkingtxt = &mt('Checking for new roles ...');
+ }
+ $updateresult = ''.$checkingtxt.' ';
+ $updateresult .= &update_session_roles();
+ &Apache::lonnet::appenv({'user.update.time' => $now});
+ $update = $now;
+ &reqauthor_check();
+ }
+
+# -------------------------------------------------- Check for author requests
+
+ my $reqauthor;
+ if ($env{'form.requestauthor'}) {
+ if ($env{'environment.canrequest.author'}) {
+ unless (&is_active_author()) {
+ my $queued = &reqauthor_check();
+ my $skipreq;
+ if ($queued =~ /^approval:\d+$/) {
+ my ($status,$timestamp) = split(/:/,$env{'environment.requestauthorqueued'});
+ if ($status eq 'approval') {
+ $reqauthor = ''.
+ &mt('A request for authoring space submitted on [_1] is awaiting approval',
+ &Apache::lonlocal::locallocaltime($timestamp)).
+ ' ';
+ }
+ $skipreq = 1;
+ } elsif ($queued =~ /^approved:\d+$/) {
+ my %roleshash = &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',
+ ['active'],['au'],[$env{'user.domain'}]);
+ if (keys(%roleshash) > 0) {
+ $skipreq = 1;
+ }
+ }
+ unless ($skipreq) {
+ my (@inststatuses,%domconfig);
+ %domconfig =
+ &Apache::lonnet::get_dom('configuration',
+ ['requestauthor'],$env{'user.domain'});
+ my $val = &Apache::loncoursequeueadmin::get_processtype('requestauthor',$env{'user.name'},
+ $env{'user.domain'},$env{'user.adv'},
+ $env{'user.domain'},undef,
+ \@inststatuses,\%domconfig);
+ if ($val eq 'automatic') {
+ if (&Apache::lonnet::assignrole($env{'user.domain'},$env{'user.name'},'/'.$env{'user.domain'}.'/',
+ 'au',undef,$now,undef,undef,'requestauthor') eq 'ok') {
+ $reqauthor = ''.
+ &mt('Access to authoring space has been activated').' ';
+ &update_session_roles();
+ &Apache::lonnet::appenv({'user.update.time' => $now});
+ $update = $now;
+ } else {
+ $reqauthor = ''.
+ &mt('An error occurred while activating your access to authoring space');
+ }
+ } elsif ($val eq 'approval') {
+ my $domconfiguser = &Apache::lonnet::get_domainconfiguser($env{'user.domain'});
+ if (&Apache::lonnet::put('requestauthorqueue',{ $env{'user.name'}.'_'.$val => $now },
+ $env{'user.domain'},$domconfiguser) eq 'ok') {
+ my %userrequest = (
+ author => {
+ timestamp => $now,
+ status => $val,
+ },
+ author_status => $val,
+ );
+ my $req_notifylist;
+ if (ref($domconfig{'requestauthor'}) eq 'HASH') {
+ if (ref($domconfig{'requestauthor'}{'notify'}) eq 'HASH') {
+ my $req_notifylist = $domconfig{'requestauthor'}{'notify'}{'approval'};
+ if ($req_notifylist) {
+ my $fullname = &Apache::loncommon::plainname($env{'user.name'},
+ $env{'user.domain'});
+ my $sender = $env{'user.name'}.':'.$env{'user.domain'};
+ my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description');
+ &Apache::loncoursequeueadmin::send_selfserve_notification($req_notifylist,
+ "$fullname ($env{'user.name'}:$env{'user.domain'})",undef,$domdesc,
+ $now,'authorreq',$sender);
+ }
+ }
+ }
+ my $userresult =
+ &Apache::lonnet::put('requestauthor',\%userrequest,$env{'user.domain'},$env{'user.name'});
+ $reqauthor = ''.
+ &mt('Your request for authoring space has been submitted for approval.').
+ ' ';
+ &Apache::lonnet::appenv({'environment.requestauthorqueued' => $val.':'.$now});
+ } else {
+ $reqauthor = ''.
+ &mt('An error occurred saving your request for authoring space.').
+ ' ';
+ }
+ }
+ }
+ }
+ }
+ }
+
+ my $envkey;
+ my %dcroles = ();
+ my $numdc = &check_fordc(\%dcroles,$update,$then);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
+ my $loncaparev = $Apache::lonnet::perlvar{'lonVersion'};
+
+# ================================================================== Roles Init
+ if ($env{'form.selectrole'}) {
+
+ 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'}) {
+ my $switch_is_active;
+ if (defined($env{'user.role.'.$env{'form.switchrole'}})) {
+ my ($start,$end) = split(/\./,$env{'user.role.'.$env{'form.switchrole'}});
+ if (!$end || $end > $now) {
+ if (!$start || $start < $update) {
+ $switch_is_active = 1;
+ }
+ }
+ }
+ unless ($switch_is_active) {
+ &adhoc_course_role($refresh,$update,$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.course.tied" => '',
+ "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 Coordinator role?
+ if (my ($ccrole,$domain,$coursenum) =
+ ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
+ if ($dcroles{$domain}) {
+ &Apache::lonnet::check_adhoc_privs($domain,$coursenum,
+ $update,$refresh,$now,$ccrole);
+ }
+ 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')) {
+ &Apache::lonnet::check_adhoc_privs($domain,$user,$update,
+ $refresh,$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);
+ &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where,
+ \$trolecode,\$tstatus,\$tstart,\$tend);
+ if ($env{'form.'.$trolecode}) {
+ if ($tstatus eq 'is') {
+ $where=~s/^\///;
+ my ($cdom,$cnum,$csec)=split(/\//,$where);
+ if (($cnum) && ($role ne 'ca') && ($role ne 'aa')) {
+ my $home = $env{'course.'.$cdom.'_'.$cnum.'.home'};
+ my @ids = &Apache::lonnet::current_machine_ids();
+ unless ($loncaparev eq '' && $home && grep(/^\Q$home\E$/,@ids)) {
+ my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
+ if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
+ my ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$cdom.'_'.$cnum,$trolecode,$curr_reqd_hash{'internal.releaserequired'});
+ if ($switchwarning ne '' || $switchserver ne '') {
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ my $end_page=&Apache::loncommon::end_page();
+ $r->print(&Apache::loncommon::start_page('Selected course unavailable on this server').
+ '');
+ if ($switchwarning) {
+ $r->print($switchwarning.'');
+ if (&Apache::loncommon::show_course()) {
+ $r->print(&mt('Display courses'));
+ } else {
+ $r->print(&mt('Display roles'));
+ }
+ $r->print(' ');
+ } elsif ($switchserver) {
+ $r->print(&mt('This course requires a newer version of LON-CAPA than is installed on this server.').
+ ' '.
+ ''.
+ &mt('Switch Server').
+ ' ');
+ }
+ $r->print('
'.&Apache::loncommon::end_page());
+ return OK;
+ }
+ }
+ }
+ }
+# 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(<
+//
+
+
+$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(<
+//
+
+
+$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 ($env{'form.symb'}) {
+ if ($dest =~ /\?/) {
+ $dest .= '&';
+ } else {
+ $dest .= '?'
+ }
+ $dest .= 'symb='.$env{'form.symb'};
+ }
+ 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 {
+ if ($dest =~ m{^/adm/coursedocs\?folderpath}) {
+ if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+ my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
+ &Apache::loncommon::update_content_constraints($cdom,$cnum,$chome,
+ $cdom.'_'.$cnum);
+ }
+ }
+ $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') || ($role eq 'co'))
+ && ($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);
+ 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);
+ 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);
+ }
+ 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.domain'}.'/'.$env{'user.name'};
+ } else {
+ $redirect_url .= $where;
+ }
+ $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;
+ }
+ if ($role eq 'sc') {
+ my $redirect_url = '/adm/grades?command=scantronupload';
+ &redirect_user($r,&mt('Loading Data Upload Page'),
+ $redirect_url);
+ return OK;
+ }
+ }
+ }
+ }
+ }
+
+
+# =============================================================== No Roles Init
+
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
$r->send_http_header;
return OK if $r->header_only;
-# ---------------------------------------------------------------- Print Header
+ my $crumbtext = 'User Roles';
+ my $pagetitle = 'My Roles';
+ my $recent = &mt('Recent Roles');
+ my $show_course=&Apache::loncommon::show_course();
+ if ($show_course) {
+ $crumbtext = 'Courses';
+ $pagetitle = 'My Courses';
+ $recent = &mt('Recent Courses');
+ }
+ my $brcrum =[{href=>"/adm/roles",text=>$crumbtext}];
+ my $swinfo=&Apache::lonmenu::rawconfig();
+ my $start_page=&Apache::loncommon::start_page($pagetitle,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
+
+
+$noscript
+
+
ENDHEADER
# ------------------------------------------ Get Error Message from Environment
- my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'});
+ 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);
+ }
-# -------------------------------------------------------- Generate Page Output
+# ------------------------------------------------- Can this user re-init, etc?
+
+ 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("LON-CAPA Access Control ");
- $r->print("Access : ".
- Apache::lonnet::plaintext($priv)."\n");
- $r->print("Resource: $fn\n");
- $r->print("Action : $msg\n ");
- $r->log_reason(
- "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn);
+ $r->print("".&mt('LON-CAPA Access Control')." ");
+ $r->print("");
+ if ($priv ne '') {
+ $r->print(&mt('Access : ').&Apache::lonnet::plaintext($priv)."\n");
+ }
+ if ($fn ne '') {
+ $r->print(&mt('Resource: ').&Apache::lonenc::check_encrypt($fn)."\n");
+ }
+ if ($msg ne '') {
+ $r->print(&mt('Action : ').$msg."\n");
+ }
+ $r->print(" ");
+ my $url=$fn;
+ my $last;
+ if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
+ &GDBM_READER(),0640)) {
+ $last=$hash{'last_known'};
+ untie(%hash);
+ }
+ if ($last) { $fn.='?symb='.&escape($last); }
+
+ &Apache::londocs::changewarning($r,undef,'You have modified your course recently, [_1] may fix this access problem.',
+ &Apache::lonenc::check_encrypt($fn));
} else {
- $r->print("LON-CAPA User Roles ");
+ if ($env{'user.error.msg'}) {
+ if ($reinit) {
+ $r->print(
+ ''.
+ &mt('As your session file for the course or community has expired, you will need to re-select it.').' ');
+ } else {
+ $r->print(
+ ''.
+ &mt('You need to choose another user role or enter a specific course or community for this function.').
+ ' ');
+ }
+ }
}
-
- my $now=time;
- my $then=$ENV{'user.login.time'};
-
if ($nochoose) {
- $r->print("Assigned User Roles \n");
+ $r->print("".&mt('Sorry ...')." \n".
+ &mt('This action is currently not authorized.').' '.
+ &Apache::loncommon::end_page());
+ return OK;
} else {
- $r->print("Select a User Role \n");
- $r->print('\n");
+ my $buttonname=$trolecode;
+ $buttonname=~s/\W//g;
+ if (!$button) {
+ if ($switchserver) {
+ $roletext.=''
+ .''
+ .&mt('Switch Server')
+ .' ';
+ } else {
+ $roletext.=(' ');
+ }
+ if ($switchwarning) {
+ if ($tremark eq '') {
+ $tremark = $switchwarning;
+ } else {
+ $tremark .= ' '.$switchwarning;
+ }
+ }
+ } elsif ($tstatus eq 'is') {
+ $roletext.=''.
+ ' ';
+ } elsif ($tryagain) {
+ $roletext.=
+ ''.
+ ' ';
+ } elsif ($advanced) {
+ $roletext.=
+ ''.
+ ' ';
+ } elsif ($reinit) {
+ $roletext.=
+ ''.
+ ' ';
+ } else {
+ $roletext.=
+ ''.
+ ' ';
+ }
+ }
+ if ($trolecode !~ m/^(dc|ca|au|aa)\./) {
+ $tremark.=&Apache::lonannounce::showday(time,1,
+ &Apache::lonannounce::readcalendar($tdom.'_'.$trest));
}
-# ----------------------------------------------------------------- Priviledges
+ $roletext.=''.$trole.' '
+ .''.$twhere.' '
+ .''.$tpstart.' '
+ .''.$tpend.' ';
+ if (!$is_dc) {
+ $roletext_end = ''.
+ $tremark.' '.
+ ' ';
+ }
+ return ($roletext,$roletext_end);
+}
- $r->print('Priviledges ');
+sub check_needs_switchserver {
+ my ($possiblerole) = @_;
+ my $needs_switchserver;
+ my ($role,$where) = split(/\./,$possiblerole,2);
+ my (undef,$tdom,$twho) = split(/\//,$where);
+ my ($server_status,$home);
+ if (($role eq 'ca') || ($role eq 'aa')) {
+ ($server_status,$home) = &check_author_homeserver($twho,$tdom);
+ } else {
+ ($server_status,$home) = &check_author_homeserver($env{'user.name'},
+ $env{'user.domain'});
+ }
+ if ($server_status eq 'switchserver') {
+ $needs_switchserver = 1;
+ }
+ return $needs_switchserver;
+}
- foreach $envkey (sort keys %ENV) {
- if ($envkey=~/^user\.priv\./) {
- my ($dum1,$dum2,@pwhere)=split(/\./,$envkey);
- my $where=join('.',@pwhere);
- my $ttype;
+sub check_author_homeserver {
+ my ($uname,$udom)=@_;
+ if (($uname eq '') || ($udom eq '')) {
+ return ('fail','');
+ }
+ my $home = &Apache::lonnet::homeserver($uname,$udom);
+ if (&Apache::lonnet::host_domain($home) ne $udom) {
+ return ('fail',$home);
+ }
+ my @ids=&Apache::lonnet::current_machine_ids();
+ if (grep(/^\Q$home\E$/,@ids)) {
+ return ('ok',$home);
+ } else {
+ return ('switchserver',$home);
+ }
+}
+
+sub check_fordc {
+ my ($dcroles,$update,$then) = @_;
+ my $numdc = 0;
+ if ($env{'user.adv'}) {
+ foreach my $envkey (sort keys %env) {
+ if ($envkey=~/^user\.role\.dc\.\/($match_domain)\/$/) {
+ 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 ($livedc) {
+ $$dcroles{$dcdom} = $envkey;
+ $numdc++;
+ }
+ }
+ }
+ }
+ return $numdc;
+}
+
+sub adhoc_course_role {
+ my ($refresh,$update,$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)) {
+ 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)) {
+ $setprivs = 1;
+ }
+ }
+ if ($setprivs) {
+ if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)([\w/]*)\./\Q$cdom\E/\Q$cnum\E/?(\w*)$-) {
+ my $role = $1;
+ my $custom_role = $2;
+ my $usec = $3;
+ if ($role eq 'cr') {
+ if ($custom_role =~ m-^/$match_domain/$match_username/\w+$-) {
+ $role .= $custom_role;
+ } else {
+ return;
+ }
+ }
+ my (%userroles,%newrole,%newgroups,%group_privs);
+ my %cgroups =
+ &Apache::lonnet::get_active_groups($env{'user.domain'},
+ $env{'user.name'},$cdom,$cnum);
+ foreach my $group (keys(%cgroups)) {
+ $group_privs{$group} =
+ $env{'user.priv.cc./'.$cdom.'/'.$cnum.'./'.$cdom.'/'.$cnum.'/'.$group};
+ }
+ $newgroups{'/'.$cdom.'/'.$cnum} = \%group_privs;
+ my $area = '/'.$cdom.'/'.$cnum;
+ my $spec = $role.'.'.$area;
+ if ($usec ne '') {
+ $spec .= '/'.$usec;
+ $area .= '/'.$usec;
+ }
+ &Apache::lonnet::standard_roleprivs(\%newrole,$role,$cdom,$spec,$cnum,$area);
+ &Apache::lonnet::set_userprivs(\%userroles,\%newrole,\%newgroups);
+ my $adhocstart = $refresh-1;
+ $userroles{'user.role.'.$spec} = $adhocstart.'.';
+ &Apache::lonnet::appenv(\%userroles,[$role,'cm']);
+ }
+ }
+ }
+ return;
+}
+
+sub check_forcc {
+ my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_;
+ my ($is_cc,$ccrole);
+ if ($crstype eq 'Community') {
+ $ccrole = 'co';
+ } else {
+ $ccrole = 'cc';
+ }
+ if (&Apache::lonnet::is_course($cdom,$cnum)) {
+ my $envkey = 'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum;
+ 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; }
+ }
+ }
+ return $is_cc;
+}
+
+sub check_release_required {
+ my ($loncaparev,$tcourseid,$trolecode,$required) = @_;
+ my ($switchserver,$warning);
+ if ($required ne '') {
+ my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
+ my ($major,$minor) = ($loncaparev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+ if ($reqdmajor ne '' && $reqdminor ne '') {
+ my $otherserver;
+ if (($major eq '' && $minor eq '') ||
+ (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
+ my ($userdomserver) = &Apache::lonnet::choose_server($env{'user.domain'});
+ my $switchlcrev =
+ &Apache::lonnet::get_server_loncaparev($env{'user.domain'},
+ $userdomserver);
+ my ($swmajor,$swminor) = ($switchlcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+ if (($swmajor eq '' && $swminor eq '') || ($reqdmajor > $swmajor) ||
+ (($reqdmajor == $swmajor) && ($reqdminor > $swminor))) {
+ my $cdom = $env{'course.'.$tcourseid.'.domain'};
+ if ($cdom ne $env{'user.domain'}) {
+ my ($coursedomserver,$coursehostname) = &Apache::lonnet::choose_server($cdom);
+ my $serverhomeID = &Apache::lonnet::get_server_homeID($coursehostname);
+ my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+ my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+ my $remoterev = &Apache::lonnet::get_server_loncaparev($serverhomedom,$coursedomserver);
+ my $canhost =
+ &Apache::lonnet::can_host_session($env{'user.domain'},
+ $coursedomserver,
+ $remoterev,
+ $udomdefaults{'remotesessions'},
+ $defdomdefaults{'hostedsessions'});
+
+ if ($canhost) {
+ $otherserver = $coursedomserver;
+ } else {
+ $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).' '. &mt("No suitable server could be found amongst servers in either your own domain or in the course's domain.");
+ }
+ } else {
+ $warning = &mt('Requires LON-CAPA version [_1].',$env{'course.'.$tcourseid.'.internal.releaserequired'}).' '.&mt("No suitable server could be found amongst servers in your own domain (which is also the course's domain).");
+ }
+ } else {
+ $otherserver = $userdomserver;
+ }
+ }
+ if ($otherserver ne '') {
+ $switchserver = 'otherserver='.$otherserver.'&role='.$trolecode;
+ }
+ }
+ }
+ return ($switchserver,$warning);
+}
+
+sub courselink {
+ my ($dcdom,$rowtype) = @_;
+ my $courseform=&Apache::loncommon::selectcourse_link
+ ('rolechoice','dccourse'.$rowtype.'_'.$dcdom,
+ 'dcdomain'.$rowtype.'_'.$dcdom,'coursedesc'.$rowtype.'_'.
+ $dcdom,$dcdom,undef,'Course/Community');
+ my $hiddenitems = ' '.
+ ' '.
+ ' '.
+ ' ';
+ return $courseform.$hiddenitems;
+}
+
+sub coursepick_jscript {
+ my %lt = &Apache::lonlocal::texthash(
+ plsu => "Please use the 'Select Course/Community' link to open a separate pick course window where you may select the course or community you wish to enter.",
+ youc => 'You can only use this screen to select courses and communities in the current domain.',
+ );
+ my $verify_script = <<"END";
+
+END
+ return $verify_script;
+}
+
+sub coauthorlink {
+ my ($dcdom,$rowtype) = @_;
+ my $coauthorform=&Apache::loncommon::selectauthor_link('rolechoice',$dcdom);
+ my $hiddenitems = ' ';
+ return $coauthorform.$hiddenitems;
+}
+
+sub display_cc_role {
+ my $rolekey = shift;
+ my ($roletext,$roletext_end);
+ my $advanced = $env{'user.adv'};
+ my $tryagain = $env{'form.tryagain'};
+ unless ($rolekey =~/^error\:/) {
+ if ($rolekey =~ m{^user\.role\.(cc|co)\./($match_domain)/($match_courseid)$}) {
+ my $ccrole = $1;
+ my $tdom = $2;
+ my $trest = $3;
+ my $tcourseid = $tdom.'_'.$trest;
+ my $trolecode = $ccrole.'./'.$tdom.'/'.$trest;
my $twhere;
- my ($tres,$tdom,@trest)=split(/\//,$where);
- if ($where=~/\.course$/) {
- $ttype='Course';
- $twhere=$tdom.'/'.join('/',@trest);
- } elsif ($tdom) {
- $ttype='Domain';
- $twhere=$tdom;
- } else {
- $ttype='System';
- $twhere='/';
- }
- $r->print("\n".$ttype.': '.$twhere.' ');
- map {
- if ($_) {
- my ($prv,$restr)=split(/\&/,$_);
- my $trestr='';
- if ($restr ne 'F') {
- my $i;
- for ($i=0;$iprint(''.Apache::lonnet::plaintext($prv).$trestr.
- ' ');
- }
- } sort split(/:/,$ENV{$envkey});
- $r->print(' ');
+ my $ttype;
+ my $tbg='LC_roles_is';
+ my %newhash=&Apache::lonnet::coursedescription($tcourseid);
+ if (%newhash) {
+ $twhere=$newhash{'description'}.
+ ' '.
+ &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom).
+ ' ';
+ $ttype = $newhash{'type'};
+ } else {
+ $twhere=&mt('Currently not available');
+ $env{'course.'.$tcourseid.'.description'}=$twhere;
+ }
+ my $trole = &Apache::lonnet::plaintext($ccrole,$ttype,$tcourseid);
+ $twhere.=" ".&mt('Domain').":".$tdom;
+ ($roletext,$roletext_end) = &build_roletext($trolecode,$tdom,$trest,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'');
}
}
+ return ($roletext,$roletext_end);
+}
+
+sub adhoc_roles_row {
+ my ($dcdom,$rowtype) = @_;
+ my $output = &Apache::loncommon::continue_data_table_row()
+ .' '
+ .&mt('[_1]Ad hoc[_2] roles in domain [_3] --'
+ ,'',' ',$dcdom)
+ .' ';
+ my $selectcclink = &courselink($dcdom,$rowtype);
+ my $ccrole = &Apache::lonnet::plaintext('co',undef,undef,1);
+ my $carole = &Apache::lonnet::plaintext('ca');
+ my $selectcalink = &coauthorlink($dcdom,$rowtype);
+ $output.=$ccrole.': '.$selectcclink
+ .' | '.$carole.': '.$selectcalink.' '
+ .&Apache::loncommon::end_data_table_row();
+ return $output;
+}
-# -------------------------------------------------------------- Debug - remove
-
- $->print("Debugging \n");
-
- foreach $envkey (sort keys %ENV) {
- $r->print("$envkey ---- $ENV{$envkey} ");
+sub recent_filename {
+ my $area=shift;
+ return 'nohist_recent_'.&escape($area);
+}
+
+sub courseloadpage {
+ my ($courseid) = @_;
+ my $startpage;
+ my %entry_settings = &Apache::lonnet::get('nohist_whatsnew',
+ [$courseid.':courseinit']);
+ my ($tmp) = %entry_settings;
+ unless ($tmp =~ /^error: 2 /) {
+ $startpage = $entry_settings{$courseid.':courseinit'};
}
+ if ($startpage eq '') {
+ if (exists($env{'environment.course_init_display'})) {
+ $startpage = $env{'environment.course_init_display'};
+ }
+ }
+ return $startpage;
+}
- $r->print("