# The LearningOnline Network with CAPA
# Extract domain, courseID, and symb from a shortened URL,
# and switch role to a role in designated course.
#
# $Id: lontiny.pm,v 1.17 2022/10/19 18:09:04 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/
#

package Apache::lontiny;

use strict;
use Apache::Constants qw(:common :http);
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonhtmlcommon;
use Apache::lonroles;
use Apache::lonuserstate;
use Apache::lonnavmaps;
use Apache::lonlocal;
use LONCAPA qw(:DEFAULT :match);

sub handler {
    my $r = shift;
    my %user;
    my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
    if ($handle ne '') {
        my $lonidsdir=$r->dir_config('lonIDsDir');
        &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
        if ($r->uri =~ m{^/tiny/($match_domain)/(\w+)$}) {
            my ($cdom,$key) = ($1,$2);
            if (&Apache::lonnet::domain($cdom) ne '') {
                my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
                my $tinyurl;
                my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
                if (defined($cached)) {
                    $tinyurl = $result;
                } else {
                    my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
                    if ($currtiny{$key} ne '') {
                        $tinyurl = $currtiny{$key};
                        &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
                    }
                }
                if ($tinyurl) {
                    my ($cnum,$symb) = split(/\&/,$tinyurl);
                    if ($cnum =~ /^$match_courseid$/) {
                        my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
                        if ($chome ne 'no_host') {
                            &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['ttoken']);
                            my ($linkprot,$linkprotuser,$linkprotexit,$ltoken);
                            if ($env{'form.ttoken'}) {
                                my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
                                if ($link_info{'origurl'} eq $r->uri) {
                                    if ($link_info{'ltoken'}) {
                                        $ltoken = $link_info{'ltoken'};
                                        my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
                                        $linkprot = $ltoken_info{'linkprot'};
                                        $linkprotuser = $ltoken_info{'linkprotuser'};
                                        $linkprotexit = $ltoken_info{'linkprotexit'};
                                    } elsif ($link_info{'linkprot'}) {
                                        $linkprot = $link_info{'linkprot'};
                                        if ($link_info{'linkprotuser'}) {
                                            $linkprotuser = $link_info{'linkprotuser'};
                                        }
                                        if ($link_info{'linkprotexit'}) {
                                            $linkprotexit = $link_info{'linkprotexit'};
                                        }
                                    }
                                }
                            }
                            if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                                # Check for ttoken
                                my $newlauncher = &launch_check($r->uri,$symb);
                                my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
                                if (&Apache::lonnet::is_on_map($url)) {
                                    my $realuri;
                                    if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
                                        (!$env{'request.role.adv'})) {
                                        $env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
                                        return HTTP_NOT_ACCEPTABLE;
                                    }
                                    if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
                                        (!$env{'request.role.adv'})) {
                                        $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
                                        if (($url =~ /\.sequence$/) &&
                                            ($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
                                            $realuri .= '?navmap=1';
                                        } else {
                                            $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
                                        }
                                    } else {
                                        $realuri = &Apache::lonnet::clutter($url);
                                        if (($url =~ /\.sequence$/) &&
                                            ($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
                                            $realuri .= '?navmap=1';
                                        } else {
                                            $realuri .= '?symb='.$symb;
                                        }
                                    }
                                    my ($update,$reinitresult);
                                    # Check if course needs to be re-initialized
                                    if ($newlauncher) {
                                        $update = 1;
                                    } else {
                                        my $loncaparev = $r->dir_config('lonVersion');
                                        ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
                                        if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
                                            $update = 1;
                                        } elsif (!-e $env{'request.course.fn'}.'.db') {
                                            $update = 1;
                                        } elsif (!$env{'request.role.adv'}) {
                                            my $navmap = Apache::lonnavmaps::navmap->new();
                                            if (ref($navmap)) {
                                                my $res = $navmap->getBySymb($symb);
                                                if (ref($res)) {
                                                    my ($enc_in_bighash,$enc_in_parm);
                                                    $enc_in_bighash = $res->encrypted();
                                                    if (&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) {
                                                        $enc_in_parm = 1;
                                                    }
                                                    if ($enc_in_bighash ne $enc_in_parm) {
                                                        $update = 1;
                                                    }
                                                }
                                            }
                                        }
                                    }
                                    if ($update) {
                                        my ($furl,$ferr)=
                                            &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
                                        if ($ferr) {
                                            $env{'user.error.msg'}=$r->uri.':bre:0:0:Course not initialized';
                                            $env{'user.reinit'} = 1;
                                            return HTTP_NOT_ACCEPTABLE;
                                        }
                                    }
                                    if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
                                        my $possdel;
                                        if ($reinitresult eq 'supp') {
                                            $possdel = 1;
                                        }
                                        my ($supplemental,$refs_updated) = &Apache::lonnet::get_supplemental($cnum,$cdom,'',$possdel);
                                        unless ($refs_updated) {
                                            &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
                                        }
                                    }
                                    my $host = $r->headers_in->get('Host');
                                    if (!$host) {
                                        $r->internal_redirect($realuri);
                                        return OK;
                                    } else {
                                        my $protocol = 'http';
                                        if ($r->get_server_port == 443) {
                                            $protocol = 'https';
                                        }
                                        my $location = $protocol.'://'.$host.$realuri;
                                        $r->headers_out->set(Location => $location);
                                        return REDIRECT;
                                    }
                                }
                            } else {
                                my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
                                my @possroles = ('in','ta','ep','st','cr','ad');
                                if ($crsenv{'type'} eq 'Community') {
                                    unshift(@possroles,'co');
                                } else {
                                    unshift(@possroles,'cc');
                                }
                                my %roleshash =
                                    &Apache::lonnet::get_my_roles($env{'user.uname'},$env{'user.domain'},
                                                                  'userroles',['previous','active','future'],
                                                                  \@possroles,[$cdom],1);
                                my (%possroles,$hassection,%active,%expired,%future);
                                if (keys(%roleshash)) {
                                    my $now = time;
                                    foreach my $entry (keys(%roleshash)) {
                                        if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
                                            my ($role,$sec) = ($1,$2);
                                            $possroles{$role} = $sec;
                                            if ($sec ne '') {
                                                $hassection = 1;
                                            }
                                            my ($tstart,$tend)=split(/\:/,$roleshash{$entry});
                                            my $status = 'active';
                                            if (($tend) && ($tend<=$now)) {
                                                $status = 'previous';
                                            }
                                            if (($tstart) && ($now<$tstart)) {
                                                $status = 'future';
                                            }
                                            if ($status eq 'active') {
                                                $active{$role} = $sec;
                                            } elsif ($status eq 'previous') {
                                                $expired{$tend} = $role.':'.$sec;
                                            } elsif ($status eq 'future') {
                                                $future{$tstart} = $role.':'.$sec;
                                            }
                                        }
                                    }
                                }
                                my @allposs = keys(%active);
                                if ($env{'request.lti.login'}) {
                                    &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
                                    if ($env{'request.lti.target'} eq '') {
                                        if ($env{'form.ltitarget'} eq 'iframe') {
                                            &Apache::lonnet::appenv({'request.lti.target' => 'iframe'});
                                            delete($env{'form.ltitarget'});
                                        }
                                    }
                                    if ($env{'form.selectrole'}) {
                                        foreach my $role (@allposs) {
                                            my $newrole = "$role./$cdom/$cnum";
                                            if ($possroles{$allposs[0]} ne '') {
                                                $newrole .= "/$possroles{$role}";
                                            }
                                            if ($env{"form.$newrole"}) {
                                                my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
                                                                   '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
                                                if ($env{'form.ltitarget'} eq 'iframe') {
                                                    $destination .= '&ltitarget=iframe';
                                                }
                                                &do_redirect($r,$destination);
                                                return OK;
                                            }
                                        }
                                    }
                                }
                                if (@allposs == 0) {
                                    &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,$linkprotexit,$ltoken);
                                } elsif (@allposs == 1) {
                                    my $newrole = "$allposs[0]./$cdom/$cnum";
                                    $newrole = "$allposs[0]./$cdom/$cnum";
                                    if ($possroles{$allposs[0]} ne '') {
                                        $newrole .= "/$possroles{$allposs[0]}";
                                    }
                                    my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
                                                       '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
                                    if ($env{'form.ttoken'}) {
                                        $destination .= '&ttoken='.$env{'form.ttoken'};
                                    }
                                    &do_redirect($r,$destination,$linkprot);
                                } elsif (@allposs > 1) {
                                    if (grep(/^(cc|co)$/,@allposs)) {
                                        my $newrole;
                                        if (exists($possroles{'cc'})) {
                                            $newrole = 'cc';
                                        } else {
                                            $newrole = 'co';
                                        }
                                        $newrole .= "./$cdom/$cnum";
                                        my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
                                                           '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
                                        if ($env{'form.ttoken'}) {
                                            $destination .= '&ttoken='.$env{'form.ttoken'};
                                        }
                                        &do_redirect($r,$destination,$linkprot);
                                    } else {
                                        my $hascustom;
                                        if (grep(/^cr\//,@allposs)) {
                                            $hascustom = 1;
                                        }
                                        &show_roles($r,\%crsenv,\%active,$hassection,$hascustom);
                                    }
                                }
                                return OK;
                            }
                        }
                    }
                }
            }
        }
        &generic_error($r);
        return OK;
    } else {
        return FORBIDDEN;
    }
}

