--- loncom/auth/lonroles.pm 2000/10/02 21:34:58 1.9 +++ loncom/auth/lonroles.pm 2023/01/20 23:28:19 1.269.2.39.2.7 @@ -1,299 +1,3555 @@ # 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 Gerd Kortemeyer # +# $Id: lonroles.pm,v 1.269.2.39.2.7 2023/01/20 23:28:19 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::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,$only_body) = @_; + &Apache::loncommon::content_type($r,'text/html'); + &Apache::loncommon::no_cache($r); + $r->send_http_header; + if ($only_body) { + $r->print(&Apache::loncommon::start_page($title,undef,{'only_body' => 1, + 'add_progressbar' => 1})); + } else { + 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,$only_body) = @_; + my $link = ''; + my $end_page = &Apache::loncommon::end_page(); + my $js_url = &js_escape($url); + my $remote_js; + if ($env{'environment.remote'} eq 'on') { + my ($menucoll,$deeplinkmenu,$menuref) = &Apache::loncommon::menucoll_in_effect(); + if ($menucoll) { + &Apache::lonnet::put('environment',{'remote' => 'off'}); + &Apache::lonnet::appenv({'environment.remote' => 'off'}); + my $menu_name = &Apache::lonmenu::get_menu_name(); + $remote_js = < a').removeAttr("aria-disabled"); + \$('.isDisabled').removeClass("isDisabled"); +REENABLE + } + $r->print(< +// + +$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; - $r->content_type('text/html'); - $r->send_http_header; - return OK if $r->header_only; -# ---------------------------------------------------------------- Print Header - $r->print(< - -LON-CAPA User Roles -ENDHEADER - if ($ENV{'form.orgurl'}) { - $r->print(''); + # 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; } - $r->print(''); my $now=time; - my $then=$ENV{'user.login.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; + } + + 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'}) { - 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); - $r->print('

Role initialized

