File:  [LON-CAPA] / loncom / interface / lontiny.pm
Revision 1.8.2.5: download - view: text, annotated - select for diffs
Wed Jul 5 19:20:19 2023 UTC (12 months ago) by raeburn
Branches: version_2_11_4_msu
- For 2.11.4 (modified)
  Reverse changes in 1.8.2.1.  Include changes in 1.19, 1.20

    1: # The LearningOnline Network with CAPA
    2: # Extract domain, courseID, and symb from a shortened URL,
    3: # and switch role to a role in designated course.
    4: #
    5: # $Id: lontiny.pm,v 1.8.2.5 2023/07/05 19:20:19 raeburn Exp $
    6: #
    7: # Copyright Michigan State University Board of Trustees
    8: #
    9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   10: #
   11: # LON-CAPA is free software; you can redistribute it and/or modify
   12: # it under the terms of the GNU General Public License as published by
   13: # the Free Software Foundation; either version 2 of the License, or
   14: # (at your option) any later version.
   15: #
   16: # LON-CAPA is distributed in the hope that it will be useful,
   17: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   19: # GNU General Public License for more details.
   20: #
   21: # You should have received a copy of the GNU General Public License
   22: # along with LON-CAPA; if not, write to the Free Software
   23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   24: #
   25: # /home/httpd/html/adm/gpl.txt
   26: #
   27: # http://www.lon-capa.org/
   28: #
   29: 
   30: package Apache::lontiny;
   31: 
   32: use strict;
   33: use Apache::Constants qw(:common :http);
   34: use Apache::lonnet;
   35: use Apache::loncommon;
   36: use Apache::lonhtmlcommon;
   37: use Apache::lonroles;
   38: use Apache::lonuserstate;
   39: use Apache::lonnavmaps;
   40: use Apache::lonlocal;
   41: use LONCAPA qw(:DEFAULT :match);
   42: 
   43: sub handler {
   44:     my $r = shift;
   45:     my %user;
   46:     my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
   47:     if ($handle ne '') {
   48:         my $lonidsdir=$r->dir_config('lonIDsDir');
   49:         &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
   50:         if ($r->uri =~ m{^/tiny/($match_domain)/(\w+)$}) {
   51:             my ($cdom,$key) = ($1,$2);
   52:             if (&Apache::lonnet::domain($cdom) ne '') {
   53:                 my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
   54:                 my $tinyurl;
   55:                 my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
   56:                 if (defined($cached)) {
   57:                     $tinyurl = $result;
   58:                 } else {
   59:                     my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
   60:                     if ($currtiny{$key} ne '') {
   61:                         $tinyurl = $currtiny{$key};
   62:                         &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
   63:                     }
   64:                 }
   65:                 if ($tinyurl) {
   66:                     my ($cnum,$symb) = split(/\&/,$tinyurl);
   67:                     if ($cnum =~ /^$match_courseid$/) {
   68:                         my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
   69:                         if ($chome ne 'no_host') {
   70:                             &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['ttoken']);
   71:                             my ($linkprot,$linkprotuser,$linkprotexit,$ltoken,$linkprotpbid,$linkprotpburl);
   72:                             if ($env{'form.ttoken'}) {
   73:                                 my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
   74:                                 if ($link_info{'origurl'} eq $r->uri) {
   75:                                     if ($link_info{'ltoken'}) {
   76:                                         $ltoken = $link_info{'ltoken'};
   77:                                         my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
   78:                                         $linkprot = $ltoken_info{'linkprot'};
   79:                                         $linkprotuser = $ltoken_info{'linkprotuser'};
   80:                                         $linkprotexit = $ltoken_info{'linkprotexit'};
   81:                                         $linkprotpbid = $ltoken_info{'linkprotpbid'};
   82:                                         $linkprotpburl = $ltoken_info{'linkprotpburl'};
   83:                                     } elsif ($link_info{'linkprot'}) {
   84:                                         $linkprot = $link_info{'linkprot'};
   85:                                         if ($link_info{'linkprotuser'}) {
   86:                                             $linkprotuser = $link_info{'linkprotuser'};
   87:                                         }
   88:                                         if ($link_info{'linkprotexit'}) {
   89:                                             $linkprotexit = $link_info{'linkprotexit'};
   90:                                         }
   91:                                         if ($link_info{'linkprotpbid'}) {
   92:                                             $linkprotpbid = $link_info{'linkprotpbid'};
   93:                                         }
   94:                                         if ($link_info{'linkprotpburl'}) {
   95:                                             $linkprotpburl = $link_info{'linkprotpburl'};
   96:                                         }
   97:                                     }
   98:                                 }
   99:                             }
  100:                             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
  101:                                 # Check for ttoken
  102:                                 my $newlauncher = &launch_check($r->uri,$symb);
  103:                                 my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
  104:                                 if (&Apache::lonnet::is_on_map($url)) {
  105:                                     my $realuri;
  106:                                     if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
  107:                                         (!$env{'request.role.adv'})) {
  108:                                         $env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
  109:                                         return HTTP_NOT_ACCEPTABLE;
  110:                                     }
  111:                                     if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
  112:                                         (!$env{'request.role.adv'})) {
  113:                                         $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
  114:                                         if (($url =~ /\.sequence$/) &&
  115:                                             ($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
  116:                                             $realuri .= '?navmap=1';
  117:                                         } else {
  118:                                             $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
  119:                                         }
  120:                                     } else {
  121:                                         $realuri = &Apache::lonnet::clutter($url);
  122:                                         if (($url =~ /\.sequence$/) &&
  123:                                             ($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
  124:                                             $realuri .= '?navmap=1';
  125:                                         } else {
  126:                                             $realuri .= '?symb='.$symb;
  127:                                         }
  128:                                     }
  129:                                     my ($update,$reinitresult);
  130:                                     # Check if course needs to be re-initialized
  131:                                     if ($newlauncher) {
  132:                                         $update = 1;
  133:                                     } else {
  134:                                         my $loncaparev = $r->dir_config('lonVersion');
  135:                                         ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
  136:                                         if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
  137:                                             $update = 1;
  138:                                         } elsif (!-e $env{'request.course.fn'}.'.db') {
  139:                                             $update = 1;
  140:                                         } elsif (!$env{'request.role.adv'}) {
  141:                                             my $navmap = Apache::lonnavmaps::navmap->new();
  142:                                             if (ref($navmap)) {
  143:                                                 my $res = $navmap->getBySymb($symb);
  144:                                                 if (ref($res)) {
  145:                                                     my ($enc_in_bighash,$enc_in_parm);
  146:                                                     $enc_in_bighash = $res->encrypted();
  147:                                                     if (&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) {
  148:                                                         $enc_in_parm = 1;
  149:                                                     }
  150:                                                     if ($enc_in_bighash ne $enc_in_parm) {
  151:                                                         $update = 1;
  152:                                                     }
  153:                                                 }
  154:                                             }
  155:                                         }
  156:                                     }
  157:                                     if ($update) {
  158:                                         my ($furl,$ferr)=
  159:                                             &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
  160:                                         if ($ferr) {
  161:                                             $env{'user.error.msg'}=$r->uri.':bre:0:0:Course not initialized';
  162:                                             $env{'user.reinit'} = 1;
  163:                                             return HTTP_NOT_ACCEPTABLE;
  164:                                         }
  165:                                     }
  166:                                     if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
  167:                                         my $possdel;
  168:                                         if ($reinitresult eq 'supp') {
  169:                                             $possdel = 1;
  170:                                         }
  171:                                         my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
  172:                                         unless ($refs_updated) {
  173:                                             &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
  174:                                         }
  175:                                     }
  176:                                     my $host = $r->headers_in->get('Host');
  177:                                     if (!$host) {
  178:                                         $r->internal_redirect($realuri);
  179:                                         return OK;
  180:                                     } else {
  181:                                         my $protocol = 'http';
  182:                                         if ($r->get_server_port == 443) {
  183:                                             $protocol = 'https';
  184:                                         }
  185:                                         my $location = $protocol.'://'.$host.$realuri;
  186:                                         $r->headers_out->set(Location => $location);
  187:                                         return REDIRECT;
  188:                                     }
  189:                                 }
  190:                             } else {
  191:                                 my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
  192:                                 my @possroles = ('in','ta','ep','st','cr','ad');
  193:                                 if ($crsenv{'type'} eq 'Community') {
  194:                                     unshift(@possroles,'co');
  195:                                 } else {
  196:                                     unshift(@possroles,'cc');
  197:                                 }
  198:                                 my %roleshash =
  199:                                     &Apache::lonnet::get_my_roles($env{'user.uname'},$env{'user.domain'},
  200:                                                                   'userroles',['previous','active','future'],
  201:                                                                   \@possroles,[$cdom],1);
  202:                                 my (%possroles,$hassection,%active,%expired,%future);
  203:                                 if (keys(%roleshash)) {
  204:                                     my $now = time;
  205:                                     foreach my $entry (keys(%roleshash)) {
  206:                                         if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
  207:                                             my ($role,$sec) = ($1,$2);
  208:                                             $possroles{$role} = $sec;
  209:                                             if ($sec ne '') {
  210:                                                 $hassection = 1;
  211:                                             }
  212:                                             my ($tstart,$tend)=split(/\:/,$roleshash{$entry});
  213:                                             my $status = 'active';
  214:                                             if (($tend) && ($tend<=$now)) {
  215:                                                 $status = 'previous';
  216:                                             }
  217:                                             if (($tstart) && ($now<$tstart)) {
  218:                                                 $status = 'future';
  219:                                             }
  220:                                             if ($status eq 'active') {
  221:                                                 $active{$role} = $sec;
  222:                                             } elsif ($status eq 'previous') {
  223:                                                 $expired{$tend} = $role.':'.$sec;
  224:                                             } elsif ($status eq 'future') {
  225:                                                 $future{$tstart} = $role.':'.$sec;
  226:                                             }
  227:                                         }
  228:                                     }
  229:                                 }
  230:                                 my @allposs = keys(%active);
  231:                                 if ($env{'request.lti.login'}) {
  232:                                     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
  233:                                     if ($env{'request.lti.target'} eq '') {
  234:                                         if ($env{'form.ltitarget'} eq 'iframe') {
  235:                                             &Apache::lonnet::appenv({'request.lti.target' => 'iframe'});
  236:                                             delete($env{'form.ltitarget'});
  237:                                         }
  238:                                     }
  239:                                     if ($env{'form.selectrole'}) {
  240:                                         foreach my $role (@allposs) {
  241:                                             my $newrole = "$role./$cdom/$cnum";
  242:                                             if ($possroles{$allposs[0]} ne '') {
  243:                                                 $newrole .= "/$possroles{$role}";
  244:                                             }
  245:                                             if ($env{"form.$newrole"}) {
  246:                                                 my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  247:                                                                    '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
  248:                                                 if ($env{'form.ltitarget'} eq 'iframe') {
  249:                                                     $destination .= '&ltitarget=iframe';
  250:                                                 }
  251:                                                 &do_redirect($r,$destination);
  252:                                                 return OK;
  253:                                             }
  254:                                         }
  255:                                     }
  256:                                 }
  257:                                 if (@allposs == 0) {
  258:                                     &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,
  259:                                                 $linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken);
  260:                                 } elsif (@allposs == 1) {
  261:                                     my $newrole = "$allposs[0]./$cdom/$cnum";
  262:                                     $newrole = "$allposs[0]./$cdom/$cnum";
  263:                                     if ($possroles{$allposs[0]} ne '') {
  264:                                         $newrole .= "/$possroles{$allposs[0]}";
  265:                                     }
  266:                                     my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  267:                                                        '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
  268:                                     if ($env{'form.ttoken'}) {
  269:                                         $destination .= '&ttoken='.$env{'form.ttoken'};
  270:                                     }
  271:                                     &do_redirect($r,$destination,$linkprot);
  272:                                 } elsif (@allposs > 1) {
  273:                                     if (grep(/^(cc|co)$/,@allposs)) {
  274:                                         my $newrole;
  275:                                         if (exists($possroles{'cc'})) {
  276:                                             $newrole = 'cc';
  277:                                         } else {
  278:                                             $newrole = 'co';
  279:                                         }
  280:                                         $newrole .= "./$cdom/$cnum";
  281:                                         my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  282:                                                            '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
  283:                                         if ($env{'form.ttoken'}) {
  284:                                             $destination .= '&ttoken='.$env{'form.ttoken'};
  285:                                         }
  286:                                         &do_redirect($r,$destination,$linkprot);
  287:                                     } else {
  288:                                         my $hascustom;
  289:                                         if (grep(/^cr\//,@allposs)) {
  290:                                             $hascustom = 1;
  291:                                         }
  292:                                         &show_roles($r,\%crsenv,\%active,$hassection,$hascustom);
  293:                                     }
  294:                                 }
  295:                                 return OK;
  296:                             }
  297:                         }
  298:                     }
  299:                 }
  300:             }
  301:         }
  302:         &generic_error($r);
  303:         return OK;
  304:     } else {
  305:         return FORBIDDEN;
  306:     }
  307: }
  308: 
  309: sub launch_check {
  310:     my ($linkuri,$symb) = @_;
  311:     my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,$linkkey,$newlauncher);
  312:     if ($env{'form.ttoken'}) {
  313:         my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
  314:         &Apache::lonnet::tmpdel($env{'form.ttoken'});
  315:         delete($env{'form.ttoken'});
  316:         if ($link_info{'ltoken'}) {
  317:             unless (($link_info{'linkprot'}) || ($link_info{'linkkey'} ne '')) {
  318:                 my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
  319:                 if ($ltoken_info{'linkprot'}) {
  320:                     $link_info{'linkprot'} = $ltoken_info{'linkprot'};
  321:                 } elsif ($ltoken_info{'linkkey'} ne '') {
  322:                     $link_info{'linkkey'} = $ltoken_info{'linkkey'};
  323:                 }
  324:             }
  325:             &Apache::lonnet::tmpdel($link_info{'ltoken'});
  326:         }
  327:         if ($link_info{'linkprot'}) {
  328:             ($linkprotector,$linkproturi) = split(/:/,$link_info{'linkprot'},2);
  329:             if ($env{'user.linkprotector'}) {
  330:                 my @protectors = split(/,/,$env{'user.linkprotector'});
  331:                 unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
  332:                     push(@protectors,$linkprotector);
  333:                     @protectors = sort { $a <=> $b } @protectors;
  334:                     &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
  335:                 }
  336:             } else {
  337:                 &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
  338:             }
  339:             if ($env{'user.linkproturi'}) {
  340:                 my @proturis = split(/,/,$env{'user.linkproturi'});
  341:                 unless(grep(/^\Q$linkproturi\E$/,@proturis)) {
  342:                     push(@proturis,$linkproturi);
  343:                     @proturis = sort(@proturis);
  344:                     &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
  345:                 }
  346:             } else {
  347:                 &Apache::lonnet::appenv({'user.linkproturi' => $linkproturi});
  348:             }
  349:             if ($link_info{'linkprotexit'}) {
  350:                 $linkprotexit = $link_info{'linkprotexit'};
  351:             }
  352:             if ($link_info{'linkprotpbid'}) {
  353:                 $linkprotpbid = $link_info{'linkprotpbid'};
  354:             }
  355:             if ($link_info{'linkprotpburl'}) {
  356:                 $linkprotpburl = $link_info{'linkprotpburl'};
  357:             }
  358:         } elsif ($link_info{'linkkey'} ne '') {
  359:             $linkkey = $link_info{'linkkey'};
  360:             my $keyedlinkuri = $linkuri;
  361:             if ($env{'user.deeplinkkey'} ne '') {
  362:                 my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
  363:                 unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
  364:                     push(@linkkeys,$linkkey);
  365:                     &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
  366:                 }
  367:             } else {
  368:                 &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
  369:             }
  370:             if ($env{'user.keyedlinkuri'}) {
  371:                 my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
  372:                 unless (grep(/^\Q$keyedlinkuri\E$/,@keyeduris)) {
  373:                     push(@keyeduris,$keyedlinkuri);
  374:                     &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
  375:                 }
  376:             } else {
  377:                 &Apache::lonnet::appenv({'user.keyedlinkuri' => $keyedlinkuri});
  378:             }
  379:         }
  380:         if ($link_info{'checklaunch'}) {
  381:             $newlauncher = 1;
  382:         }
  383:     }
  384:     my $currdeeplinklogin = $env{'request.deeplink.login'};
  385:     my $deeplink;
  386:     if ($symb =~ /\.(page|sequence)$/) {
  387:         my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
  388:         my $navmap = Apache::lonnavmaps::navmap->new();
  389:         if (ref($navmap)) {
  390:             $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
  391:         }
  392:     } else {
  393:         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
  394:     }
  395:     if ($deeplink ne '') {
  396:         my $disallow;
  397:         my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
  398:         if (($protect ne 'none') && ($protect ne '')) {
  399:             my ($acctype,$item) = split(/:/,$protect);
  400:             if ($acctype =~ /lti(c|d)$/) {
  401:                 my $ltitype = $1;
  402:                 if ($linkprotector) {
  403:                     unless ($linkprotector.':'.$linkproturi eq $item.$ltitype.':'.$linkuri) {
  404:                         $disallow = 1;
  405:                     }
  406:                 } else {
  407:                     $disallow = 1;
  408:                 }
  409:             } elsif ($acctype eq 'key') {
  410:                 if ($linkkey ne '') {
  411:                     unless ($linkkey eq $item) {
  412:                         $disallow = 1;
  413:                     }
  414:                 } else {
  415:                     $disallow = 1;
  416:                 }
  417:             }
  418:         }
  419:         if ($disallow) {
  420:             if ($currdeeplinklogin eq $linkuri) {
  421:                 &Apache::lonnet::delenv('request.deeplink.login');
  422:                 if ($env{'request.deeplink.target'} ne '') {
  423:                     &Apache::lonnet::delenv('request.deeplink.target');
  424:                 }
  425:                 if ($env{'request.linkprot'} ne '') {
  426:                     &Apache::lonnet::delenv('request.linkprot');
  427:                 }
  428:                 if ($env{'request.linkprotexit'} ne '') {
  429:                     &Apache::lonnet::delenv('request.linkprotexit');
  430:                 }
  431:                 if ($env{'request.linkprotpbid'} ne '') {
  432:                     &Apache::lonnet::delenv('request.linkprotpbid');
  433:                 }
  434:                 if ($env{'request.linkprotpburl'} ne '') {
  435:                     &Apache::lonnet::delenv('request.linkprotpburl');
  436:                 }
  437:             }
  438:         } else {
  439:             unless ($currdeeplinklogin eq $linkuri) {
  440:                 if (($linkprotector) || ($linkkey ne '')) {
  441:                     if ($linkprotector) {
  442:                         &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
  443:                     } elsif ($env{'request.linkprot'}) {
  444:                         &Apache::lonnet::delenv('request.linkprot');
  445:                     }
  446:                     if ($linkprotexit) {
  447:                         &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
  448:                     } elsif ($env{'request.linkprotexit'}) {
  449:                         &Apache::lonnet::delenv('request.linkprotexit');
  450:                     }
  451:                     if ($linkprotpbid) {
  452:                         &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
  453:                     } elsif ($env{'request.linkprotpbid'}) {
  454:                         &Apache::lonnet::delenv('request.linkprotpbid');
  455:                     }
  456:                     if ($linkprotpburl) {
  457:                         &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
  458:                     } elsif ($env{'request.linkprotpburl'}) {
  459:                         &Apache::lonnet::delenv('request.linkprotpburl');
  460:                     }
  461:                     if ($linkkey ne '') {
  462:                         &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
  463:                     } elsif ($env{'request.linkkey'} ne '') {
  464:                         &Apache::lonnet::delenv('request.linkkey');
  465:                     }
  466:                     $newlauncher = 1;
  467:                 }
  468:             }
  469:             &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
  470:             if ($target ne '') {
  471:                 &Apache::lonnet::appenv({'request.deeplink.target' => $target});
  472:             } elsif ($env{'request.deeplink.target'} ne '') {
  473:                 &Apache::lonnet::delenv('request.deeplink.target');
  474:             }
  475:         }
  476:     } else {
  477:         if ($linkprotector) {
  478:             &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
  479:         } elsif ($env{'request.linkprot'}) {
  480:             &Apache::lonnet::delenv('request.linkprot');
  481:         }
  482:         if ($linkprotexit) {
  483:             &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
  484:         } elsif ($env{'request.linkprotexit'}) {
  485:             &Apache::lonnet::delenv('request.linkprotexit');
  486:         }
  487:         if ($linkprotpbid) {
  488:             &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
  489:         } elsif ($env{'request.linkprotpbid'}) {
  490:             &Apache::lonnet::delenv('request.linkprotpbid');
  491:         }
  492:         if ($linkprotpburl) {
  493:             &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
  494:         } elsif ($env{'request.linkprotpburl'}) {
  495:             &Apache::lonnet::delenv('request.linkprotpburl');
  496:         }
  497:         if ($linkkey ne '') {
  498:             &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
  499:         } else {
  500:             &Apache::lonnet::delenv('request.linkkey');
  501:         }
  502:         &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
  503:         if ($env{'request.deeplink.target'} ne '') {
  504:             &Apache::lonnet::delenv('request.deeplink.target');
  505:         }
  506:     }
  507:     return $newlauncher;
  508: }
  509: 
  510: sub do_redirect {
  511:     my ($r,$destination,$linkprot) = @_;
  512:     my $windowname = 'loncapaclient';
  513:     if ($env{'request.lti.login'}) {
  514:         $windowname .= 'lti';
  515:     }
  516:     my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
  517:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
  518:     if ($linkprot) {
  519:         $args = {'only_body' => 1,
  520:                  'redirect'  => [0,$destination],};
  521:     }
  522:     &Apache::loncommon::content_type($r,'text/html');
  523:     $r->send_http_header;
  524:     if ($linkprot) {
  525:         $r->print(&Apache::loncommon::start_page('Valid link','',$args).
  526:                   &Apache::loncommon::end_page());
  527:     } else {
  528:         $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
  529:                   &Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
  530:                   '<h1>'.&mt('Welcome').'</h1>'.
  531:                   '<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>'.
  532:                   '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
  533:                   &Apache::loncommon::end_page());
  534:     }
  535:     return;
  536: }
  537: 
  538: sub show_roles {
  539:     my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
  540:         $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
  541:     my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
  542:     if (ref($crsenv) eq 'HASH') {
  543:         $crsdesc = $crsenv->{'description'};
  544:         $crstype = $crsenv->{'type'};
  545:         $cdom = $crsenv->{'domain'};
  546:         $cnum = $crsenv->{'num'};
  547:     }
  548:     if ($crstype eq '') {
  549:         $crstype = 'Course';
  550:     }
  551:     my $lc_crstype = lc($crstype);
  552:     if ($crsdesc ne '') {
  553:         $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
  554:                       '<i>'.$crsdesc.'</i>');
  555:     }
  556:     if (ref($possroles) eq 'HASH') {
  557:         if (keys(%{$possroles}) > 0) {
  558:             $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
  559:             if ($linkprot) {
  560:                 $args = {'only_body' => 1};
  561:             }
  562:             $title = 'Choose a role'; #Do not localize.
  563:             if ($crstype eq 'Community') {
  564:                 $preamble = &mt('You have the following active roles in this community:');
  565:             } else { 
  566:                 $preamble = &mt('You have the following active roles in this course:');
  567:             }
  568:             $datatable = '<form name="" action="/adm/roles">'.
  569:                          '<input type="hidden" name="newrole" value="" />'."\n".
  570:                          '<input type="hidden" name="selectrole" value="1" />'."\n".
  571:                          '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
  572:             if ($env{'form.ttoken'}) {
  573:                 $datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
  574:             }
  575:             $datatable .= &Apache::loncommon::start_data_table().
  576:                           &Apache::loncommon::start_data_table_header_row().
  577:                           '<th></th><th>'.&mt('User role').'</th>';
  578:             if ($hassection) {
  579:                 $datatable .= '<th>'.&mt('Section').'</th>';
  580:             }
  581:             if ($hascustom) {
  582:                 $datatable .= '<th>'.&mt('Information').'</th>';
  583:             }
  584:             $datatable .= &Apache::loncommon::end_data_table_header_row();
  585:             my @available = sort(keys(%{$possroles}));
  586:             foreach my $role ('ad','in','ta','ep','st','cr') {
  587:                 foreach my $key (@available) {
  588:                     if ($key =~ m{^$role($|/)}) {
  589:                         my $trolecode = "$key./$cdom/$cnum";
  590:                         my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
  591:                         my $sec = $possroles->{$key};
  592:                         if ($sec ne '') {
  593:                             $trolecode .= '/'.$sec;
  594:                         }
  595:                         my $buttonname=$trolecode;
  596:                         $buttonname=~s/\W//g;
  597:                         $datatable .= &Apache::loncommon::start_data_table_row().
  598:                                       '<td><input name="'.$buttonname.'" type="button" value="'.
  599:                                       &mt('Select').'" onclick="javascript:enterrole(this.form,'.
  600:                                       "'$trolecode','$buttonname'".');" /></td>';
  601:                         if ($key =~ /^cr\//) {
  602:                             my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
  603:                             $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
  604:                             if ($hassection) {
  605:                                 $datatable .= '<td>'.$sec.'</td>';
  606:                             }
  607:                             $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
  608:                                           &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
  609:                                           '</td>';
  610:                         } else {
  611:                             if ($hassection) {
  612:                                 $datatable .= '<td>'.$rolename.'</td>';
  613:                                 if ($hascustom) {
  614:                                     $datatable .= '<td colspan="2">'.$sec.'</td>';
  615:                                 } else {
  616:                                     $datatable .= '<td>'.$sec.'</td>';
  617:                                 }
  618:                             } elsif ($hascustom) {
  619:                                 $datatable .= '<td colspan="2">'.$rolename.'</td>';
  620:                             } else {
  621:                                 $datatable .= '<td>'.$rolename.'</td>';
  622:                             }
  623:                         }
  624:                         $datatable .= &Apache::loncommon::end_data_table_row();
  625:                     }
  626:                 }
  627:             }
  628:             $datatable .= &Apache::loncommon::end_data_table().
  629:                           '</form>';
  630:             my $standby = &mt('Role selected. Please stand by.');
  631:             $js = <<"ENDJS";
  632: <script type="text/javascript">
  633: // <![CDATA[
  634: 
  635: active=true;
  636: 
  637: function enterrole (thisform,rolecode,buttonname) {
  638:     if (active) {
  639:         active=false;
  640:         document.title='$standby';
  641:         window.status='$standby';
  642:         thisform.newrole.value=rolecode;
  643:         thisform.submit();
  644:     } else {
  645:        alert('$standby');
  646:     }
  647: }
  648: 
  649: // ]]>
  650: </script>
  651: ENDJS
  652:         } else {
  653:             if ($linkprot) {
  654:                 $title = 'No access';
  655:                 $preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
  656:                 $args->{'only_body'} = 1;
  657:             } else {
  658:                 $title = 'No active role';
  659:                 $preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
  660:                 $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
  661:             }
  662:             $header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
  663:                                                                                     $env{'user.domain'}).'</b>');
  664:             if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
  665:                 my @future = sort { $a <=> $b } (keys(%{$futureroles}));
  666:                 $preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
  667:                              ' '.&mt('Please try again then.').'</p>';
  668:             } elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
  669:                 my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
  670:                 $preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
  671:             } elsif ($linkprot) {
  672:                 if ($linkprotuser) {
  673:                     my ($uname,$udom) = split(/:/,$linkprotuser,2);
  674:                     $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>';
  675:                 } else {
  676:                     my $relogin;
  677:                     my %data = (
  678:                                 origurl => $r->uri,
  679:                                 linkprot => $linkprot,
  680:                                 linkprotexit => $linkprotexit,
  681:                                 linkprotpbid => $linkprotpbid,
  682:                                 linkprotpburl => $linkprotpburl,
  683:                     );
  684:                     my $token =
  685:                         &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
  686:                     unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
  687:                             ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
  688:                             $relogin = '/adm/relaunch?rtoken='.$token;
  689:                     }
  690:                     $preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
  691:                                        &mt('You are currently logged in as: [_1] in domain: [_2]',
  692:                                            '<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
  693:                     if ($relogin) {
  694:                         $preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
  695:                     }
  696:                 }
  697:             }
  698:             if ($env{'form.ttoken'}) {
  699:                 &Apache::lonnet::tmpdel($env{'form.ttoken'});
  700:             }
  701:             if ($ltoken) {
  702:                 &Apache::lonnet::tmpdel($ltoken);
  703:             }
  704:         }
  705:     }
  706:     &Apache::loncommon::content_type($r,'text/html');
  707:     $r->send_http_header;
  708:     $r->print(&Apache::loncommon::start_page($title,$js,$args).
  709:               '<h3>'.$header.'</h3>'.
  710:               '<div>'.$preamble.'</div>'.
  711:               $datatable.
  712:               &Apache::loncommon::end_page());
  713:     return;
  714: }
  715: 
  716: sub generic_error {
  717:     my ($r) = @_;
  718:     my $continuelink;
  719:     unless ($env{'request.lti.login'}) {
  720:         my $linktext;
  721:         if ($env{'user.adv'}) {
  722:             $linktext = &mt('Continue to your roles page');
  723:         } else {
  724:             $linktext = &mt('Continue to your courses page');
  725:         }
  726:         $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
  727:     }
  728:     my $msg = &mt('The page you requested does not exist.');
  729:     &Apache::loncommon::content_type($r,'text/html');
  730:     $r->send_http_header;
  731:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
  732:     $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
  733:               '<div class="LC_error">'.$msg.'</div>'.
  734:               '<p>'.$continuelink.'</p>'.
  735:               &Apache::loncommon::end_page());
  736:     return;
  737: }
  738: 
  739: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>