sub launch_check {
    my ($linkuri,$symb) = @_;
    my ($linkprotector,$linkproturi,$linkprotexit,$linkkey,$newlauncher);
    if ($env{'form.ttoken'}) {
        my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
        &Apache::lonnet::tmpdel($env{'form.ttoken'});
        delete($env{'form.ttoken'});
        if ($link_info{'ltoken'}) {
            unless (($link_info{'linkprot'}) || ($link_info{'linkkey'} ne '')) {
                my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
                if ($ltoken_info{'linkprot'}) {
                    $link_info{'linkprot'} = $ltoken_info{'linkprot'};
                } elsif ($ltoken_info{'linkkey'} ne '') {
                    $link_info{'linkkey'} = $ltoken_info{'linkkey'};
                }
            }
            &Apache::lonnet::tmpdel($link_info{'ltoken'});
        }
        if ($link_info{'linkprot'}) {
            ($linkprotector,$linkproturi) = split(/:/,$link_info{'linkprot'},2);
            if ($env{'user.linkprotector'}) {
                my @protectors = split(/,/,$env{'user.linkprotector'});
                unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
                    push(@protectors,$linkprotector);
                    @protectors = sort { $a <=> $b } @protectors;
                    &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
                }
            } else {
                &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
            }
            if ($env{'user.linkproturi'}) {
                my @proturis = split(/,/,$env{'user.linkproturi'});
                unless(grep(/^\Q$linkproturi\E$/,@proturis)) {
                    push(@proturis,$linkproturi);
                    @proturis = sort(@proturis);
                    &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
                }
            } else {
                &Apache::lonnet::appenv({'user.linkproturi' => $linkproturi});
            }
            if ($link_info{'linkprotexit'}) {
                $linkprotexit = $link_info{'linkprotexit'};
            }
        } elsif ($link_info{'linkkey'} ne '') {
            $linkkey = $link_info{'linkkey'};
            my $keyedlinkuri = $linkuri;
            if ($env{'user.deeplinkkey'} ne '') {
                my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
                unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
                    push(@linkkeys,$linkkey);
                    &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
                }
            } else {
                &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
            }
            if ($env{'user.keyedlinkuri'}) {
                my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
                unless (grep(/^\Q$keyedlinkuri\E$/,@keyeduris)) {
                    push(@keyeduris,$keyedlinkuri);
                    &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
                }
            } else {
                &Apache::lonnet::appenv({'user.keyedlinkuri' => $keyedlinkuri});
            }
        }
        if ($link_info{'checklaunch'}) {
            $newlauncher = 1;
        }
    }
    my $currdeeplinklogin = $env{'request.deeplink.login'};
    my $deeplink;
    if ($symb =~ /\.(page|sequence)$/) {
        my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
        my $navmap = Apache::lonnavmaps::navmap->new();
        if (ref($navmap)) {
            $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
        }
    } else {
        $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
    }
    if ($deeplink ne '') {
        my $disallow;
        my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
        if (($protect ne 'none') && ($protect ne '')) {
            my ($acctype,$item) = split(/:/,$protect);
            if ($acctype =~ /lti(c|d)$/) {
                my $ltitype = $1;
                if ($linkprotector) {
                    unless ($linkprotector.':'.$linkproturi eq $item.$ltitype.':'.$linkuri) {
                        $disallow = 1;
                    }
                } else {
                    $disallow = 1;
                }
            } elsif ($acctype eq 'key') {
                if ($linkkey ne '') {
                    unless ($linkkey eq $item) {
                        $disallow = 1;
                    }
                } else {
                    $disallow = 1;
                }
            }
        }
        if ($disallow) {
            if ($currdeeplinklogin eq $linkuri) {
                &Apache::lonnet::delenv('request.deeplink.login');
                if ($env{'request.deeplink.target'} ne '') {
                    &Apache::lonnet::delenv('request.deeplink.target');
                }
                if ($env{'request.linkprot'} ne '') {
                    &Apache::lonnet::delenv('request.linkprot');
                }
                if ($env{'request.linkprotexit'} ne '') {
                    &Apache::lonnet::delenv('request.linkprotexit');
                }
            }
        } else {
            unless ($currdeeplinklogin eq $linkuri) {
                if (($linkprotector) || ($linkkey ne '')) {
                    if ($linkprotector) {
                        &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
                    } elsif ($env{'request.linkprot'}) {
                        &Apache::lonnet::delenv('request.linkprot');
                    }
                    if ($linkprotexit) {
                        &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
                    } elsif ($env{'request.linkprotexit'}) {
                        &Apache::lonnet::delenv('request.linkprotexit');
                    }
                    if ($linkkey ne '') {
                        &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
                    } elsif ($env{'request.linkkey'} ne '') {
                        &Apache::lonnet::delenv('request.linkkey');
                    }
                    $newlauncher = 1;
                }
            }
            &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
            if ($target ne '') {
                &Apache::lonnet::appenv({'request.deeplink.target' => $target});
            } elsif ($env{'request.deeplink.target'} ne '') {
                &Apache::lonnet::delenv('request.deeplink.target');
            }
        }
    } else {
        if ($linkprotector) {
            &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
        } elsif ($env{'request.linkprot'}) {
            &Apache::lonnet::delenv('request.linkprot');
        }
        if ($linkprotexit) {
            &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
        } elsif ($env{'request.linkprotexit'}) {
            &Apache::lonnet::delenv('request.linkprotexit');
        }
        if ($linkkey ne '') {
            &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
        } else {
            &Apache::lonnet::delenv('request.linkkey');
        }
        &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
        if ($env{'request.deeplink.target'} ne '') {
            &Apache::lonnet::delenv('request.deeplink.target');
        }
    }
    return $newlauncher;
}

