File:  [LON-CAPA] / loncom / interface / lontiny.pm
Revision 1.22: download - view: text, annotated - select for diffs
Sat Feb 10 14:12:32 2024 UTC (3 months, 1 week ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- Bug 6907.
  Update values for request.linkprotexit, request.linkprotpbid, and
  request.linkprotpburl in %env if deep-link is followed and launch URL
  unchanged but their values changed (e.g., different Consumer deep-link).

    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.22 2024/02/10 14:12:32 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,
  312:         $linkkey,$newlauncher,$prevlaunch);
  313:     if ($env{'form.ttoken'}) {
  314:         my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
  315:         &Apache::lonnet::tmpdel($env{'form.ttoken'});
  316:         delete($env{'form.ttoken'});
  317:         if ($link_info{'ltoken'}) {
  318:             unless (($link_info{'linkprot'}) || ($link_info{'linkkey'} ne '')) {
  319:                 my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
  320:                 if ($ltoken_info{'linkprot'}) {
  321:                     $link_info{'linkprot'} = $ltoken_info{'linkprot'};
  322:                 } elsif ($ltoken_info{'linkkey'} ne '') {
  323:                     $link_info{'linkkey'} = $ltoken_info{'linkkey'};
  324:                 }
  325:             }
  326:             &Apache::lonnet::tmpdel($link_info{'ltoken'});
  327:         }
  328:         if ($link_info{'linkprot'}) {
  329:             ($linkprotector,$linkproturi) = split(/:/,$link_info{'linkprot'},2);
  330:             if ($env{'user.linkprotector'}) {
  331:                 my @protectors = split(/,/,$env{'user.linkprotector'});
  332:                 unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
  333:                     push(@protectors,$linkprotector);
  334:                     @protectors = sort { $a <=> $b } @protectors;
  335:                     &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
  336:                 }
  337:             } else {
  338:                 &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
  339:             }
  340:             if ($env{'user.linkproturi'}) {
  341:                 my @proturis = split(/,/,$env{'user.linkproturi'});
  342:                 unless(grep(/^\Q$linkproturi\E$/,@proturis)) {
  343:                     push(@proturis,$linkproturi);
  344:                     @proturis = sort(@proturis);
  345:                     &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
  346:                 }
  347:             } else {
  348:                 &Apache::lonnet::appenv({'user.linkproturi' => $linkproturi});
  349:             }
  350:             if ($link_info{'linkprotexit'}) {
  351:                 $linkprotexit = $link_info{'linkprotexit'};
  352:             }
  353:             if ($link_info{'linkprotpbid'}) {
  354:                 $linkprotpbid = $link_info{'linkprotpbid'};
  355:             }
  356:             if ($link_info{'linkprotpburl'}) {
  357:                 $linkprotpburl = $link_info{'linkprotpburl'};
  358:             }
  359:         } elsif ($link_info{'linkkey'} ne '') {
  360:             $linkkey = $link_info{'linkkey'};
  361:             my $keyedlinkuri = $linkuri;
  362:             if ($env{'user.deeplinkkey'} ne '') {
  363:                 my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
  364:                 unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
  365:                     push(@linkkeys,$linkkey);
  366:                     &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
  367:                 }
  368:             } else {
  369:                 &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
  370:             }
  371:             if ($env{'user.keyedlinkuri'}) {
  372:                 my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
  373:                 unless (grep(/^\Q$keyedlinkuri\E$/,@keyeduris)) {
  374:                     push(@keyeduris,$keyedlinkuri);
  375:                     &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
  376:                 }
  377:             } else {
  378:                 &Apache::lonnet::appenv({'user.keyedlinkuri' => $keyedlinkuri});
  379:             }
  380:         }
  381:         if ($link_info{'checklaunch'}) {
  382:             $newlauncher = 1;
  383:         }
  384:         if ($link_info{'prevlaunch'} ne '') {
  385:             $prevlaunch = $link_info{'prevlaunch'};
  386:         }
  387:     }
  388:     my $currdeeplinklogin = $env{'request.deeplink.login'};
  389:     my $deeplink;
  390:     if ($symb =~ /\.(page|sequence)$/) {
  391:         my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
  392:         my $navmap = Apache::lonnavmaps::navmap->new();
  393:         if (ref($navmap)) {
  394:             $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
  395:         }
  396:     } else {
  397:         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
  398:     }
  399:     if ($deeplink ne '') {
  400:         my $disallow;
  401:         my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
  402:         if (($protect ne 'none') && ($protect ne '')) {
  403:             my ($acctype,$item) = split(/:/,$protect);
  404:             if ($acctype =~ /lti(c|d)$/) {
  405:                 my $ltitype = $1;
  406:                 if ($linkprotector) {
  407:                     unless ($linkprotector.':'.$linkproturi eq $item.$ltitype.':'.$linkuri) {
  408:                         $disallow = 1;
  409:                     }
  410:                 } else {
  411:                     $disallow = 1;
  412:                 }
  413:             } elsif ($acctype eq 'key') {
  414:                 if ($linkkey ne '') {
  415:                     unless ($linkkey eq $item) {
  416:                         $disallow = 1;
  417:                     }
  418:                 } else {
  419:                     $disallow = 1;
  420:                 }
  421:             }
  422:         }
  423:         if ($disallow) {
  424:             if ($currdeeplinklogin eq $linkuri) {
  425:                 &Apache::lonnet::delenv('request.deeplink.login');
  426:                 if ($env{'request.deeplink.target'} ne '') {
  427:                     &Apache::lonnet::delenv('request.deeplink.target');
  428:                 }
  429:                 if ($env{'request.linkprot'} ne '') {
  430:                     &Apache::lonnet::delenv('request.linkprot');
  431:                 }
  432:                 if ($env{'request.linkprotexit'} ne '') {
  433:                     &Apache::lonnet::delenv('request.linkprotexit');
  434:                 }
  435:                 if ($env{'request.linkprotpbid'} ne '') {
  436:                     &Apache::lonnet::delenv('request.linkprotpbid');
  437:                 }
  438:                 if ($env{'request.linkprotpburl'} ne '') {
  439:                     &Apache::lonnet::delenv('request.linkprotpburl');
  440:                 }
  441:             }
  442:         } else {
  443:             unless ($currdeeplinklogin eq $linkuri) {
  444:                 if (($linkprotector) || ($linkkey ne '')) {
  445:                     $newlauncher = 1;
  446:                 }
  447:             }
  448:             if ($linkprotector) {
  449:                 &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
  450:             } elsif ($env{'request.linkprot'}) {
  451:                 &Apache::lonnet::delenv('request.linkprot');
  452:             }
  453:             if ($linkkey ne '') {
  454:                 &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
  455:             } elsif ($env{'request.linkkey'} ne '') {
  456:                 &Apache::lonnet::delenv('request.linkkey');
  457:             }
  458:             if (($linkprotector) || ($linkkey ne '')) {
  459:                 if ($linkprotexit ne $env{'request.linkprotexit'}) {
  460:                     if ($linkprotexit) {
  461:                         &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
  462:                     } elsif ($env{'request.linkprotexit'}) {
  463:                         &Apache::lonnet::delenv('request.linkprotexit');
  464:                     }
  465:                 }
  466:                 if ($linkprotpbid ne $env{'request.linkprotpbid'}) {
  467:                     if ($linkprotpbid) {
  468:                         &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
  469:                     } elsif ($env{'request.linkprotpbid'}) {
  470:                         &Apache::lonnet::delenv('request.linkprotpbid');
  471:                     }
  472:                 }
  473:                 if ($linkprotpburl ne $env{'request.linkprotpburl'}) {
  474:                     if ($linkprotpburl) {
  475:                         &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
  476:                     } elsif ($env{'request.linkprotpburl'}) {
  477:                         &Apache::lonnet::delenv('request.linkprotpburl');
  478:                     }
  479:                 }
  480:             } elsif ($prevlaunch) {
  481:                 foreach my $requestkey ('linkprotpbid','linkprotpburl','linkprotexit') {
  482:                     if ($env{"request.$requestkey"}) {
  483:                         &Apache::lonnet::delenv("request.$requestkey");
  484:                     }
  485:                 }
  486:             }
  487:             &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
  488:             if ($target ne '') {
  489:                 &Apache::lonnet::appenv({'request.deeplink.target' => $target});
  490:             } elsif ($env{'request.deeplink.target'} ne '') {
  491:                 &Apache::lonnet::delenv('request.deeplink.target');
  492:             }
  493:         }
  494:     } else {
  495:         if ($linkprotector) {
  496:             &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
  497:         } elsif ($env{'request.linkprot'}) {
  498:             &Apache::lonnet::delenv('request.linkprot');
  499:         }
  500:         if ($linkprotexit) {
  501:             &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
  502:         } elsif ($env{'request.linkprotexit'}) {
  503:             &Apache::lonnet::delenv('request.linkprotexit');
  504:         }
  505:         if ($linkprotpbid) {
  506:             &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
  507:         } elsif ($env{'request.linkprotpbid'}) {
  508:             &Apache::lonnet::delenv('request.linkprotpbid');
  509:         }
  510:         if ($linkprotpburl) {
  511:             &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
  512:         } elsif ($env{'request.linkprotpburl'}) {
  513:             &Apache::lonnet::delenv('request.linkprotpburl');
  514:         }
  515:         if ($linkkey ne '') {
  516:             &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
  517:         } else {
  518:             &Apache::lonnet::delenv('request.linkkey');
  519:         }
  520:         &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
  521:         if ($env{'request.deeplink.target'} ne '') {
  522:             &Apache::lonnet::delenv('request.deeplink.target');
  523:         }
  524:     }
  525:     return $newlauncher;
  526: }
  527: 
  528: sub do_redirect {
  529:     my ($r,$destination,$linkprot) = @_;
  530:     my $windowname = 'loncapaclient';
  531:     if ($env{'request.lti.login'}) {
  532:         $windowname .= 'lti';
  533:     }
  534:     my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
  535:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
  536:     if ($linkprot) {
  537:         $args = {'only_body' => 1,
  538:                  'redirect'  => [0,$destination],};
  539:     }
  540:     &Apache::loncommon::content_type($r,'text/html');
  541:     $r->send_http_header;
  542:     if ($linkprot) {
  543:         $r->print(&Apache::loncommon::start_page('Valid link','',$args).
  544:                   &Apache::loncommon::end_page());
  545:     } else {
  546:         $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
  547:                   &Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
  548:                   '<h1>'.&mt('Welcome').'</h1>'.
  549:                   '<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>'.
  550:                   '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
  551:                   &Apache::loncommon::end_page());
  552:     }
  553:     return;
  554: }
  555: 
  556: sub show_roles {
  557:     my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
  558:         $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
  559:     my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
  560:     if (ref($crsenv) eq 'HASH') {
  561:         $crsdesc = $crsenv->{'description'};
  562:         $crstype = $crsenv->{'type'};
  563:         $cdom = $crsenv->{'domain'};
  564:         $cnum = $crsenv->{'num'};
  565:     }
  566:     if ($crstype eq '') {
  567:         $crstype = 'Course';
  568:     }
  569:     my $lc_crstype = lc($crstype);
  570:     if ($crsdesc ne '') {
  571:         $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
  572:                       '<i>'.$crsdesc.'</i>');
  573:     }
  574:     if (ref($possroles) eq 'HASH') {
  575:         if (keys(%{$possroles}) > 0) {
  576:             $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
  577:             if ($linkprot) {
  578:                 $args = {'only_body' => 1};
  579:             }
  580:             $title = 'Choose a role'; #Do not localize.
  581:             if ($crstype eq 'Community') {
  582:                 $preamble = &mt('You have the following active roles in this community:');
  583:             } else { 
  584:                 $preamble = &mt('You have the following active roles in this course:');
  585:             }
  586:             $datatable = '<form name="" action="/adm/roles">'.
  587:                          '<input type="hidden" name="newrole" value="" />'."\n".
  588:                          '<input type="hidden" name="selectrole" value="1" />'."\n".
  589:                          '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
  590:             if ($env{'form.ttoken'}) {
  591:                 $datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
  592:             }
  593:             $datatable .= &Apache::loncommon::start_data_table().
  594:                           &Apache::loncommon::start_data_table_header_row().
  595:                           '<th></th><th>'.&mt('User role').'</th>';
  596:             if ($hassection) {
  597:                 $datatable .= '<th>'.&mt('Section').'</th>';
  598:             }
  599:             if ($hascustom) {
  600:                 $datatable .= '<th>'.&mt('Information').'</th>';
  601:             }
  602:             $datatable .= &Apache::loncommon::end_data_table_header_row();
  603:             my @available = sort(keys(%{$possroles}));
  604:             foreach my $role ('ad','in','ta','ep','st','cr') {
  605:                 foreach my $key (@available) {
  606:                     if ($key =~ m{^$role($|/)}) {
  607:                         my $trolecode = "$key./$cdom/$cnum";
  608:                         my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
  609:                         my $sec = $possroles->{$key};
  610:                         if ($sec ne '') {
  611:                             $trolecode .= '/'.$sec;
  612:                         }
  613:                         my $buttonname=$trolecode;
  614:                         $buttonname=~s/\W//g;
  615:                         $datatable .= &Apache::loncommon::start_data_table_row().
  616:                                       '<td><input name="'.$buttonname.'" type="button" value="'.
  617:                                       &mt('Select').'" onclick="javascript:enterrole(this.form,'.
  618:                                       "'$trolecode','$buttonname'".');" /></td>';
  619:                         if ($key =~ /^cr\//) {
  620:                             my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
  621:                             $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
  622:                             if ($hassection) {
  623:                                 $datatable .= '<td>'.$sec.'</td>';
  624:                             }
  625:                             $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
  626:                                           &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
  627:                                           '</td>';
  628:                         } else {
  629:                             if ($hassection) {
  630:                                 $datatable .= '<td>'.$rolename.'</td>';
  631:                                 if ($hascustom) {
  632:                                     $datatable .= '<td colspan="2">'.$sec.'</td>';
  633:                                 } else {
  634:                                     $datatable .= '<td>'.$sec.'</td>';
  635:                                 }
  636:                             } elsif ($hascustom) {
  637:                                 $datatable .= '<td colspan="2">'.$rolename.'</td>';
  638:                             } else {
  639:                                 $datatable .= '<td>'.$rolename.'</td>';
  640:                             }
  641:                         }
  642:                         $datatable .= &Apache::loncommon::end_data_table_row();
  643:                     }
  644:                 }
  645:             }
  646:             $datatable .= &Apache::loncommon::end_data_table().
  647:                           '</form>';
  648:             my $standby = &mt('Role selected. Please stand by.');
  649:             $js = <<"ENDJS";
  650: <script type="text/javascript">
  651: // <![CDATA[
  652: 
  653: active=true;
  654: 
  655: function enterrole (thisform,rolecode,buttonname) {
  656:     if (active) {
  657:         active=false;
  658:         document.title='$standby';
  659:         window.status='$standby';
  660:         thisform.newrole.value=rolecode;
  661:         thisform.submit();
  662:     } else {
  663:        alert('$standby');
  664:     }
  665: }
  666: 
  667: // ]]>
  668: </script>
  669: ENDJS
  670:         } else {
  671:             if ($linkprot) {
  672:                 $title = 'No access';
  673:                 $preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
  674:                 $args->{'only_body'} = 1;
  675:             } else {
  676:                 $title = 'No active role';
  677:                 $preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
  678:                 $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
  679:             }
  680:             $header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
  681:                                                                                     $env{'user.domain'}).'</b>');
  682:             if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
  683:                 my @future = sort { $a <=> $b } (keys(%{$futureroles}));
  684:                 $preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
  685:                              ' '.&mt('Please try again then.').'</p>';
  686:             } elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
  687:                 my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
  688:                 $preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
  689:             } elsif ($linkprot) {
  690:                 if ($linkprotuser) {
  691:                     my ($uname,$udom) = split(/:/,$linkprotuser,2);
  692:                     $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>';
  693:                 } else {
  694:                     my $relogin;
  695:                     my %data = (
  696:                                 origurl => $r->uri,
  697:                                 linkprot => $linkprot,
  698:                                 linkprotexit => $linkprotexit,
  699:                                 linkprotpbid => $linkprotpbid,
  700:                                 linkprotpburl => $linkprotpburl,
  701:                     );
  702:                     my $token =
  703:                         &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
  704:                     unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
  705:                             ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
  706:                             $relogin = '/adm/relaunch?rtoken='.$token;
  707:                     }
  708:                     $preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
  709:                                        &mt('You are currently logged in as: [_1] in domain: [_2]',
  710:                                            '<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
  711:                     if ($relogin) {
  712:                         $preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
  713:                     }
  714:                 }
  715:             }
  716:             if ($env{'form.ttoken'}) {
  717:                 &Apache::lonnet::tmpdel($env{'form.ttoken'});
  718:             }
  719:             if ($ltoken) {
  720:                 &Apache::lonnet::tmpdel($ltoken);
  721:             }
  722:         }
  723:     }
  724:     &Apache::loncommon::content_type($r,'text/html');
  725:     $r->send_http_header;
  726:     $r->print(&Apache::loncommon::start_page($title,$js,$args).
  727:               '<h3>'.$header.'</h3>'.
  728:               '<div>'.$preamble.'</div>'.
  729:               $datatable.
  730:               &Apache::loncommon::end_page());
  731:     return;
  732: }
  733: 
  734: sub generic_error {
  735:     my ($r) = @_;
  736:     my $continuelink;
  737:     unless ($env{'request.lti.login'}) {
  738:         my $linktext;
  739:         if ($env{'user.adv'}) {
  740:             $linktext = &mt('Continue to your roles page');
  741:         } else {
  742:             $linktext = &mt('Continue to your courses page');
  743:         }
  744:         $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
  745:     }
  746:     my $msg = &mt('The page you requested does not exist.');
  747:     &Apache::loncommon::content_type($r,'text/html');
  748:     $r->send_http_header;
  749:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
  750:     $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
  751:               '<div class="LC_error">'.$msg.'</div>'.
  752:               '<p>'.$continuelink.'</p>'.
  753:               &Apache::loncommon::end_page());
  754:     return;
  755: }
  756: 
  757: 1;

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