--- loncom/auth/lonroles.pm 2003/03/23 01:46:51 1.53
+++ loncom/auth/lonroles.pm 2022/01/01 19:28:28 1.269.2.39.2.1
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# User Roles Screen
#
-# $Id: lonroles.pm,v 1.53 2003/03/23 01:46:51 www Exp $
+# $Id: lonroles.pm,v 1.269.2.39.2.1 2022/01/01 19:28:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,502 +25,3340 @@
#
# http://www.lon-capa.org/
#
-# (Directory Indexer
-# (Login Screen
-# YEAR=1999
-# 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)
-# YEAR=2000
-# 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,10/26,10/28,
-# 12/08,12/28,
-# YEAR=2001
-# 01/15/01 Gerd Kortemeyer
-# 03/02,05/03,05/25,05/30,06/01,07/06,08/06 Gerd Kortemeyer
-# 12/29 Gerd Kortemeyer
-#
###
+=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::Constants qw(:common REDIRECT);
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 Apache::longroup;
+use Apache::lonrss;
+use GDBM_File;
+use LONCAPA qw(:DEFAULT :match);
+use HTML::Entities;
+
+sub start_loading_course {
+ my ($r,$title) = @_;
+ &Apache::loncommon::content_type($r,'text/html');
+ &Apache::loncommon::no_cache($r);
+ $r->send_http_header;
+ my $swinfo=&Apache::lonmenu::rawconfig();
+ # Breadcrumbs
+ my $brcrum = [{'href' => '',
+ 'text' => $title},];
+ my $start_page = &Apache::loncommon::start_page($title,undef,
+ {'bread_crumbs' => $brcrum,
+ 'bread_crumbs_nomenu' => 1,
+ 'links_disabled' => 1});
+ $r->print(<
+//
+
+ENDREDIR
+ return;
+}
+
+sub finish_loading_course {
+ my ($r,$msg,$url) = @_;
+ my $link = '';
+ my $end_page = &Apache::loncommon::end_page();
+ my $js_url = &js_escape($url);
+ $r->print(<
+// a').removeAttr("aria-disabled");
+ \$('.isDisabled').removeClass("isDisabled");
+ var url = "$js_url";
+ \$(location).attr('href',url);
+});
+
+$link
+$end_page
+END
+ return;
+}
+
+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;
+ my $swinfo=&Apache::lonmenu::rawconfig();
+
+ # 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)=@_;
+ my %lt = &Apache::lonlocal::texthash(
+ pdc => 'Problems during Course Initialization',
+ tfp => 'The following problems occurred:',
+ con => 'Continue',
+ );
+ my $end_page = &Apache::loncommon::end_page();
+ $dest = &HTML::Entities::encode($dest,'"<>&');
+ $r->print(<$lt{'pdc'}
+$lt{'tfp'}
+
+$error
+
$lt{'con'}
+$end_page
+END
+ return;
+}
sub handler {
my $r = shift;
+ # Check for critical messages and redirect if present.
+ my ($redirect,$url) = &Apache::loncommon::critical_redirect(300,'roles');
+ if ($redirect) {
+ &Apache::loncommon::content_type($r,'text/html');
+ $r->header_out(Location => $url);
+ return REDIRECT;
+ }
+
my $now=time;
- my $then=$ENV{'user.login.time'};
- my $envkey;
+ 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;
+ }
+ my ($norolelist,$blocked_by_ip,$blocked_type,$clientip);
+ $clientip = &Apache::lonnet::get_requestor_ip($r);
+ if (($env{'request.course.id'}) && ($env{'request.deeplink.login'})) {
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
+ my $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);
+ if ($deeplink_symb) {
+ my ($menucoll,$deeplinkmenu,$menuref) = &Apache::loncommon::menucoll_in_effect();
+ if (ref($menuref) eq 'HASH') {
+ unless (($menuref->{'role'}) || ($env{'request.role.adv'})) {
+ foreach my $envkey (keys(%env)) {
+ next unless ($envkey =~ /^form\./);
+ if ($envkey =~ m{\./($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
+ unless (($1 eq $cdom) && ($2 eq $cnum)) {
+ delete($env{$envkey});
+ }
+ }
+ }
+ if ($env{'form.selectrole'}) {
+ if ($env{'form.switchrole'} =~ m{\./($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
+ unless (($1 eq $cdom) && ($2 eq $cnum)) {
+ delete($env{'form.selectrole'});
+ delete($env{'form.switchrole'});
+ }
+ } elsif ($env{'form.newrole'} =~ m{\./($match_domain)/($match_courseid)(?:/(\w+)|$)}) {
+ unless (($1 eq $cdom) && ($2 eq $cnum)) {
+ delete($env{'form.selectrole'});
+ delete($env{'form.newrole'});
+ }
+ }
+ }
+ $norolelist = 1;
+ }
+ }
+ }
+ }
+
+ if ($env{'form.selectrole'}) {
+ my ($role,$cdom,$cnum,$rest);
+ if ($env{'form.switchrole'} =~ m{^(co|cc|in|ta|ep|ad|st|cr).*?\./($match_domain)/($match_courseid)(/(\w+)|$)}) {
+ ($role,$cdom,$cnum,$rest) = ($1,$2,$3,$4);
+ } elsif ($env{'form.newrole'} =~ m{^(co|cc|in|ta|ep|ad|st|cr).*?\./($match_domain)/($match_courseid)(/(\w+)|$)}) {
+ ($role,$cdom,$cnum,$rest) = ($1,$2,$3,$4);
+ }
+ if ($cdom ne '') {
+ my ($has_evb,$check_ipaccess,$showrole);
+ $showrole = 1;
+ my $checkrole = "cm./$cdom/$cnum";
+ if ($rest ne '') {
+ $checkrole .= "/$rest";
+ }
+ if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+ ($role ne 'st')) {
+ $has_evb = 1;
+ }
+ unless ($has_evb) {
+ my @machinedoms = &Apache::lonnet::current_machine_domains();
+ my $udom = $env{'user.domain'};
+ if ($udom eq $cdom) {
+ $check_ipaccess = 1;
+ } elsif (($udom ne '') && (grep(/^\Q$udom\E$/,@machinedoms))) {
+ $check_ipaccess = 1;
+ } else {
+ my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+ my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+ my $cprim = &Apache::lonnet::domain($cdom,'primary');
+ my $cintdom = &Apache::lonnet::internet_dom($cprim);
+ if (($cintdom ne '') && (ref($internet_names) eq 'ARRAY')) {
+ if (grep(/^\Q$cintdom\E$/,@{$internet_names})) {
+ $check_ipaccess = 1;
+ }
+ }
+ }
+ if ($check_ipaccess) {
+ my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$cdom);
+ unless (defined($cached)) {
+ my %domconfig =
+ &Apache::lonnet::get_dom('configuration',['ipaccess'],$cdom);
+ $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$cdom,$domconfig{'ipaccess'},1800);
+ }
+ if (ref($ipaccessref) eq 'HASH') {
+ foreach my $id (keys(%{$ipaccessref})) {
+ if (ref($ipaccessref->{$id}) eq 'HASH') {
+ my $range = $ipaccessref->{$id}->{'ip'};
+ if ($range) {
+ my $type = 'exclude';
+ if (&Apache::lonnet::ip_match($clientip,$range)) {
+ $type = 'include';
+ }
+ if (ref($ipaccessref->{$id}->{'courses'}) eq 'HASH') {
+ if ($ipaccessref->{$id}->{'courses'}{$cdom.'_'.$cnum}) {
+ if ($type eq 'include') {
+ $showrole = 1;
+ last;
+ } else {
+ $showrole = 0;
+ }
+ } else {
+ if ($type eq 'include') {
+ $showrole = 0;
+ } else {
+ $showrole = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ unless ($showrole) {
+ $blocked_by_ip = 1;
+ $blocked_type = &Apache::loncommon::course_type($cdom.'_'.$cnum);
+ delete($env{'form.selectrole'});
+ delete($env{'form.newrole'});
+ }
+ }
+ }
+
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
+
+# -------------------------------------------------- Check if setting hot list
+ my $hotlist;
+ if ($env{'form.action'} eq 'verify_and_change_rolespref') {
+ $hotlist = &Apache::lonpreferences::verify_and_change_rolespref($r);
+ }
+
+# -------------------------------------------------------- Check for new roles
+ my $updateresult;
+ if ($env{'form.state'} eq '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;
+ &Apache::loncoursequeueadmin::reqauthor_check();
+ }
+
+# -------------------------------------------------- Check for author requests
+ my $reqauthor;
+ if ($env{'form.state'} eq 'requestauthor') {
+ $reqauthor = &Apache::loncoursequeueadmin::process_reqauthor(\$update);
+ }
+
+ my $envkey;
+ my %dcroles = ();
+ my %helpdeskroles = ();
+ my ($numdc,$numhelpdesk,$numadhoc) =
+ &check_for_adhoc(\%dcroles,\%helpdeskroles,$update,$then);
+ my $loncaparev = $r->dir_config('lonVersion');
# ================================================================== Roles Init
+ if ($env{'form.selectrole'}) {
+
+ my $locknum=&Apache::lonnet::get_locks();
+ if ($locknum) { return 409; }
- if ($ENV{'form.selectrole'}) {
- if ($ENV{'request.course.id'}) {
- my %temp=('logout_'.$ENV{'request.course.id'} => time);
+ my $custom_adhoc;
+ if ($env{'form.newrole'}) {
+ $env{'form.'.$env{'form.newrole'}}=1;
+# Check if this is a Domain Helpdesk or Domain Helpdesk Assistant role trying to enter a course
+ if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/\w+\./\1/$match_courseid$}) {
+ if ($helpdeskroles{$1}) {
+ $custom_adhoc = 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.course.timechecked" => '',
+ "request.role" => 'cm',
+ "request.role.adv" => $env{'user.adv'},
+ "request.role.domain" => $env{'user.domain'}});
+# Check if Domain Helpdesk role trying to enter a course needs privs to be created
+ if ($env{'form.newrole'} =~ m{^cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)(?:/(\w+)|$)}) {
+ my $cdom = $1;
+ my $rolename = $2;
+ my $cnum = $3;
+ my $sec = $4;
+ if ($custom_adhoc) {
+ my ($possroles,$description) = &Apache::lonnet::get_my_adhocroles($cdom.'_'.$cnum,1);
+ if (ref($possroles) eq 'ARRAY') {
+ if (grep(/^\Q$rolename\E$/,@{$possroles})) {
+ if (&Apache::lonnet::check_adhoc_privs($cdom,$cnum,$update,$refresh,$now,
+ "cr/$cdom/$cdom".'-domainconfig/'.$rolename,undef,$sec)) {
+ &Apache::lonnet::appenv({"environment.internal.$cdom.$cnum.cr/$cdom/$cdom".'-domainconfig/'."$rolename.adhoc" => time});
+ }
+ }
+ }
+ }
+ } elsif (($numdc > 0) || ($numhelpdesk > 0)) {
+# Check if user is a DC trying to enter a course or author space and needs privs to be created
+# Check if user is a DH or DA trying to enter a course and needs privs to be created
+ foreach my $envkey (keys(%env)) {
+ if ($numdc) {
+# Is this an ad-hoc Coordinator role?
+ if (my ($ccrole,$domain,$coursenum) =
+ ($envkey =~ m-^form\.(cc|co)\./($match_domain)/($match_courseid)$-)) {
+ if ($dcroles{$domain}) {
+ if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,
+ $update,$refresh,$now,$ccrole)) {
+ &Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.$ccrole.adhoc" => time});
+ }
+ }
+ 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);
+ return OK;
+ }
+ 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);
+ return OK;
+ }
+ 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);
+ return OK;
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ last;
+ }
+ }
+ if ($numhelpdesk) {
+# Is this an ad hoc custom role in a course/community?
+ if (my ($domain,$rolename,$coursenum,$sec) = ($envkey =~ m{^form\.cr/($match_domain)/\1\-domainconfig/(\w+)\./\1/($match_courseid)(?:/(\w+)|$)})) {
+ if ($helpdeskroles{$domain}) {
+ my ($possroles,$description) = &Apache::lonnet::get_my_adhocroles($domain.'_'.$coursenum,1);
+ if (ref($possroles) eq 'ARRAY') {
+ if (grep(/^\Q$rolename\E$/,@{$possroles})) {
+ if (&Apache::lonnet::check_adhoc_privs($domain,$coursenum,$update,$refresh,$now,
+ "cr/$domain/$domain".'-domainconfig/'.$rolename,
+ undef,$sec)) {
+ &Apache::lonnet::appenv({"environment.internal.$domain.$coursenum.cr/$domain/$domain".
+ '-domainconfig/'."$rolename.adhoc" => time});
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ } else {
+ delete($env{$envkey});
+ }
+ last;
+ }
+ }
+ }
}
- &Apache::lonnet::appenv("request.course.id" => '',
- "request.course.fn" => '',
- "request.course.uri" => '',
- "request.course.sec" => '',
- "request.role" => 'cm',
- "request.role.domain" => $ENV{'user.domain'});
- foreach $envkey (keys %ENV) {
+
+ foreach $envkey (keys(%env)) {
next if ($envkey!~/^user\.role\./);
- my (undef,undef,$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') {
- $where=~s/^\///;
- my ($cdom,$cnum,$csec)=split(/\//,$where);
+ 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) =
+ &Apache::loncommon::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;
+ $r->print(&Apache::loncommon::check_release_result($switchwarning,$switchserver));
+ 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')) {
- unless (&Apache::lonnet::validate_access_key(
- $ENV{'environment.key.'.$cdom.'_'.$cnum},
- $cdom,$cnum)) {
+ 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'}) {
+ if ($env{'form.newkey'}) {
# student attempts to register a new key
- } else {
+ &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 $ip = &Apache::lonnet::get_requestor_ip();
+ 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]'
+ ,$ip
+ ,&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
- $r->content_type('text/html');
- &Apache::loncommon::no_cache($r);
- $r->send_http_header;
- my $swinfo=&Apache::lonmenu::rawconfig();
- my $bodytag=&Apache::loncommon::bodytag
- ('Enter Access Key to Unlock this Course');
- $r->print(<Entering Course Access Key
-
-
-$bodytag
-
-
-