sub do_redirect {
    my ($r,$destination,$linkprot) = @_;
    my $windowname = 'loncapaclient';
    if ($env{'request.lti.login'}) {
        $windowname .= 'lti';
    }
    my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
    my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
    if ($linkprot) {
        $args = {'only_body' => 1,
                 'redirect'  => [0,$destination],};
    }
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    if ($linkprot) {
        $r->print(&Apache::loncommon::start_page('Valid link','',$args).
                  &Apache::loncommon::end_page());
    } else {
        $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
                  &Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
                  '<h1>'.&mt('Welcome').'</h1>'.
                  '<p>'.&mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>').'</p><p>'.
                  '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
                  &Apache::loncommon::end_page());
    }
    return;
}

sub show_roles {
    my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,$linkprot,$linkprotuser,$linkprotexit,$ltoken) = @_;
    my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
    if (ref($crsenv) eq 'HASH') {
        $crsdesc = $crsenv->{'description'};
        $crstype = $crsenv->{'type'};
        $cdom = $crsenv->{'domain'};
        $cnum = $crsenv->{'num'};
    }
    if ($crstype eq '') {
        $crstype = 'Course';
    }
    my $lc_crstype = lc($crstype);
    if ($crsdesc ne '') {
        $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
                      '<i>'.$crsdesc.'</i>');
    }
    if (ref($possroles) eq 'HASH') {
        if (keys(%{$possroles}) > 0) {
            $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
            if ($linkprot) {
                $args = {'only_body' => 1};
            }
            $title = 'Choose a role'; #Do not localize.
            if ($crstype eq 'Community') {
                $preamble = &mt('You have the following active roles in this community:');
            } else { 
                $preamble = &mt('You have the following active roles in this course:');
            }
            $datatable = '<form name="" action="/adm/roles">'.
                         '<input type="hidden" name="newrole" value="" />'."\n".
                         '<input type="hidden" name="selectrole" value="1" />'."\n".
                         '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
            if ($env{'form.ttoken'}) {
                $datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
            }
            $datatable .= &Apache::loncommon::start_data_table().
                          &Apache::loncommon::start_data_table_header_row().
                          '<th></th><th>'.&mt('User role').'</th>';
            if ($hassection) {
                $datatable .= '<th>'.&mt('Section').'</th>';
            }
            if ($hascustom) {
                $datatable .= '<th>'.&mt('Information').'</th>';
            }
            $datatable .= &Apache::loncommon::end_data_table_header_row();
            my @available = sort(keys(%{$possroles}));
            foreach my $role ('ad','in','ta','ep','st','cr') {
                foreach my $key (@available) {
                    if ($key =~ m{^$role($|/)}) {
                        my $trolecode = "$key./$cdom/$cnum";
                        my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
                        my $sec = $possroles->{$key};
                        if ($sec ne '') {
                            $trolecode .= '/'.$sec;
                        }
                        my $buttonname=$trolecode;
                        $buttonname=~s/\W//g;
                        $datatable .= &Apache::loncommon::start_data_table_row().
                                      '<td><input name="'.$buttonname.'" type="button" value="'.
                                      &mt('Select').'" onclick="javascript:enterrole(this.form,'.
                                      "'$trolecode','$buttonname'".');" /></td>';
                        if ($key =~ /^cr\//) {
                            my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
                            $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
                            if ($hassection) {
                                $datatable .= '<td>'.$sec.'</td>';
                            }
                            $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
                                          &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
                                          '</td>';
                        } else {
                            if ($hassection) {
                                $datatable .= '<td>'.$rolename.'</td>';
                                if ($hascustom) {
                                    $datatable .= '<td colspan="2">'.$sec.'</td>';
                                } else {
                                    $datatable .= '<td>'.$sec.'</td>';
                                }
                            } elsif ($hascustom) {
                                $datatable .= '<td colspan="2">'.$rolename.'</td>';
                            } else {
                                $datatable .= '<td>'.$rolename.'</td>';
                            }
                        }
                        $datatable .= &Apache::loncommon::end_data_table_row();
                    }
                }
            }
            $datatable .= &Apache::loncommon::end_data_table().
                          '</form>';
            my $standby = &mt('Role selected. Please stand by.');
            $js = <<"ENDJS";
<script type="text/javascript">
// <![CDATA[

active=true;

function enterrole (thisform,rolecode,buttonname) {
    if (active) {
        active=false;
        document.title='$standby';
        window.status='$standby';
        thisform.newrole.value=rolecode;
        thisform.submit();
    } else {
       alert('$standby');
    }
}

// ]]>
</script>
ENDJS
        } else {
            if ($linkprot) {
                $title = 'No access';
                $preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
                $args->{'only_body'} = 1;
            } else {
                $title = 'No active role';
                $preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
                $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
            }
            $header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
                                                                                    $env{'user.domain'}).'</b>');
            if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
                my @future = sort { $a <=> $b } (keys(%{$futureroles}));
                $preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
                             ' '.&mt('Please try again then.').'</p>';
            } elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
                my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
                $preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
            } elsif ($linkprot) {
                if ($linkprotuser) {
                    my ($uname,$udom) = split(/:/,$linkprotuser,2);
                    $preamble .= '<p>'.&mt('As you followed a link from another system, while logged into that other system with the username: [_1], it is recommended that you contact your instructor.','<i>'.$uname.'</i>').'</p>';
                } else {
                    my $relogin;
                    my %data = (
                                origurl => $r->uri,
                                linkprot => $linkprot,
                                linkprotexit => $linkprotexit,
                    );
                    my $token =
                        &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
                    unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
                            ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
                            $relogin = '/adm/relaunch?rtoken='.$token;
                    }
                    $preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
                                       &mt('You are currently logged in as: [_1] in domain: [_2]',
                                           '<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
                    if ($relogin) {
                        $preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
                    }
                }
            }
            if ($env{'form.ttoken'}) {
                &Apache::lonnet::tmpdel($env{'form.ttoken'});
            }
            if ($ltoken) {
                &Apache::lonnet::tmpdel($ltoken);
            }
        }
    }
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    $r->print(&Apache::loncommon::start_page($title,$js,$args).
              '<h3>'.$header.'</h3>'.
              '<div>'.$preamble.'</div>'.
              $datatable.
              &Apache::loncommon::end_page());
    return;
}

sub generic_error {
    my ($r) = @_;
    my $continuelink;
    unless ($env{'request.lti.login'}) {
        my $linktext;
        if ($env{'user.adv'}) {
            $linktext = &mt('Continue to your roles page');
        } else {
            $linktext = &mt('Continue to your courses page');
        }
        $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
    }
    my $msg = &mt('The page you requested does not exist.');
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
    $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
              '<div class="LC_error">'.$msg.'</div>'.
              '<p>'.$continuelink.'</p>'.
              &Apache::loncommon::end_page());
    return;
}

1;