'); - return OK; - } - } - } - } + my $locknum=&Apache::lonnet::get_locks(); + if ($locknum) { return 409; } + + 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.course.suppupdated" => '', + "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; + } + } + } + } + + 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) = + &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')) { +# 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 $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(< +// + +
+ + +$message
+ +
+$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')) { + if ($role =~ m{^\Qcr/$cdom/$cdom\E\-domainconfig/(\w+)$}) { + my $rolename = $1; + my %domdef = &Apache::lonnet::get_domain_defaults($cdom); + if (ref($domdef{'adhocroles'}) eq 'HASH') { + if (ref($domdef{'adhocroles'}{$rolename}) eq 'HASH') { + &Apache::lonnet::appenv({'request.role.desc' => $domdef{'adhocroles'}{$rolename}{'desc'}}); + } + } + } + my $crstype = &Apache::loncommon::course_type($cdom.'_'.$cnum); + $crstype = lc($crstype); + my ($msg,$critmsg_check,$title,$loadmsg,$only_body); + $critmsg_check = 1; + $title = &mt("Loading $crstype"); + $loadmsg = &mt("Please be patient while your $crstype loads"); + if (($env{'request.deeplink.login'}) && ($env{'request.linkprot'})) { + if ($env{'request.linkprot'} =~ /^\d+(c|d):\Q$env{'form.destinationurl'}\E$/) { + $title = &mt('Loading LON-CAPA session'); + $loadmsg = &mt('Please be patient while LON-CAPA loads'); + $only_body = 1; + $critmsg_check = 0; + } + } + my $preamble = '
'. + '
'. + $loadmsg. + '
'. + '
'; + my $closure = < +// + +ENDCLOSE + &start_loading_course($r,$title,$only_body); + my %prog_state = &Apache::lonhtmlcommon::Create_PrgWin($r,undef,$preamble); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Loading ...')); + $r->rflush(); + if ($critmsg_check) { + my $blockcrit = &Apache::loncommon::blocking_status('alert',$clientip,$cnum,$cdom,undef,1); + if ($blockcrit) { + my $checkrole = "cm./$cdom/$cnum"; + if ($csec ne '') { + $checkrole .= "/$csec"; + } + unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && + ($trolecode !~ m{^st\./$cdom/$cnum})) { + $critmsg_check = 0; + } + } + } + my ($furl,$ferr)= + &Apache::lonuserstate::readmap($cdom.'/'.$cnum,$critmsg_check); + &Apache::lonhtmlcommon::Update_PrgWin($r,\%prog_state,&mt('Finished!')); + &Apache::lonhtmlcommon::Close_PrgWin($r,\%prog_state); + $r->print($closure); + $r->rflush(); + if ($ferr) { + $furl = '/adm/roles?tryagain=1'; + } else { + &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); + unless (($env{'form.switchrole'}) || + ($env{"environment.internal.$cdom.$cnum.$role.adhoc"})) { + &Apache::lonnet::put('nohist_crslastlogin', + {$env{'user.name'}.':'.$env{'user.domain'}. + ':'.$csec.':'.$role => $now},$cdom,$cnum); + } + if (($env{"environment.internal.$cdom.$cnum.$role.adhoc"}) && + (&Apache::lonnet::allowed('vxc',$cdom.'_'.$cnum))) { + my $owner = $env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'}; + my @coowners = split(/,/,$env{'course.'.$env{'request.course.id'}.'.internal.co-owners'}); + my %auaccess; + foreach my $user ($owner,@coowners) { + my ($cpname,$cpdom) = split(/:/,$user); + my %auroles = &Apache::lonnet::get_my_roles($cpname,$cpdom,'userroles',undef,['au','ca','aa'],[$cdom]); + foreach my $key (keys(%auroles)) { + my ($auname,$audom,$aurole) = split(/:/,$key); + if ($aurole eq 'au') { + $auaccess{$cpname} = 1; + } else { + $auaccess{$auname} = 1; + } + } + } + &Apache::lonnet::appenv({'request.course.adhocsrcaccess' => join(',',sort(keys(%auaccess))) }); + } + my ($feeds,$syllabus_time); + &Apache::lonrss::advertisefeeds($cnum,$cdom,undef,\$feeds); + &Apache::lonnet::appenv({'request.course.feeds' => $feeds}); + unless ($env{'course.'.$cdom.'_'.$cnum.'.updatedsyllabus'}) { + unless (($env{'course.'.$cdom.'_'.$cnum.'.externalsyllabus'}) || + ($env{'course.'.$cdom.'_'.$cnum.'.uploadedsyllabus'})) { + my %syllabus=&Apache::lonnet::dump('syllabus',$cdom,$cnum); + $syllabus_time = $syllabus{'uploaded.lastmodified'}; + if ($syllabus_time) { + &Apache::lonnet::appenv({'request.course.syllabustime' => $syllabus_time}); + } + } + } + } + if (($env{'form.orgurl'}) && + ($env{'form.orgurl'}!~/^\/adm\/flip/) && + ($env{'form.orgurl'} ne '/adm/roles')) { + 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) { + if ($env{'form.orgurl'}) { + $furl .= '&orgurl='.&HTML::Entities::encode($env{'form.orgurl'},'<>&"'); + } + if ($env{'form.symb'}) { + $furl .= '&symb='.&HTML::Entities::encode($env{'form.symb'},'<>&"'); + } + } else { + &set_supplemental_access($cnum,$cdom); + } + if (($ferr) && ($tadv)) { + &error_page($r,$ferr,$furl); + } else { + if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { + if (($env{'form.orgurl'} ne '') && ($env{'form.symb'} ne '')) { + unless (&Apache::lonnet::symbverify($env{'form.symb'},$env{'form.orgurl'})) { + $dest=$env{'form.orgurl'}; + } + } + } + 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); + } + } + if ($ferr) { + if (!$env{'request.course.id'}) { + &Apache::lonnet::appenv( + {"request.course.id" => $cdom.'_'.$cnum}); + $r->print('

'. + &mt('Could not initialize [_1] at this time.', + $env{'course.'.$cdom.'_'.$cnum.'.description'}). + '

'. + '

'. + &mt('Please try again.').'

'. + &Apache::loncommon::end_page()); + } + } else { + if ($env{'request.deeplink.login'}) { + &set_deeplink_target($cnum,$cdom); + } + $msg = '

'.&mt('Entering [_1] ...', + $env{'course.'.$cdom.'_'.$cnum.'.description'}). + '

'; + &finish_loading_course($r,$msg,$dest,$only_body); + } + } + $r->rflush(); + return OK; + } else { + if (!$env{'request.course.id'}) { + &Apache::lonnet::appenv( + {"request.course.id" => $cdom.'_'.$cnum}); + } + if (&Apache::lonnet::allowed('adv') eq 'F') { $tadv=1; } + &Apache::lonnet::appenv({'request.role.adv'=>$tadv}); + if ($ferr) { + if ($tadv) { + &error_page($r,$ferr,$furl); + } else { + $r->print('

'. + &mt('Could not initialize [_1] at this time.', + $env{'course.'.$cdom.'_'.$cnum.'.description'}). + '

'. + '

'.&mt('Please try again.').'

'. + &Apache::loncommon::end_page()); + } + } else { + &set_supplemental_access($cnum,$cdom); + if ($env{'request.deeplink.login'}) { + &set_deeplink_target($cnum,$cdom); + } + # Check to see if the user is a CC entering a course + # for the first time + if ((($role eq 'cc') || ($role eq 'co')) + && ($env{'course.'.$cdom.'_'.$cnum.'.course.helper.not.run'})) { + $furl = "/adm/helper/course.initialization.helper"; + # Send the user to the course they selected + } elsif ($env{'request.course.id'}) { + my ($dest,$destsymb,$checkenc); + $dest = $env{'form.destinationurl'}; + $destsymb = $env{'form.destsymb'}; + if ($dest ne '') { + if ($env{'form.switchrole'}) { + if ($destsymb ne '') { + if ($destsymb !~ m{^/enc/}) { + unless ($env{'request.role.adv'}) { + $checkenc = 1; + } + } + } + if (($dest =~ m{^\Q/public/$cdom/$cnum/syllabus\E.*(\?|\&)usehttp=1}) || + ($dest =~ m{^\Q/adm/wrapper/ext/\E(?!https:)})) { + if ($ENV{'SERVER_PORT'} == 443) { + my $hostname = $r->hostname(); + unless ((&Apache::lonnet::uses_sts()) || + (&Apache::lonnet::waf_allssl($hostname))) { + if ($hostname ne '') { + $dest = 'http://'.$hostname.$dest; + } + } + } + } + if ($dest =~ m{^/enc/}) { + if ($env{'request.role.adv'}) { + $dest = &Apache::lonenc::unencrypted($dest); + if ($destsymb eq '') { + ($destsymb) = ($dest =~ /(?:\?|\&)symb=([^\&]*)/); + $destsymb = &unescape($destsymb); + } + } + } else { + if ($destsymb eq '') { + ($destsymb) = ($dest =~ /(?:\?|\&)symb=([^\&]+)/); + $destsymb = &unescape($destsymb); + } + unless ($env{'request.role.adv'}) { + $checkenc = 1; + } + } + if (($checkenc) && ($destsymb ne '')) { + my ($encstate,$unencsymb,$res); + $unencsymb = &Apache::lonnet::symbclean($destsymb); + (undef,undef,$res) = &Apache::lonnet::decode_symb($unencsymb); + &Apache::lonnet::symbverify($unencsymb,$res,\$encstate); + if ($encstate) { + if (($dest ne '') && ($dest !~ m{^/enc/})) { + $dest=&Apache::lonenc::encrypted($dest); + } + } + } + } + unless (($dest =~ m{^/enc/}) || ($dest =~ /(\?|\&)symb=.+___\d+___.+/)) { + if (($destsymb ne '') && ($destsymb !~ m{^/enc/})) { + my $esc_symb = &escape($destsymb); + $dest .= (($dest =~/\?/)? '&':'?').'symb='.$esc_symb; + } + } + if ($env{'form.ttoken'}) { + $dest .= (($dest =~/\?/)? '&':'?').'ttoken='.$env{'form.ttoken'}; + } + unless ($env{'request.deeplink.login'}) { + $msg = '

'.&mt('Entering [_1] ...', + $env{'course.'.$cdom.'_'.$cnum.'.description'}). + '

'; + } + &finish_loading_course($r,$msg,$dest,$only_body); + $r->rflush(); + 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($env{'request.course.id'}); + unless ($startpage eq 'firstres') { + $msg = '

'.&mt('Entering [_1] ...', + $env{'course.'.$cdom.'_'.$cnum.'.description'}). + '

'; + &finish_loading_course($r,$msg,'/adm/whatsnew?refpage=start',$only_body); + $r->rflush(); + return OK; + } + } + } + # Are we allowed to look at the first resource? + # + # $furl returned by lonuserstate::readmap() has format: + # $url?symb=escaped($symb). If the resource has the + # encrypturl parameter in effect, the entire string + # $url?symb=escaped($symb) is encrypted as a string + # beginning /enc/. + # + my ($access,$unencfurl,$unencsymb); + if ($furl =~ m{^(.+)(?:\?|\&)symb=([^&]+)(?:$|&)}) { + my ($poss_url,$poss_symb) = ($1,$2); + $unencsymb = &unescape($poss_symb); + $unencfurl = $poss_url; + } elsif ($furl =~ m{^/enc/}) { + my $unenc = &Apache::lonenc::unencrypted($furl); + if ($unenc =~ m{^(.+)(?:\?|\&)symb=([^&]+)(?:$|&)}) { + ($unencfurl,$unencsymb) = ($1,$2); + $unencsymb = &unescape($unencsymb); + } else { + $unencfurl = $unenc; + } + } else { + $unencfurl = $furl; + } + if ($unencsymb) { + my $symb = &Apache::lonnet::symbclean($unencsymb); + if (($symb ne '') && (&Apache::lonnet::symbverify($symb,$unencfurl))) { + $access = &Apache::lonnet::allowed('bre',$unencfurl,$symb); + } else { + $access = &Apache::lonnet::allowed('bre',$unencfurl); + } + } else { + $access = &Apache::lonnet::allowed('bre',$unencfurl); + } + if ((!$access) || ($access eq 'B') || ($access eq 'D')) { + $furl = &Apache::lonpageflip::first_accessible_resource(); + if ($furl eq '') { + $furl = '/adm/navmaps?showOnlyHomework=1'; + } + } + $msg = '

'.&mt('Entering [_1] ...', + $env{'course.'.$cdom.'_'.$cnum.'.description'}). + '

'; + &finish_loading_course($r,$msg,$furl,$only_body); + } + $r->rflush(); + 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 .= '/'; + if ($env{'form.orgurl'} =~ /^\Q$redirect_url\E/) { + my ($path) = ($env{'form.orgurl'} =~ m{^(.+)/[^/]+$}); + if (($path ne '') && (-e $Apache::lonnet::perlvar{'lonDocRoot'}.$path)) { + $redirect_url = $env{'form.orgurl'}; + } + } + &redirect_user($r,&mt('Entering Authoring 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 'dh') { + my $redirect_url = '/adm/menu/'; + &redirect_user($r,&mt('Loading Domain Helpdesk Menu'), + $redirect_url); + return OK; + } + if ($role eq 'da') { + my $redirect_url = '/adm/menu/'; + &redirect_user($r,&mt('Loading Domain Helpdesk Assistant 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; + } + } + } } - - $r->print('

Role not active

'); - return OK; } + + # =============================================================== No Roles Init -# ------------------------------------------ Get Error Message from Environment + &Apache::loncommon::content_type($r,'text/html'); + &Apache::loncommon::no_cache($r); + $r->send_http_header; + return OK if $r->header_only; - my ($fn,$priv,$nochoose,$error,$msg)=split(/:/,$ENV{'user.error.msg'}); - $r->log_reason( - "$msg for $ENV{'user.name'} domain $ENV{'user.domain'} access $priv",$fn); + my $crumbtext = 'User Roles'; + my $pagetitle = 'My Roles'; + my $recent = &mt('Recent Roles'); + my $standby = &mt('Role selected. Please stand by.'); + my $show_course=&Apache::loncommon::show_course(); + if ($show_course) { + $crumbtext = 'Courses'; + $pagetitle = 'My Courses'; + $recent = &mt('Recent Courses'); + $standby = &mt('Course selected. Please stand by.'); + } + if (($norolelist) && ((split(/:/,$env{'user.error.msg'}))[2])) { + $crumbtext = 'Access Denied'; + $pagetitle = 'Unauthorized'; + } + my $brcrum =[{href=>"/adm/roles",text=>$crumbtext}]; -# ---------------------------------------------------------------- Who is this? + my %roles_in_env; + my $showcount = &roles_from_env(\%roles_in_env,$update); - my $advanced=0; - foreach $envkey (keys %ENV) { - if ($envkey=~/^user\.role\./) { - my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey); - if ($role ne 'st') { $advanced=1; } + my $swinfo=&Apache::lonmenu::rawconfig(); + my %domdefs=&Apache::lonnet::get_domain_defaults($env{'user.domain'}); + my $cattype = 'std'; + if ($domdefs{'catauth'}) { + $cattype = $domdefs{'catauth'}; + } + my ($funcs,$crumbsright); + unless (($norolelist) && ((split(/:/,$env{'user.error.msg'}))[2])) { + $funcs = &get_roles_functions($showcount,$cattype); + if ($env{'browser.mobile'}) { + $crumbsright = $funcs; + undef($funcs); } } + my $start_page=&Apache::loncommon::start_page($pagetitle,undef,{bread_crumbs=>$brcrum, + bread_crumbs_component=>$crumbsright}); + &js_escape(\$standby); + 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.').'
'; -# ---------------------------------------------- Get cached course descriptions + $r->print(< +$noscript + + +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); + } + +# ------------------------------------------------- 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->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.'). + '

'); + } + } } -# -------------------------------------------------------- Choice or no choice? if ($nochoose) { - if ($advanced) { - $r->print("

Assigned User Roles

\n"); - } else { - $r->print("

Sorry ...

\nThis resource might be part of"); - if ($ENV{'request.course.id'}) { - $r->print(' another'); - } else { - $r->print(' a certain'); - } - $r->print(' course.'); - return OK; - } - } else { - if ($advanced) { - $r->print("

Select a User Role

\n"); - } else { - $r->print("

Enter a Course

\n"); - } - $r->print('
'); - $r->print(''); - $r->print(''); + $r->print("

".&mt('Sorry ...')."

\n". + &mt('This action is currently not authorized.').''); + if ($error && $norolelist) { + $r->print('

'. + &mt('As your session was launched from a web page external to LON-CAPA some course content may be unavailable, including the resource you were trying to access.'). + '

'. + '

'. + &mt('You may need to login to LON-CAPA directly, or re-launch from a different external system.'). + '

'); + } + $r->print(&Apache::loncommon::end_page()); + return OK; + } else { + if ($updateresult || $reqauthor || $hotlist) { + my $showresult = '
'; + if ($updateresult) { + $showresult .= &Apache::lonhtmlcommon::confirm_success($updateresult); + } + if ($reqauthor) { + $showresult .= &Apache::lonhtmlcommon::confirm_success($reqauthor); + } + if ($hotlist) { + $showresult .= $hotlist; + } + $showresult .= '
'; + $r->print($showresult); + } elsif ($env{'form.state'} eq 'queued') { + $r->print(&get_queued()); + } + if (($ENV{'REDIRECT_QUERY_STRING'}) && ($fn)) { + $fn.='?'.$ENV{'REDIRECT_QUERY_STRING'}; + } + my $display = ($env{'form.display'} =~ /^(showall)$/); + $r->print(''); + $r->print(''); + $r->print(''); + $r->print(''); + $r->print(''); + $r->print(''); + if ($blocked_by_ip) { + my $blocked_role = 'student'; + if ($blocked_type eq 'Community') { + $blocked_role = 'member'; + } + $r->print('

'. + &mt('The [_1] you selected is not available for access with a [_2] role from your current IP address: [_3].', + lc($blocked_type),$blocked_role,$clientip). + '

'); + } + } + $r->rflush(); + + my (%roletext,%sortrole,%roleclass,%futureroles,%timezones); + my ($countactive,$countfuture,$inrole,$possiblerole) = + &gather_roles($update,$refresh,$now,$reinit,$nochoose,\%roles_in_env,\%roletext, + \%sortrole,\%roleclass,\%futureroles,\%timezones,$loncaparev); + $refresh = $now; + &Apache::lonnet::appenv({'user.refresh.time' => $refresh}); + if ((($cattype eq 'std') || ($cattype eq 'domonly')) && (!$env{'user.adv'})) { + if ($countactive > 0) { + my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + $r->print( + '

' + .&mt('[_1]Visit the [_2]Course/Community Catalog[_3][_4]' + .' to view all [_5] LON-CAPA courses and communities.' + ,'' + ,'' + ,'' + ,'' + ,'"'.$domdesc.'"') + .'
' + .&mt('If a course or community is [_1]not[_2] in your list of current courses and communities below,' + .' you may be able to enroll if self-enrollment is permitted.' + ,'','') + .'

' + ); + } + } + + if ($norolelist) { + if ($env{'request.role'}) { + my ($roletext,$role_text_end) = &display_curr_role($env{'request.role'}); + if ($roletext) { + $r->print(&Apache::loncommon::start_data_table('LC_textsize_mobile'). + &Apache::loncommon::start_data_table_row(). + $roletext. + &Apache::loncommon::end_data_table_row()); + if ($role_text_end) { + $r->print(&Apache::loncommon::continue_data_table_row(). + $role_text_end. + &Apache::loncommon::end_data_table_row()); + } + $r->print(&Apache::loncommon::end_data_table()); + } + } + $r->print(&Apache::loncommon::end_page()); + return OK; + } + +# No active roles + if ($countactive==0) { + my $elapsed = 0; + if ($now && $update) { + $elapsed = $now - $update; + } + &requestcourse_advice($r,$cattype,$inrole,$elapsed); + $r->print('
'); + if ($countfuture) { + $r->print(&mt('The following [quant,_1,role,roles] will become active in the future:',$countfuture)); + my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole, + $nochoose); + &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles, + \%roletext,$update,$then); + my $tremark=''; + my $tbg; + if ($env{'request.role'} eq 'cm') { + $tbg="LC_roles_selected"; + $tremark=&mt('Currently selected.').' '; + } else { + $tbg="LC_roles_is"; + } + $r->print(&Apache::loncommon::start_data_table_row() + .' ' + .'' + .&mt('No role specified') + .'' + .''.$tremark.' ' + .&Apache::loncommon::end_data_table_row() + ); + + $r->print(&Apache::loncommon::end_data_table()); + } + $r->print(&Apache::loncommon::end_page()); + return OK; } # ----------------------------------------------------------------------- Table - $r->print(''); - unless ($nochoose) { $r->print(''); } + + if (($numdc > 0) || (($numhelpdesk > 0) && ($numadhoc > 0))) { + $r->print(&coursepick_jscript(). + &Apache::loncommon::coursebrowser_javascript()); + } + if ($numdc > 0) { + $r->print(&Apache::loncommon::authorbrowser_javascript()); + } + + unless ((!&Apache::loncommon::show_course()) || ($nochoose) || ($countactive==1)) { + $r->print("

".&mt('Select a Course to Enter')."

\n"); + } + if ($env{'form.destinationurl'}) { + $r->print(''); + if ($env{'form.destsymb'} ne '') { + $r->print(''); + } + } + + my $doheaders = &roletable_headers($r,\%roleclass,\%sortrole,$nochoose); + if ($env{'environment.recentroles'}) { + my %recent_roles = + &Apache::lonhtmlcommon::get_recent('roles',$env{'environment.recentrolesn'}); + my $output=''; + foreach my $role (sort(keys(%recent_roles))) { + if (ref($roletext{'user.role.'.$role}) eq 'ARRAY') { + $output.= &Apache::loncommon::start_data_table_row(). + $roletext{'user.role.'.$role}->[0]. + &Apache::loncommon::end_data_table_row(); + if ($roletext{'user.role.'.$role}->[1] ne '') { + $output .= &Apache::loncommon::continue_data_table_row(). + $roletext{'user.role.'.$role}->[1]. + &Apache::loncommon::end_data_table_row(); + } + if ($role =~ m{^dc\./($match_domain)/$} + && $dcroles{$1}) { + $output .= &adhoc_roles_row($1,'recent'); + } elsif ($role =~ m{^(dh|da)\./($match_domain)/$}) { + $output .= &adhoc_customroles_row($1,$2,'recent',$update,$then); + } + } elsif ($numdc > 0) { + unless ($role =~/^error\:/) { + my ($roletext,$role_text_end) = &display_cc_role('user.role.'.$role); + if ($roletext) { + $output.= &Apache::loncommon::start_data_table_row(). + $roletext. + &Apache::loncommon::end_data_table_row(); + if ($role_text_end) { + $output .= &Apache::loncommon::continue_data_table_row(). + $role_text_end. + &Apache::loncommon::end_data_table_row(); + } + } + } + } + } + if ($output) { + $r->print(&Apache::loncommon::start_data_table_empty_row() + .'' + .&Apache::loncommon::end_data_table_empty_row() + ); + $r->print($output); + $doheaders ++; + } + } + &print_rolerows($r,$doheaders,\%roleclass,\%sortrole,\%dcroles,\%roletext,$update,$then); + if ($countactive > 1) { + my $tremark=''; + my $tbg; + if ($env{'request.role'} eq 'cm') { + $tbg="LC_roles_selected"; + $tremark=&mt('Currently selected.').' '; + } else { + $tbg="LC_roles_is"; + } + $r->print(&Apache::loncommon::start_data_table_row()); + unless ($nochoose) { + if ($env{'request.role'} ne 'cm') { + $r->print(''); + } else { + $r->print(''); + } + } + $r->print('' + .'' + .&Apache::loncommon::end_data_table_row() + ); + } + $r->print(&Apache::loncommon::end_data_table()); + unless ($nochoose) { + $r->print("\n"); + } +# ------------------------------------------------------------ Privileges Info + if (($advanced) && (($env{'user.error.msg'}) || ($error))) { + $r->print('

'.&mt('Current Privileges').'

'); + $r->print(&privileges_info()); + } + my $announcements = &Apache::lonnet::getannounce(); + $r->print( + '
'. + '

'.&mt('Announcements').'

'. + $announcements + ) unless (!$announcements); if ($advanced) { - $r->print(''. - ''."\n"); - } else { - $r->print(''."\n"); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + $r->print('

' + .&mt('This LON-CAPA server is version [_1]',$r->dir_config('lonVersion')) + .'

'); } + $r->print(&Apache::loncommon::end_page()); + return OK; +} - foreach $envkey (sort keys %ENV) { - if ($envkey=~/^user\.role\./) { - my ($dum1,$dum2,$role,@pwhere)=split(/\./,$envkey); - my $where=join('.',@pwhere); - my $trolecode=$role.'.'.$where; - my ($tstart,$tend)=split(/\./,$ENV{$envkey}); - my $tremark=''; - my $tstatus='is'; - my $tpstart=' '; - my $tpend=' '; - if ($tstart) { - if ($tstart>$then) { - $tstatus='future'; - if ($tstart<$now) { $tstatus='will'; } - } - $tpstart=localtime($tstart); - } - if ($tend) { - if ($tend<$then) { $tstatus='expired'; } - if ($tend>$now) { $tstatus='will_not'; } - $tpend=localtime($tend); +sub roles_from_env { + my ($roleshash,$update) = @_; + my $count = 0; + if (ref($roleshash) eq 'HASH') { + foreach my $envkey (keys(%env)) { + if ($envkey =~ m{^user\.role\.(\w+)[./]}) { + next if ($1 eq 'gr'); + $roleshash->{$envkey} = $env{$envkey}; + my ($start,$end) = split(/\./,$env{$envkey}); + unless ($end && $end<$update) { + $count ++; + } } - if ($ENV{'request.role'} eq $trolecode) { - $tstatus='selected'; + } + } + return $count; +} + +sub gather_roles { + my ($update,$refresh,$now,$reinit,$nochoose,$roles_in_env,$roletext,$sortrole,$roleclass,$futureroles, + $timezones,$loncaparev) = @_; + my ($countactive,$countfuture,$inrole,$possiblerole) = (0,0,0,''); + my $advanced = $env{'user.adv'}; + my $tryagain = $env{'form.tryagain'}; + my @ids = &Apache::lonnet::current_machine_ids(); + if (ref($roles_in_env) eq 'HASH') { + my %adhocdesc; + foreach my $envkey (sort(keys(%{$roles_in_env}))) { + my $button = 1; + my $switchserver=''; + my $switchwarning; + my ($role_text,$role_text_end,$sortkey,$role,$where,$trolecode,$tstart, + $tend,$tremark,$tstatus,$tpstart,$tpend); + &Apache::lonnet::role_status($envkey,$update,$refresh,$now,\$role,\$where, + \$trolecode,\$tstatus,\$tstart,\$tend); + next if (!defined($role) || $role eq '' || $role =~ /^gr/); + $tremark=''; + $tpstart=' '; + $tpend=' '; + if ($env{'request.role'} eq $trolecode) { + $tstatus='selected'; } my $tbg; - if ($tstatus eq 'is') { - $tbg='#77FF77'; - } elsif ($tstatus eq 'future') { - $tbg='#FFFF77'; - } elsif ($tstatus eq 'will') { - $tbg='#FFAA77'; - $tremark.='Active at next login. '; - } elsif ($tstatus eq 'expired') { - $tbg='#FF7777'; - } elsif ($tstatus eq 'will_not') { - $tbg='#AAFF77'; - $tremark.='Expired after logout. '; - } elsif ($tstatus eq 'selected') { - $tbg='#33FF33'; - $tremark.='Currently selected. '; + if (($tstatus eq 'is') + || ($tstatus eq 'selected') + || ($tstatus eq 'future') + || ($env{'form.display'} eq 'showall')) { + my $timezone = &role_timezone($where,$timezones); + if ($tstart) { + $tpstart=&Apache::lonlocal::locallocaltime($tstart,$timezone); + } + if ($tend) { + $tpend=&Apache::lonlocal::locallocaltime($tend,$timezone); + } + if ($tstatus eq 'is') { + $tbg='LC_roles_is'; + $possiblerole=$trolecode; + $countactive++; + } elsif ($tstatus eq 'future') { + $tbg='LC_roles_future'; + $button=0; + $futureroles->{$trolecode} = $tstart.':'.$tend; + $countfuture ++; + } elsif ($tstatus eq 'expired') { + $tbg='LC_roles_expired'; + $button=0; + } elsif ($tstatus eq 'will_not') { + $tbg='LC_roles_will_not'; + $tremark.=&mt('Expired after logout.').' '; + } elsif ($tstatus eq 'selected') { + $tbg='LC_roles_selected'; + $inrole=1; + $countactive++; + $tremark.=&mt('Currently selected.').' '; + } + my $trole; + if ($role =~ /^cr\//) { + my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); + unless ($rauthor eq $rdomain.'-domainconfig') { + if ($tremark) { $tremark.='
'; } + $tremark.=&mt('Custom role defined by [_1].',$rauthor.':'.$rdomain); + } + } + $trole=Apache::lonnet::plaintext($role); + my $ttype; + my $twhere; + my $skipcal; + my ($tdom,$trest,$tsection)= + split(/\//,Apache::lonnet::declutter($where)); + # First, Co-Authorship roles + if (($role eq 'ca') || ($role eq 'aa')) { + my $home = &Apache::lonnet::homeserver($trest,$tdom); + my $allowed=0; + foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } + if (!$allowed) { + $button=0; + $switchserver='otherserver='.$home.'&role='.$trolecode; + } + #next if ($home eq 'no_host'); + $home = &Apache::lonnet::hostname($home); + $ttype='Authoring Space'; + $twhere=&mt('User').': '.$trest.'
'.&mt('Domain'). + ': '.$tdom.'
'. + ' '.&mt('Server').': '.$home; + $env{'course.'.$tdom.'_'.$trest.'.description'}='ca'; + $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$trest.'/'); + $sortkey=$role."$trest:$tdom"; + } elsif ($role eq 'au') { + # Authors + my $home = &Apache::lonnet::homeserver + ($env{'user.name'},$env{'user.domain'}); + my $allowed=0; + foreach my $id (@ids) { if ($id eq $home) { $allowed=1; } } + if (!$allowed) { + $button=0; + $switchserver='otherserver='.$home.'&role='.$trolecode; + } + #next if ($home eq 'no_host'); + $home = &Apache::lonnet::hostname($home); + $ttype='Authoring Space'; + $twhere=&mt('Domain').': '.$tdom.'
'.&mt('Server'). + ': '.$home; + $env{'course.'.$tdom.'_'.$trest.'.description'}='ca'; + $tremark.=&Apache::lonhtmlcommon::authorbombs('/res/'.$tdom.'/'.$env{'user.name'}.'/'); + $sortkey=$role; + } elsif ($trest) { + my $tcourseid=$tdom.'_'.$trest; + $ttype = &Apache::loncommon::course_type($tcourseid); + if ($role !~ /^cr/) { + $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid); + } elsif ($role =~ m{^\Qcr/$tdom/$tdom\E\-domainconfig/(\w+)$}) { + my $rolename = $1; + my $desc; + if (ref($adhocdesc{$tdom}) eq 'HASH') { + $desc = $adhocdesc{$tdom}{$rolename}; + } else { + my %domdef = &Apache::lonnet::get_domain_defaults($tdom); + if (ref($domdef{'adhocroles'}) eq 'HASH') { + foreach my $rolename (sort(keys(%{$domdef{'adhocroles'}}))) { + if (ref($domdef{'adhocroles'}{$rolename}) eq 'HASH') { + $adhocdesc{$tdom}{$rolename} = $domdef{'adhocroles'}{$rolename}{'desc'}; + $desc = $adhocdesc{$tdom}{$rolename}; + } + } + } + } + if ($desc ne '') { + $trole = $desc; + } else { + $trole = &mt('Helpdesk[_1]',' '.$rolename); + } + } else { + $trole = (split(/\//,$role,4))[-1]; + } + if ($env{'course.'.$tcourseid.'.description'}) { + my $home=$env{'course.'.$tcourseid.'.home'}; + $twhere=$env{'course.'.$tcourseid.'.description'}; + $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey; + $twhere = &HTML::Entities::encode($twhere,'"<>&'); + unless ($twhere eq &mt('Currently not available')) { + $twhere.=' '. + &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom). + ''; + unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') { + my $required = $env{'course.'.$tcourseid.'.internal.releaserequired'}; + if ($required ne '') { + ($switchserver,$switchwarning) = + &Apache::loncommon::check_release_required($loncaparev,$tcourseid,$trolecode,$required); + if ($switchserver || $switchwarning) { + $button = 0; + } + } + } + } + } else { + my %newhash=&Apache::lonnet::coursedescription($tcourseid); + if (%newhash) { + $sortkey=$role."\0".$tdom."\0".$newhash{'description'}. + "\0".$envkey; + $twhere=&HTML::Entities::encode($newhash{'description'},'"<>&'). + ' '. + &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$trest,$tdom). + ''; + $ttype = $newhash{'type'}; + $trole = &Apache::lonnet::plaintext($role,$ttype,$tcourseid); + my $home = $newhash{'home'}; + unless ($home && grep(/^\Q$home\E$/,@ids) && $loncaparev eq '') { + my $required = $newhash{'internal.releaserequired'}; + if ($required ne '') { + ($switchserver,$switchwarning) = + &Apache::loncommon::check_release_required($loncaparev,$tcourseid,$trolecode,$required); + if ($switchserver || $switchwarning) { + $button = 0; + } + } + } + } else { + $twhere=&mt('Currently not available'); + $env{'course.'.$tcourseid.'.description'}=$twhere; + $sortkey=$role."\0".$tdom."\0".$twhere."\0".$envkey; + $ttype = 'Unavailable'; + $skipcal = 1; + } + } + if ($tsection) { + $twhere.='
'.&mt('Section').': '.$tsection; + } + if ($role ne 'st') { $twhere.="
".&mt('Domain').":".$tdom; } + } elsif ($tdom) { + $ttype='Domain'; + $twhere=$tdom; + $sortkey=$role.$twhere; + } else { + $ttype='System'; + $twhere=&mt('system wide'); + $sortkey=$role.$twhere; + } + ($role_text,$role_text_end) = + &build_roletext($trolecode,$tdom,$trest,$tstatus,$tryagain, + $advanced,$tremark,$tbg,$trole,$twhere,$tpstart, + $tpend,$nochoose,$button,$switchserver,$reinit, + $switchwarning,$skipcal); + $roletext->{$envkey}=[$role_text,$role_text_end]; + if (!$sortkey) {$sortkey=$twhere."\0".$envkey;} + $sortrole->{$sortkey}=$envkey; + $roleclass->{$envkey}=$ttype; } - my $trole; - if ($role =~ /^cr\//) { - my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); - $tremark.='
Defined by '.$rauthor.' at '.$rdomain.'.'; - $trole=$rrole; + } + } + return ($countactive,$countfuture,$inrole,$possiblerole); +} + +sub role_timezone { + my ($where,$timezones) = @_; + my $timezone; + if (ref($timezones) eq 'HASH') { + if ($where =~ m{^/($match_domain)/($match_courseid)}) { + my $cdom = $1; + my $cnum = $2; + if ($cdom && $cnum) { + if (!exists($timezones->{$cdom.'_'.$cnum})) { + my $tz; + if ($env{'course.'.$cdom.'_'.$cnum.'.description'}) { + $tz = $env{'course.'.$cdom.'_'.$cnum.'.timezone'}; + } else { + my %timehash = + &Apache::lonnet::get('environment',['timezone'],$cdom,$cnum); + $tz = $timehash{'timezone'}; + } + if ($tz eq '') { + if (!exists($timezones->{$cdom})) { + my %domdefaults = + &Apache::lonnet::get_domain_defaults($cdom); + if ($domdefaults{'timezone_def'} eq '') { + $timezones->{$cdom} = 'local'; + } else { + $timezones->{$cdom} = $domdefaults{'timezone_def'}; + } + } + $timezones->{$cdom.'_'.$cnum} = $timezones->{$cdom}; + } else { + $timezones->{$cdom.'_'.$cnum} = + &Apache::lonlocal::gettimezone($tz); + } + } + $timezone = $timezones->{$cdom.'_'.$cnum}; + } + } else { + my ($tdom) = ($where =~ m{^/($match_domain)}); + if ($tdom) { + if (!exists($timezones->{$tdom})) { + my %domdefaults = &Apache::lonnet::get_domain_defaults($tdom); + if ($domdefaults{'timezone_def'} eq '') { + $timezones->{$tdom} = 'local'; + } else { + $timezones->{$tdom} = $domdefaults{'timezone_def'}; + } + } + $timezone = $timezones->{$tdom}; + } + } + if ($timezone eq 'local') { + $timezone = undef; + } + } + return $timezone; +} + +sub roletable_headers { + my ($r,$roleclass,$sortrole,$nochoose) = @_; + my $doheaders; + if ((ref($sortrole) eq 'HASH') && (ref($roleclass) eq 'HASH')) { + $r->print('
' + .&Apache::loncommon::start_data_table('LC_textsize_mobile') + .&Apache::loncommon::start_data_table_header_row() + ); + if (!$nochoose) { $r->print(''); } + $r->print('' + .'' + .'' + .'' + .&Apache::loncommon::end_data_table_header_row() + ); + $doheaders=-1; + my @roletypes = &roletypes(); + foreach my $type (@roletypes) { + my $haverole=0; + foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { + if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { + $haverole=1; + } + } + if ($haverole) { $doheaders++; } + } + } + return $doheaders; +} + +sub roletypes { + my @types = ('Domain','Authoring Space','Course','Community','Unavailable','System'); + return @types; +} + +sub print_rolerows { + my ($r,$doheaders,$roleclass,$sortrole,$dcroles,$roletext,$update,$then) = @_; + if ((ref($roleclass) eq 'HASH') && (ref($sortrole) eq 'HASH')) { + my @types = &roletypes(); + foreach my $type (@types) { + my $output; + foreach my $which (sort {uc($a) cmp uc($b)} (keys(%{$sortrole}))) { + if ($roleclass->{$sortrole->{$which}} =~ /^\Q$type\E/) { + if (ref($roletext) eq 'HASH') { + if (ref($roletext->{$sortrole->{$which}}) eq 'ARRAY') { + $output.= &Apache::loncommon::start_data_table_row(). + $roletext->{$sortrole->{$which}}->[0]. + &Apache::loncommon::end_data_table_row(); + if ($roletext->{$sortrole->{$which}}->[1] ne '') { + $output .= &Apache::loncommon::continue_data_table_row(). + $roletext->{$sortrole->{$which}}->[1]. + &Apache::loncommon::end_data_table_row(); + } + } + if ($sortrole->{$which} =~ m{^user\.role\.dc\./($match_domain)/}) { + if (ref($dcroles) eq 'HASH') { + if ($dcroles->{$1}) { + $output .= &adhoc_roles_row($1,''); + } + } + } elsif ($sortrole->{$which} =~ m{^user\.role\.(dh|da)\./($match_domain)/}) { + $output .= &adhoc_customroles_row($1,$2,'',$update,$then); + } + } + } + } + if ($output) { + if ($doheaders > 0) { + $r->print(&Apache::loncommon::start_data_table_empty_row() + .'' + .&Apache::loncommon::end_data_table_empty_row() + ); + } + $r->print($output); + } + } + } +} + +sub findcourse_advice { + my ($r,$cattype,$elapsed) = @_; + my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + if (&Apache::lonnet::auto_run(undef,$env{'user.domain'})) { + $r->print('

'.&mt('If you were expecting to see an active role listed for a particular course in the [_1] domain, it may be missing for one of the following reasons:',$domdesc).' +

    +
  • '.&mt('The course has yet to be created.').'
    • +
  • '.&mt('Automatic enrollment of registered students has not been enabled for the course.').'
    • +
  • '.&mt('You are in a section of course for which automatic enrollment in the corresponding LON-CAPA course is not active.').'
    • +
  • '.&mt('The start date for automated enrollment has yet to be reached.').'
    • +
  • '.&mt('You registered for the course recently and there is a time lag between the time you register, and the time this information becomes available for the update of LON-CAPA course rosters.').'
    • +
  • '.&mt('Automated enrollment added you to the course in the time since you last logged-in.').' '.&mt('If that is the case you can use the "Check for changes" link in the gray Functions bar to update the list of your available course roles.').'
    • +

'); + } else { + $r->print('

'.&mt('If you were expecting to see an active role listed for a particular course, that course may not have been created yet.').'

'); + if ($elapsed > 600) { + $r->print('

'.&mt('You may also have been assigned to a course in the time since you last logged-in, or checked for changes.'). + '
'. + &mt('If that is the case you can use the "Check for changes" link in the gray Functions bar to update the list of your available course roles.').'

'); + } + } + if (($cattype eq 'std') || ($cattype eq 'domonly')) { + $r->print('

'.&mt('Self-Enrollment').'

'. + '

'.&mt('The [_1]Course/Community Catalog[_2] provides information about all [_3] classes for which LON-CAPA courses have been created, as well as any communities in the domain.','','',$domdesc).'
'); + $r->print(&mt('You can search for courses and communities which permit self-enrollment, if you would like to enroll in one.').'

'. + &Apache::loncoursequeueadmin::queued_selfenrollment()); + } + return; +} + +sub requestcourse_advice { + my ($r,$cattype,$inrole,$elapsed) = @_; + my $domdesc = &Apache::lonnet::domain($env{'user.domain'},'description'); + my $esc_dom = &HTML::Entities::encode($env{'user.domain'},'"<>&'); + my (%can_request,%request_doms,$output); + &Apache::lonnet::check_can_request($env{'user.domain'},\%can_request,\%request_doms); + if (keys(%request_doms) > 0) { + my ($types,$typename) = &Apache::loncommon::course_types(); + if ((ref($types) eq 'ARRAY') && (ref($typename) eq 'HASH')) { + my (@reqdoms,@reqtypes); + foreach my $type (sort(keys(%request_doms))) { + push(@reqtypes,$type); + if (ref($request_doms{$type}) eq 'ARRAY') { + my $domstr = join(', ',map { &Apache::lonnet::domain($_) } sort(@{$request_doms{$type}})); + $output .= + '
  • ' + .&mt('[_1]'.$typename->{$type}.'[_2] in domain: [_3]', + '', + '', + ''.$domstr.'') + .'
    • '; + foreach my $dom (@{$request_doms{$type}}) { + unless (grep(/^\Q$dom\E/,@reqdoms)) { + push(@reqdoms,$dom); + } + } + } + } + my @showtypes; + foreach my $type (@{$types}) { + if (grep(/^\Q$type\E$/,@reqtypes)) { + push(@showtypes,$type); + } + } + my $requrl = '/adm/requestcourse'; + if (@reqdoms == 1) { + $requrl .= '?showdom='.$reqdoms[0]; + } + if (@showtypes > 0) { + $requrl.=(($requrl=~/\?/)?'&':'?').'crstype='.$showtypes[0]; + } + if (@reqdoms == 1 || @showtypes > 0) { + $requrl .= '&state=crstype&action=new'; + } + if ($output) { + $r->print('

    '.&mt('Request creation of a course or community').'

    '. + '

    '. + &mt('You have rights to request the creation of courses and/or communities in the following domain(s):'). + '

      '. + $output. + '
    '. + &mt('Use the [_1]request form[_2] to submit a request for creation of a new course or community.', + '',''). + '

    '); + } + } + } elsif (!$env{'user.adv'}) { + if ($inrole) { + $r->print('

    '.&mt('Currently no additional roles, courses or communities').'

    '); + } else { + $r->print('

    '.&mt('Currently no active roles, courses or communities').'

    '); + } + &findcourse_advice($r,$cattype,$elapsed); + } + return; +} + +sub privileges_info { + my ($which) = @_; + my $output; + + $which ||= $env{'request.role'}; + + foreach my $envkey (sort(keys(%env))) { + next if ($envkey!~/^user\.priv\.\Q$which\E\.(.*)/); + + my $where=$1; + my $ttype; + my $twhere; + my (undef,$tdom,$trest,$tsec)=split(m{/},$where); + if ($trest) { + if ($env{'course.'.$tdom.'_'.$trest.'.description'} eq 'ca') { + $ttype='Authoring Space'; + $twhere='User: '.$trest.', Domain: '.$tdom; } else { - $trole=Apache::lonnet::plaintext($role); + $ttype= &Apache::loncommon::course_type($tdom.'_'.$trest); + $twhere=$env{'course.'.$tdom.'_'.$trest.'.description'}; + if ($tsec) { + my $sec_type = 'Section'; + if (exists($env{"user.role.gr.$where"})) { + $sec_type = 'Group'; + } + $twhere.=' ('.$sec_type.': '.$tsec.')'; + } + } + } elsif ($tdom) { + $ttype='Domain'; + $twhere=$tdom; + } else { + $ttype='System'; + $twhere='/'; + } + $output .= "\n

    ".&mt($ttype).': '.$twhere.'

    '."\n
      "; + foreach my $priv (sort(split(/:/,$env{$envkey}))) { + next if (!$priv); + + my ($prv,$restr)=split(/\&/,$priv); + my $trestr=''; + if ($restr ne 'F') { + $trestr.=' ('. + join(', ', + map { &Apache::lonnet::plaintext($_) } + (split('',$restr))).') '; + } + $output .= "\n\t". + '
    • '.&Apache::lonnet::plaintext($prv).$trestr.'
      • '; + } + $output .= "\n".'
    '; + } + return $output; +} + +sub build_roletext { + my ($trolecode,$tdom,$trest,$tstatus,$tryagain,$advanced,$tremark,$tbg,$trole,$twhere, + $tpstart,$tpend,$nochoose,$button,$switchserver,$reinit,$switchwarning,$skipcal) = @_; + my ($roletext,$roletext_end,$poss_adhoc); + if ($trolecode =~ m/^d(c|h|a)\./) { + $poss_adhoc = 1; + } + my $rowspan=($poss_adhoc) ? '' + : ' rowspan="2" '; + + unless ($nochoose) { + my $buttonname=$trolecode; + $buttonname=~s/\W//g; + if (!$button) { + if ($switchserver) { + $roletext.='' + .'' + .&mt('Switch Server') + .''; + } else { + $roletext.=(' '); } - my $ttype; - my $twhere; - my ($tdom,$trest)= - split(/\//,Apache::lonnet::declutter($where)); - if ($trest) { - $ttype='Course'; - my $tcourseid=$tdom.'/'.$trest; - if ($cdes{$tcourseid}) { - $twhere=$cdes{$tcourseid}; + if ($switchwarning) { + if ($tremark eq '') { + $tremark = $switchwarning; } else { - my %newhash=Apache::lonnet::coursedescription($tcourseid); - if (%newhash) { - $twhere=$newhash{'description'}; + $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)\./) && (!$skipcal)) { + $tremark.=&Apache::lonannounce::showday(time,1, + &Apache::lonannounce::readcalendar($tdom.'_'.$trest)); + } + $roletext.='    ' + .'' + .'' + .''; + unless ($poss_adhoc) { + $roletext_end = ''; + } + return ($roletext,$roletext_end); +} + +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_for_adhoc { + my ($dcroles,$helpdeskroles,$update,$then) = @_; + my $numdc = 0; + my $numhelpdesk = 0; + my $numadhoc = 0; + my $num_custom_adhoc = 0; + if (($env{'user.adv'}) || ($env{'user.rar'})) { + foreach my $envkey (sort(keys(%env))) { + if ($envkey=~/^user\.role\.(dc|dh|da)\.\/($match_domain)\/$/) { + my $role = $1; + my $roledom = $2; + my $liverole = 1; + my ($tstart,$tend)=split(/\./,$env{$envkey}); + my $limit = $update; + if ($env{'request.role'} eq "$role./$roledom/") { + $limit = $then; + } + if ($tstart && $tstart>$limit) { $liverole = 0; } + if ($tend && $tend <$limit) { $liverole = 0; } + if ($liverole) { + if ($role eq 'dc') { + $dcroles->{$roledom} = $envkey; + $numdc++; } else { - $twhere='Currently not available'; + $helpdeskroles->{$roledom} = $envkey; + my %domdefaults = &Apache::lonnet::get_domain_defaults($roledom); + if (ref($domdefaults{'adhocroles'}) eq 'HASH') { + if (keys(%{$domdefaults{'adhocroles'}})) { + $numadhoc ++; + } + } + $numhelpdesk++; } - $cdes{$tcourseid}=$twhere; - } - } elsif ($tdom) { - $ttype='Domain'; - $twhere=$tdom; - } else { - $ttype='System'; - $twhere='system wide'; - } - - $r->print(''); - unless ($nochoose) { - if ($tstatus eq 'is') { - $r->print(''); + } + } + } + } + return ($numdc,$numhelpdesk,$numadhoc); +} + +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; + } + } + unless ($setprivs) { + if (!exists($env{'user.priv.'.$env{'form.switchrole'}.'./'})) { + $setprivs = 1; + } + } + if ($setprivs) { + if ($env{'form.switchrole'} =~ m-^(in|ta|ep|ad|st|cr)(.*?)\./\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); + my $ccrole; + if ($crstype eq 'Community') { + $ccrole = 'co'; } else { - $r->print(''); + $ccrole = 'cc'; } + foreach my $group (keys(%cgroups)) { + $group_privs{$group} = + $env{'user.priv.'.$ccrole.'./'.$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; + } + if ($role =~ /^cr/) { + &Apache::lonnet::custom_roleprivs(\%newrole,$role,$cdom,$cnum,$spec,$area); + } else { + &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']); } - $r->print(''."\n"); } } + return; +} - $r->print('
     ' + .$recent + .' ' + .&mt('No role specified') + .''.$tremark.' User RoleExtentStartEndRemark
    Course
     '.&mt('User Role').''.&mt('Extent').''.&mt('Start').''.&mt('End').'' + .&mt($type) + .''.$trole.''.$twhere.''.$tpstart.''.$tpend.''. + $tremark.' '. + '
     '.$trole.''. - $ttype.''.$twhere.''.$tpstart. - ''.$tpend. - ''.$tremark.' 
    '); - unless ($nochoose) { - $r->print("\n"); +sub check_forcc { + my ($cdom,$cnum,$refresh,$update,$then,$crstype) = @_; + my ($is_cc,$ccrole); + if ($crstype eq 'Community') { + $ccrole = 'co'; + } else { + $ccrole = 'cc'; } -# ------------------------------------------------------------ Priviledges Info - if ($advanced) { - $r->print('

    Priviledges

    '); - - foreach $envkey (sort keys %ENV) { - if ($envkey=~/^user\.priv\./) { - my ($dum1,$dum2,@pwhere)=split(/\./,$envkey); - my $where=join('.',@pwhere); - my $ttype; + 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 courselink { + my ($roledom,$rowtype,$role) = @_; + my $courseform=&Apache::loncommon::selectcourse_link + ('rolechoice','course'.$rowtype.'_'.$roledom.'_'.$role, + 'domain'.$rowtype.'_'.$roledom.'_'.$role, + 'coursedesc'.$rowtype.'_'.$roledom.'_'.$role, + $roledom.':'.$role,undef,'Course/Community'); + my $hiddenitems = ''. + ''. + ''. + ''; + return $courseform.$hiddenitems; +} + +sub coursepick_jscript { + my %js_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.', + ); + &js_escape(\%js_lt); + 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 ($tdom,$trest)= - split(/\//,Apache::lonnet::declutter($where)); - if ($trest) { - $ttype='Course'; - $twhere=$cdes{$tdom.'/'.$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; - $trestr.=' ('; - for ($i=0;$iprint('
    • '.Apache::lonnet::plaintext($prv).$trestr. - '
      • '); - } - } sort split(/:/,$ENV{$envkey}); - $r->print('
    '); + my $ttype; + my $skipcal; + 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; + $skipcal = 1; + } + 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,'','','',$skipcal); } } - } -# -------------------------------------------------------------- Debug - remove + return ($roletext,$roletext_end); +} - $->print("

    Debugging

    \n"); - - foreach $envkey (sort keys %ENV) { - $r->print("$envkey ---- $ENV{$envkey}
    "); +sub display_curr_role { + my ($currentrole) = @_; + my ($roletext,$roletext_end); + my $advanced = $env{'user.adv'}; + my $tryagain = $env{'form.tryagain'}; + my ($role,$rest) = split(m{\./},$currentrole,2); + unless (!defined($role) || $role eq '') { + if ($rest =~ m{^($match_domain)/($match_courseid)(?:/(\w+)|$)}) { + my $cdom = $1; + my $cnum = $2; + my $csec = $3; + my $cid = $cdom.'_'.$cnum; + my $ttype = $env{'course.'.$cid.'.type'}; + my $skipcal = 1; + my $tbg='LC_roles_is'; + my $twhere = $env{'course.'.$cid.'.description'}. + ' '. + &Apache::loncommon::syllabuswrapper(&mt('Syllabus'),$cnum,$cdom). + ''; + my $trole = &Apache::lonnet::plaintext($role,$ttype,$cid); + if ($csec) { + $twhere.= '  '.&mt('Section').': '.$csec; + } + if ($role ne 'st') { + $twhere.= '  '.&mt('Domain').': '.$cdom; + } + ($roletext,$roletext_end) = &build_roletext($currentrole,$cdom,$cnum,'is',$tryagain,$advanced,'',$tbg,$trole,$twhere,'','','',1,'','','',$skipcal); + } } + return ($roletext,$roletext_end); +} -# ------------------------------------------------------------------- End Debug +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 $role = 'cc'; + my $selectcclink = &courselink($dcdom,$rowtype,$role); + 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; +} - $r->print("\n"); - return OK; -} +sub adhoc_customroles_row { + my ($role,$dhdom,$rowtype,$update,$then) = @_; + my $liverole = 1; + my ($tstart,$tend)=split(/\./,$env{"user.role.$role./$dhdom/"}); + my $limit = $update; + if (($role eq 'dh') && ($env{'request.role'} eq 'dh./'.$dhdom.'/')) { + $limit = $then; + } + if ($tstart && $tstart>$limit) { $liverole = 0; } + if ($tend && $tend <$limit) { $liverole = 0; } + return unless ($liverole); + my %domdefaults = &Apache::lonnet::get_domain_defaults($dhdom); + if (ref($domdefaults{'adhocroles'}) eq 'HASH') { + if (scalar(keys(%{$domdefaults{'adhocroles'}})) > 0) { + return &Apache::loncommon::continue_data_table_row() + .' ' + .&mt('[_1]Ad hoc[_2] course/community roles in domain [_3]', + '','',$dhdom) + .' -- '.&courselink($dhdom,$rowtype,$role); + } + } + return; +} + +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; +} + +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,$now,$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,$now,$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 %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++; + } + } + } + } + my $status_in_env = + &curr_role_status($currstart,$currend,$refresh,$update); + if ($status_in_env eq 'active') { + $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); + } + $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(m{\./},$rolekey,2); + $rest = '/'.$rest; + 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 = '

    '.&mt('The section has changed for your current role. Log-out and log-in again to select a role for the new section.').'

    '; + } else { + my $newrole = $env{'request.role'}; + if ($newsec[0] eq 'none') { + $newrole =~ s{(/[^/])$}{}; + } elsif ($oldsec eq 'none') { + $newrole .= '/'.$newsec[0]; + } else { + $newrole =~ s{([^/]+)$}{$newsec[0]}; + } + my $coursedesc = $env{'course.'.$env{'request.course.id'}.'.description'}; + my ($curr_role) = ($env{'request.role'} =~ m{^(\w+)\./$match_domain/$match_courseid}); + 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'}}); + my $rolename = &Apache::loncommon::plainname($curr_role); + $msg = '

    '. + ''. + ''. + ''. + &mt('Your section has changed for your current [_1] role in [_2].',$rolename,$coursedesc).'
    '; + 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 .= '

    '; + } + } elsif ($currrole_expired) { + $msg .= '

    '; + if (&Apache::loncommon::show_course()) { + $msg .= &mt('Your role in the current course has expired.'); + } else { + $msg .= &mt('Your current role has expired.'); + } + $msg .= '
    '.&mt('However you can continue to use this role until you logout, click the "Re-Select" button, or your session has been idle for more than 24 hours.').'

    '; + } + &Apache::lonnet::set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles); + my ($curr_is_adv,$curr_role_adv,$curr_author,$curr_role_author); + $curr_author = $env{'user.author'}; + if (($env{'request.role'} =~/^au/) || ($env{'request.role'} =~/^ca/) || + ($env{'request.role'} =~/^aa/)) { + $curr_role_author=1; + } + $curr_is_adv = $env{'user.adv'}; + $curr_role_adv = $env{'request.role.adv'}; + if (keys(%userroles) > 0) { + foreach my $role (@changed_roles) { + unless(grep(/^\Q$role\E$/,@rolecodes)) { + push(@rolecodes,$role); + } + } + unless(grep(/^\Qcm\E$/,@rolecodes)) { + push(@rolecodes,'cm'); + } + &Apache::lonnet::appenv(\%userroles,\@rolecodes); + } + my %newenv; + if (&Apache::lonnet::is_advanced_user($env{'user.domain'},$env{'user.name'})) { + unless ($curr_is_adv) { + $newenv{'user.adv'} = 1; + } + } elsif ($curr_is_adv && !$curr_role_adv) { + &Apache::lonnet::delenv('user.adv'); + } + my %authorroleshash = + &Apache::lonnet::get_my_roles('','','userroles',['active'],['au','ca','aa']); + if (keys(%authorroleshash)) { + unless ($curr_author) { + $newenv{'user.author'} = 1; + } + } elsif ($curr_author && !$curr_role_author) { + &Apache::lonnet::delenv('user.author'); + } + if ($env{'request.course.id'}) { + my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; + my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; + my (@activecrsgroups,$crsgroupschanged); + if ($env{'request.course.groups'}) { + @activecrsgroups = split(/:/,$env{'request.course.groups'}); + foreach my $item (keys(%deletedroles)) { + if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) { + if (grep(/^\Q$1\E$/,@activecrsgroups)) { + $crsgroupschanged = 1; + last; + } + } + } + } + unless ($crsgroupschanged) { + foreach my $item (keys(%newgroup)) { + if ($item =~ m{^gr\./\Q$cdom\E/\Q$cnum\E/(\w+)$}) { + if ($newgroup{$item} eq 'active') { + $crsgroupschanged = 1; + last; + } + } + } + } + if ((ref($changed_groups{$env{'request.course.id'}}) eq 'HASH') || + (ref($groupchange{"/$cdom/$cnum"}) eq 'HASH') || + ($crsgroupschanged)) { + my %grouproles = &Apache::lonnet::get_my_roles('','','userroles', + ['active'],['gr'],[$cdom],1); + my @activegroups; + foreach my $item (keys(%grouproles)) { + next unless($item =~ /^\Q$cnum\E:\Q$cdom\E/); + my $group; + my ($crsn,$crsd,$role,$remainder) = split(/:/,$item,4); + if ($remainder =~ /:/) { + (my $other,$group) = ($remainder =~ /^([\w:]+):([^:]+)$/); + } else { + $group = $remainder; + } + if ($group ne '') { + push(@activegroups,$group); + } + } + $newenv{'request.course.groups'} = join(':',@activegroups); + } + } + if (keys(%newenv)) { + &Apache::lonnet::appenv(\%newenv); + } + if (!@changed_roles || !(keys(%changed_groups))) { + my ($rolesmsg,$groupsmsg); + if (!@changed_roles) { + if (&Apache::loncommon::show_course()) { + $rolesmsg = &mt('No new courses or communities'); + } else { + $rolesmsg = &mt('No role changes'); + } + } + if ($hasgroups && !(keys(%changed_groups)) && !(grep(/gr/,@changed_roles))) { + $groupsmsg = &mt('No changes in course/community groups'); + } + if (!@changed_roles && !(keys(%changed_groups))) { + if (($msg ne '') || ($groupsmsg ne '')) { + $msg .= '
      '; + if ($rolesmsg) { + $msg .= '
    • '.$rolesmsg.'
      • '; + } + if ($groupsmsg) { + $msg .= '
    • '.$groupsmsg.'
      • '; + } + $msg .= '
    '; + } else { + $msg = ' '.$rolesmsg.'
    '; + } + return $msg; + } + } + my $changemsg; + if (@changed_roles > 0) { + if (keys(%newgroup) > 0) { + my $groupmsg; + my (%curr_groups,%groupdescs,$currcrs); + foreach my $item (sort(keys(%newgroup))) { + if (&is_active_course($item,$refresh,$update,\%roleshash)) { + if ($item =~ m{^gr\./($match_domain/$match_courseid)/(\w+)$}) { + my ($cdom,$cnum) = split(/\//,$1); + my $group = $2; + if ($currcrs ne $cdom.'_'.$cnum) { + if ($currcrs) { + $groupmsg .= '
  • '; + } + $groupmsg .= '
  • '. + $env{'course.'.$cdom.'_'.$cnum.'.description'}.'
      '; + $currcrs = $cdom.'_'.$cnum; + } + my $groupdesc; + unless (ref($curr_groups{$cdom.'_'.$cnum}) eq 'HASH') { + %{$curr_groups{$cdom.'_'.$cnum}} = + &Apache::longroup::coursegroups($cdom,$cnum); + } + unless ((ref($groupdescs{$cdom.'_'.$cnum}) eq 'HASH') && + ($groupdescs{$cdom.'_'.$cnum}{$group})) { + + my %groupinfo = + &Apache::longroup::get_group_settings($curr_groups{$cdom.'_'.$cnum}{$group}); + $groupdescs{$cdom.'_'.$cnum}{$group} = + &unescape($groupinfo{'description'}); + } + $groupdesc = $groupdescs{$cdom.'_'.$cnum}{$group}; + if ($groupdesc) { + $groupmsg .= '
    • '. + &mt('[_1] with status: [_2].', + ''.$groupdesc.'',$newgroup{$item}).'
      • '; + } + } + } + if ($groupmsg) { + $groupmsg .= '
    • '; + } + } + if ($groupmsg) { + $changemsg .= '
  • '. + &mt('Courses with new groups').'
    • '. + '
      '.$groupmsg.'
    '; + } + } + if (keys(%newrole) > 0) { + my $newmsg; + foreach my $item (sort(keys(%newrole))) { + my $desc = &role_desc($item,$update,$refresh,$now); + if ($desc) { + $newmsg .= '
  • '. + &mt('[_1] with status: [_2].', + $desc,&mt($newrole{$item})).'
    • '; + } + } + if ($newmsg) { + $changemsg .= '
  • '.&mt('New roles'). + '
      '.$newmsg.'
    '. + '
    • '; + } + } + if (keys(%customprivchg) > 0) { + my $privmsg; + foreach my $item (sort(keys(%customprivchg))) { + my $desc = &role_desc($item,$update,$refresh,$now); + if ($desc) { + $privmsg .= '
  • '.$desc.'
    • '; + } + } + if ($privmsg) { + $changemsg .= '
  • '. + &mt('Custom roles with privilege changes'). + '
      '.$privmsg.'
    '. + '
    • '; + } + } + if (keys(%rolechange) > 0) { + my $rolemsg; + foreach my $item (sort(keys(%rolechange))) { + my $desc = &role_desc($item,$update,$refresh,$now); + if ($desc) { + $rolemsg .= '
  • '. + &mt('[_1] status now: [_2].',$desc, + $rolechange{$item}).'
    • '; + } + } + if ($rolemsg) { + $changemsg .= '
  • '. + &mt('Existing roles with status changes').'
    • '. + '
      '.$rolemsg.'
    '. + ''; + } + } + if (keys(%deletedroles) > 0) { + my $delmsg; + foreach my $item (sort(keys(%deletedroles))) { + my $desc = &role_desc($item,$update,$refresh,$now); + if ($desc) { + $delmsg .= '
  • '.$desc.'
    • '; + } + } + if ($delmsg) { + $changemsg .= '
  • '. + &mt('Existing roles now expired').'
    • '. + '
      '.$delmsg.'
    '. + ''; + } + } + } + if ((keys(%changed_groups) > 0) || (keys(%groupchange) > 0)) { + my $groupchgmsg; + foreach my $key (sort(keys(%changed_groups))) { + my $crs = 'gr/'.$key; + $crs =~ s/_/\//; + if (&is_active_course($crs,$refresh,$update,\%roleshash)) { + if (ref($changed_groups{$key}) eq 'HASH') { + my @showgroups; + foreach my $group (sort(keys(%{$changed_groups{$key}}))) { + if ($changed_groups{$key}{$group} eq 'active') { + push(@showgroups,$group); + } + } + if (@showgroups > 0) { + $groupchgmsg .= '
  • '. + &mt('Course: [_1], groups: [_2].',$key, + join(', ',@showgroups)). + '
    • '; + } + } + } + } + if (keys(%groupchange) > 0) { + $groupchgmsg .= '
  • '. + &mt('Existing course/community groups with status changes').'
    • '. + '
      '; + foreach my $crs (sort(keys(%groupchange))) { + my $cid = $crs; + $cid=~s{^/}{}; + $cid=~s{/}{_}; + my $crsdesc = $env{'course.'.$cid.'.description'}; + my $cdom = $env{'course.'.$cid.'.domain'}; + my $cnum = $env{'course.'.$cid.'.num'}; + my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum); + my %groupdesc; + if (ref($groupchange{$crs}) eq 'HASH') { + $groupchgmsg .= '
    • '.&mt('Course/Community: [_1]',''.$crsdesc.'
        '); + foreach my $group (sort(keys(%{$groupchange{$crs}}))) { + unless ($groupdesc{$group}) { + my %groupinfo = &Apache::longroup::get_group_settings($curr_groups{$group}); + $groupdesc{$group} = &unescape($groupinfo{'description'}); + } + $groupchgmsg .= '
      • '.&mt('Group: [_1] status now: [_2].',''.$groupdesc{$group}.'',$groupchange{$crs}{$group}).'
        • '; + } + $groupchgmsg .= '
      • '; + } + } + $groupchgmsg .= '
    '; + } + if ($groupchgmsg) { + $changemsg .= '
  • '. + &mt('Courses with changes in groups').'
    • '. + '
      '.$groupchgmsg.'
    '; + } + } + if ($changemsg) { + $msg .= '
      '.$changemsg.'
    '; + } else { + if (&Apache::loncommon::show_course()) { + $msg = &mt('No new courses or communities'); + } else { + $msg = &mt('No role changes'); + } + } + return $msg; +} + +sub role_desc { + my ($item,$update,$refresh,$now) = @_; + my ($where,$trolecode,$role,$tstatus,$tend,$tstart,$twhere, + $trole,$tremark); + &Apache::lonnet::role_status('user.role.'.$item,$update,$refresh, + $now,\$role,\$where,\$trolecode, + \$tstatus,\$tstart,\$tend); + return unless ($role); + if ($role =~ /^cr\//) { + my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$role); + $tremark = &mt('Custom role defined by [_1].',$rauthor.':'.$rdomain); + } + $trole=Apache::lonnet::plaintext($role); + my ($tdom,$trest,$tsection)= + split(/\//,Apache::lonnet::declutter($where)); + if (($role eq 'ca') || ($role eq 'aa')) { + my $home = &Apache::lonnet::homeserver($trest,$tdom); + $home = &Apache::lonnet::hostname($home); + $twhere=&mt('User').': '.$trest.'  '.&mt('Domain'). + ': '.$tdom.'  '.&mt('Server').': '.$home; + } elsif ($role eq 'au') { + my $home = &Apache::lonnet::homeserver + ($env{'user.name'},$env{'user.domain'}); + $home = &Apache::lonnet::hostname($home); + $twhere=&mt('Domain').': '.$tdom.'  '.&mt('Server'). + ': '.$home; + } elsif ($trest) { + my $tcourseid=$tdom.'_'.$trest; + my $crstype = &Apache::loncommon::course_type($tcourseid); + $trole = &Apache::lonnet::plaintext($role,$crstype,$tcourseid); + if ($env{'course.'.$tcourseid.'.description'}) { + $twhere=$env{'course.'.$tcourseid.'.description'}; + } else { + my %newhash=&Apache::lonnet::coursedescription($tcourseid); + if (%newhash) { + $twhere=$newhash{'description'}; + } else { + $twhere=&mt('Currently not available'); + } + } + if ($tsection) { + $twhere.= '  '.&mt('Section').': '.$tsection; + } + if ($role ne 'st') { + $twhere.= '  '.&mt('Domain').': '.$tdom; + } + } elsif ($tdom) { + $twhere = &mt('Domain').': '.$tdom; + } + my $output; + if ($trole) { + $output = $trole; + if ($twhere) { + $output .= " -- $twhere"; + } + if ($tremark) { + $output .= '
    '.$tremark; + } + } + return $output; +} + +sub curr_role_status { + my ($start,$end,$refresh,$update) = @_; + if (($start) && ($start<0)) { return 'deleted' }; + my $status = 'active'; + if (($end) && ($end<=$update)) { + $status = 'previous'; + } + if (($start) && ($refresh<$start)) { + $status = 'future'; + } + return $status; +} + +sub gather_roleprivs { + my ($allroles,$allgroups,$userroles,$area,$role,$tstart,$tend,$status) = @_; + return unless ((ref($allroles) eq 'HASH') && (ref($allgroups) eq 'HASH') && (ref($userroles) eq 'HASH')); + if (($area ne '') && ($role ne '')) { + &Apache::lonnet::userrolelog($role,$env{'user.name'},$env{'user.domain'}, + $area,$tstart,$tend); + my $spec=$role.'.'.$area; + $userroles->{'user.role.'.$spec} = $tstart.'.'.$tend; + my ($tdummy,$tdomain,$trest)=split(/\//,$area); + if ($status eq 'active') { + if ($role =~ /^cr\//) { + &Apache::lonnet::custom_roleprivs($allroles,$role,$tdomain,$trest,$spec,$area); + } elsif ($role eq 'gr') { + my %rolehash = &Apache::lonnet::get('roles',[$area.'_'.$role], + $env{'user.domain'}, + $env{'user.name'}); + my ($trole) = split(/_/,$rolehash{$area.'_'.$role},2); + (undef,my $group_privs) = split(/\//,$trole); + $group_privs = &unescape($group_privs); + &Apache::lonnet::group_roleprivs($allgroups,$area,$group_privs,$tend,$tstart); + } else { + &Apache::lonnet::standard_roleprivs($allroles,$role,$tdomain,$spec,$trest,$area); + } + } + } + return; +} + +sub is_active_course { + my ($rolekey,$refresh,$update,$roleshashref) = @_; + return unless(ref($roleshashref) eq 'HASH'); + my ($role,$cdom,$cnum) = split(/\//,$rolekey); + my $is_active; + foreach my $key (keys(%{$roleshashref})) { + if ($key =~ /^\Q$cnum\E:\Q$cdom\E:/) { + my ($tstart,$tend) = split(/:/,$roleshashref->{$key}); + my $status = &curr_role_status($tstart,$tend,$refresh,$update); + if ($status eq 'active') { + $is_active = 1; + last; + } + } + } + return $is_active; +} + +sub get_roles_functions { + my ($rolescount,$cattype) = @_; + my @links; + push(@links,["javascript:rolesView('doupdate');",'start-here-22x22',&mt('Check for changes')]); + if ($env{'environment.canrequest.author'}) { + unless (&Apache::loncoursequeueadmin::is_active_author()) { + push(@links,["javascript:rolesView('requestauthor');",'list-add-22x22',&mt('Request author role')]); + } + } + if (($rolescount > 3) || ($env{'environment.recentroles'})) { + push(@links,['/adm/preferences?action=changerolespref&returnurl=/adm/roles','role_hotlist-22x22',&mt('Hotlist')]); + } + if (&Apache::lonmenu::check_for_rcrs()) { + push(@links,['/adm/requestcourse','rcrs-22x22',&mt('Request course')]); + } + if ($env{'form.state'} eq 'queued') { + push(@links,["javascript:rolesView('noqueued');",'selfenrl-queue-22x22',&mt('Hide queued')]); + } else { + push(@links,["javascript:rolesView('queued');",'selfenrl-queue-22x22',&mt('Show queued')]); + } + if ($env{'user.adv'}) { + if ($env{'form.display'} eq 'showall') { + push(@links,["javascript:rolesView('noshowall');",'edit-redo-22x22',&mt('Exclude expired')]); + } else { + push(@links,["javascript:rolesView('showall');",'edit-undo-22x22',&mt('Include expired')]); + } + } + unless ($cattype eq 'none') { + push(@links,['/adm/coursecatalog','ccat-22x22',&mt('Course catalog')]); + } + my $funcs; + if ($env{'browser.mobile'}) { + my @functions; + foreach my $link (@links) { + push(@functions,[$link->[0],$link->[2]]); + } + my $title = 'Display options'; + if ($env{'user.adv'}) { + $title = 'Roles options'; + } + $funcs = &Apache::lonmenu::create_submenu('','',$title,\@functions,1,'LC_breadcrumbs_hoverable'); + $funcs = '
      '.$funcs.'
    '; + } else { + $funcs = &Apache::lonhtmlcommon::start_funclist(); + foreach my $link (@links) { + $funcs .= &Apache::lonhtmlcommon::add_item_funclist( + ''. + ''.$link->[2].''. + $link->[2].''); + } + $funcs .= &Apache::lonhtmlcommon::end_funclist(); + $funcs = &Apache::loncommon::head_subbox($funcs); + } + return $funcs; +} + +sub get_queued { + my ($output,%reqcrs); + my ($types,$typenames) = &Apache::loncommon::course_types(); + my %statusinfo = &Apache::lonnet::dump('courserequests',$env{'user.domain'}, + $env{'user.name'},'^status:'); + foreach my $key (keys(%statusinfo)) { + next unless (($statusinfo{$key} eq 'approval') || ($statusinfo{$key} eq 'pending')); + (undef,my($cdom,$cnum)) = split(/:/,$key); + my $requestkey = $cdom.'_'.$cnum; + if ($requestkey =~ /^($match_domain)_($match_courseid)$/) { + my %history = &Apache::lonnet::restore($requestkey,'courserequests', + $env{'user.domain'},$env{'user.name'}); + next if ((exists($history{'status'})) && ($history{'status'} eq 'created')); + my $reqtime = $history{'reqtime'}; + my $lastupdate = $history{'timestamp'}; + my $showtype = $history{'crstype'}; + if (defined($typenames->{$history{'crstype'}})) { + $showtype = $typenames->{$history{'crstype'}}; + } + my $description; + if (ref($history{'details'}) eq 'HASH') { + $description = $history{details}{'cdescr'}; + } + @{$reqcrs{$reqtime}} = ($description,$showtype); + } + } + my @sortedtimes = sort {$a <=> $b} (keys(%reqcrs)); + if (@sortedtimes > 0) { + $output .= '

    '.&mt('Course/Community requests').'
    '. + &Apache::loncommon::start_data_table(). + &Apache::loncommon::start_data_table_header_row(). + ''.&mt('Date requested').''. + ''.&mt('Course title').''. + ''.&mt('Course type').''; + &Apache::loncommon::end_data_table_header_row(); + foreach my $reqtime (@sortedtimes) { + next unless (ref($reqcrs{$reqtime}) eq 'ARRAY'); + $output .= &Apache::loncommon::start_data_table_row(). + ''.&Apache::lonlocal::locallocaltime($reqtime).''. + ''.join('',@{$reqcrs{$reqtime}}).''. + &Apache::loncommon::end_data_table_row(); + } + $output .= &Apache::loncommon::end_data_table(). + '

    '; + } + my $queuedselfenroll = &Apache::loncoursequeueadmin::queued_selfenrollment(1); + if ($queuedselfenroll) { + $output .= '

    '.&mt('Enrollment requests').'
    '. + $queuedselfenroll.'

    '; + } + if ($env{'environment.canrequest.author'}) { + unless (&Apache::loncoursequeueadmin::is_active_author()) { + my $requestauthor; + my ($status,$timestamp) = split(/:/,$env{'environment.requestauthorqueued'}); + if (($status eq 'approval') || ($status eq 'approved')) { + $output .= '

    '.&mt('Author role request').'
    '; + if ($status eq 'approval') { + $output .= &mt('A request for Authoring Space submitted on [_1] is awaiting approval', + &Apache::lonlocal::locallocaltime($timestamp)); + } elsif ($status eq 'approved') { + my %roleshash = + &Apache::lonnet::get_my_roles($env{'user.name'},$env{'user.domain'},'userroles', + ['active'],['au'],[$env{'user.domain'}]); + if (keys(%roleshash)) { + $output .= ''. + &mt('Your request for an author role has been approved.').'
    '. + &mt('Use the "Check for changes" link to update your list of roles.'). + '    '; + } + } + $output .= '

    '; + } + } + } + unless ($output) { + if ($env{'environment.canrequest.author'} || $env{'environment.canrequest.official'} || + $env{'environment.canrequest.unofficial'} || $env{'environment.canrequest.community'}) { + $output = &mt('No requests for courses, communities or authoring currently queued'); + } else { + $output = &mt('No enrollment requests currently queued awaiting approval'); + } + } + return '
    '.&mt('Queued requests').''. + $output.'

    '; +} + +sub set_deeplink_target { + my ($cnum,$cdom) = @_; + if (($cnum ne '') && ($cdom ne '')) { + my $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom); + if ($deeplink_symb ne '') { + my $deeplink; + if ($deeplink_symb =~ /\.(page|sequence)$/) { + my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]); + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink'); + } + } elsif ($deeplink_symb ne '') { + $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb); + } + if ($deeplink ne '') { + my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink); + if ($target ne '') { + &Apache::lonnet::appenv({'request.deeplink.target' => $target}); + } elsif (exists($env{'request.deeplink.target'})) { + &Apache::lonnet::delenv('request.deeplink.target'); + } + } + } + } + return; +} + +sub set_supplemental_access { + my ($cnum,$cdom) = @_; + my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom); + unless ($refs_updated) { + &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental); + } +} 1; __END__ + +=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