File:  [LON-CAPA] / loncom / interface / lontiny.pm
Revision 1.24: download - view: text, annotated - select for diffs
Fri Feb 7 20:23:42 2025 UTC (13 days, 21 hours ago) by raeburn
Branches: MAIN
CVS tags: version_2_12_X, HEAD
- If user already has an active session on the current server and follows a
  deep-link to an item that is hidden in the current session, check for a
  course update if it has been more than 10 minutes since last check.

    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.24 2025/02/07 20:23:42 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,$cdom,$cnum);
  103:                                 my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
  104:                                 if (&Apache::lonnet::is_on_map($url)) {
  105:                                     my ($realuri,$reinitresult,$reinitchecked);
  106:                                     if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
  107:                                         (!$env{'request.role.adv'})) {
  108:                                         my $loncaparev = $r->dir_config('lonVersion');
  109:                                         ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
  110:                                         $reinitchecked = 1;
  111:                                         unless (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
  112:                                             $env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
  113:                                             return HTTP_NOT_ACCEPTABLE;
  114:                                         }
  115:                                     }
  116:                                     if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
  117:                                         (!$env{'request.role.adv'})) {
  118:                                         $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
  119:                                         if (($url =~ /\.sequence$/) &&
  120:                                             ($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
  121:                                             $realuri .= '?navmap=1';
  122:                                         } else {
  123:                                             $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
  124:                                         }
  125:                                     } else {
  126:                                         $realuri = &Apache::lonnet::clutter($url);
  127:                                         if (($url =~ /\.sequence$/) &&
  128:                                             ($env{'course.'.$env{'request.course.id'}.'.type'} ne 'Placement')) {
  129:                                             $realuri .= '?navmap=1';
  130:                                         } else {
  131:                                             $realuri .= '?symb='.$symb;
  132:                                         }
  133:                                     }
  134:                                     my $update;
  135:                                     # Check if course needs to be re-initialized
  136:                                     if ($newlauncher) {
  137:                                         $update = 1;
  138:                                     } elsif (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
  139:                                         $update = 1;
  140:                                     } else {
  141:                                         if (!$reinitchecked) {
  142:                                             my $loncaparev = $r->dir_config('lonVersion');
  143:                                             ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
  144:                                         }
  145:                                         if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
  146:                                             $update = 1;
  147:                                         } elsif (!-e $env{'request.course.fn'}.'.db') {
  148:                                             $update = 1;
  149:                                         } elsif (!$env{'request.role.adv'}) {
  150:                                             my $navmap = Apache::lonnavmaps::navmap->new();
  151:                                             if (ref($navmap)) {
  152:                                                 my $res = $navmap->getBySymb($symb);
  153:                                                 if (ref($res)) {
  154:                                                     my ($enc_in_bighash,$enc_in_parm);
  155:                                                     $enc_in_bighash = $res->encrypted();
  156:                                                     if (&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) {
  157:                                                         $enc_in_parm = 1;
  158:                                                     }
  159:                                                     if ($enc_in_bighash ne $enc_in_parm) {
  160:                                                         $update = 1;
  161:                                                     }
  162:                                                 }
  163:                                             }
  164:                                         }
  165:                                     }
  166:                                     if ($update) {
  167:                                         my ($furl,$ferr)=
  168:                                             &Apache::lonuserstate::readmap($cdom.'/'.$cnum);
  169:                                         if ($ferr) {
  170:                                             $env{'user.error.msg'}=$r->uri.':bre:0:0:Course not initialized';
  171:                                             $env{'user.reinit'} = 1;
  172:                                             return HTTP_NOT_ACCEPTABLE;
  173:                                         } elsif ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
  174:                                                  (!$env{'request.role.adv'})) {
  175:                                             $env{'user.error.msg'}=$r->uri.':bre:1:1:Access to resource denied';
  176:                                             return HTTP_NOT_ACCEPTABLE;
  177:                                         }
  178:                                     }
  179:                                     if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
  180:                                         my $possdel;
  181:                                         if ($reinitresult eq 'supp') {
  182:                                             $possdel = 1;
  183:                                         }
  184:                                         my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
  185:                                         unless ($refs_updated) {
  186:                                             &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
  187:                                         }
  188:                                     }
  189:                                     my $host = $r->headers_in->get('Host');
  190:                                     if (!$host) {
  191:                                         $r->internal_redirect($realuri);
  192:                                         return OK;
  193:                                     } else {
  194:                                         my $protocol = 'http';
  195:                                         if ($r->get_server_port == 443) {
  196:                                             $protocol = 'https';
  197:                                         }
  198:                                         my $location = $protocol.'://'.$host.$realuri;
  199:                                         $r->headers_out->set(Location => $location);
  200:                                         return REDIRECT;
  201:                                     }
  202:                                 }
  203:                             } else {
  204:                                 my %crsenv = &Apache::lonnet::coursedescription("$cdom/$cnum");
  205:                                 my @possroles = ('in','ta','ep','st','cr','ad');
  206:                                 if ($crsenv{'type'} eq 'Community') {
  207:                                     unshift(@possroles,'co');
  208:                                 } else {
  209:                                     unshift(@possroles,'cc');
  210:                                 }
  211:                                 my %roleshash =
  212:                                     &Apache::lonnet::get_my_roles($env{'user.uname'},$env{'user.domain'},
  213:                                                                   'userroles',['previous','active','future'],
  214:                                                                   \@possroles,[$cdom],1);
  215:                                 my (%possroles,$hassection,%active,%expired,%future);
  216:                                 if (keys(%roleshash)) {
  217:                                     my $now = time;
  218:                                     foreach my $entry (keys(%roleshash)) {
  219:                                         if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
  220:                                             my ($role,$sec) = ($1,$2);
  221:                                             $possroles{$role} = $sec;
  222:                                             if ($sec ne '') {
  223:                                                 $hassection = 1;
  224:                                             }
  225:                                             my ($tstart,$tend)=split(/\:/,$roleshash{$entry});
  226:                                             my $status = 'active';
  227:                                             if (($tend) && ($tend<=$now)) {
  228:                                                 $status = 'previous';
  229:                                             }
  230:                                             if (($tstart) && ($now<$tstart)) {
  231:                                                 $status = 'future';
  232:                                             }
  233:                                             if ($status eq 'active') {
  234:                                                 $active{$role} = $sec;
  235:                                             } elsif ($status eq 'previous') {
  236:                                                 $expired{$tend} = $role.':'.$sec;
  237:                                             } elsif ($status eq 'future') {
  238:                                                 $future{$tstart} = $role.':'.$sec;
  239:                                             }
  240:                                         }
  241:                                     }
  242:                                 }
  243:                                 my @allposs = keys(%active);
  244:                                 if ($env{'request.lti.login'}) {
  245:                                     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
  246:                                     if ($env{'request.lti.target'} eq '') {
  247:                                         if ($env{'form.ltitarget'} eq 'iframe') {
  248:                                             &Apache::lonnet::appenv({'request.lti.target' => 'iframe'});
  249:                                             delete($env{'form.ltitarget'});
  250:                                         }
  251:                                     }
  252:                                     if ($env{'form.selectrole'}) {
  253:                                         foreach my $role (@allposs) {
  254:                                             my $newrole = "$role./$cdom/$cnum";
  255:                                             if ($possroles{$allposs[0]} ne '') {
  256:                                                 $newrole .= "/$possroles{$role}";
  257:                                             }
  258:                                             if ($env{"form.$newrole"}) {
  259:                                                 my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  260:                                                                    '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
  261:                                                 if ($env{'form.ltitarget'} eq 'iframe') {
  262:                                                     $destination .= '&ltitarget=iframe';
  263:                                                 }
  264:                                                 &do_redirect($r,$destination);
  265:                                                 return OK;
  266:                                             }
  267:                                         }
  268:                                     }
  269:                                 }
  270:                                 if (@allposs == 0) {
  271:                                     &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,
  272:                                                 $linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken);
  273:                                 } elsif (@allposs == 1) {
  274:                                     my $newrole = "$allposs[0]./$cdom/$cnum";
  275:                                     $newrole = "$allposs[0]./$cdom/$cnum";
  276:                                     if ($possroles{$allposs[0]} ne '') {
  277:                                         $newrole .= "/$possroles{$allposs[0]}";
  278:                                     }
  279:                                     my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  280:                                                        '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
  281:                                     if ($env{'form.ttoken'}) {
  282:                                         $destination .= '&ttoken='.$env{'form.ttoken'};
  283:                                     }
  284:                                     &do_redirect($r,$destination,$linkprot);
  285:                                 } elsif (@allposs > 1) {
  286:                                     if (grep(/^(cc|co)$/,@allposs)) {
  287:                                         my $newrole;
  288:                                         if (exists($possroles{'cc'})) {
  289:                                             $newrole = 'cc';
  290:                                         } else {
  291:                                             $newrole = 'co';
  292:                                         }
  293:                                         $newrole .= "./$cdom/$cnum";
  294:                                         my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
  295:                                                            '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
  296:                                         if ($env{'form.ttoken'}) {
  297:                                             $destination .= '&ttoken='.$env{'form.ttoken'};
  298:                                         }
  299:                                         &do_redirect($r,$destination,$linkprot);
  300:                                     } else {
  301:                                         my $hascustom;
  302:                                         if (grep(/^cr\//,@allposs)) {
  303:                                             $hascustom = 1;
  304:                                         }
  305:                                         &show_roles($r,\%crsenv,\%active,$hassection,$hascustom);
  306:                                     }
  307:                                 }
  308:                                 return OK;
  309:                             }
  310:                         }
  311:                     }
  312:                 }
  313:             }
  314:         }
  315:         &generic_error($r);
  316:         return OK;
  317:     } else {
  318:         return FORBIDDEN;
  319:     }
  320: }
  321: 
  322: sub launch_check {
  323:     my ($linkuri,$symb,$cdom,$cnum) = @_;
  324:     my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,
  325:         $linkkey,$newlauncher,$prevlaunch);
  326:     if ($env{'form.ttoken'}) {
  327:         my %link_info = &Apache::lonnet::tmpget($env{'form.ttoken'});
  328:         &Apache::lonnet::tmpdel($env{'form.ttoken'});
  329:         delete($env{'form.ttoken'});
  330:         if ($link_info{'ltoken'}) {
  331:             unless (($link_info{'linkprot'}) || ($link_info{'linkkey'} ne '')) {
  332:                 my %ltoken_info = &Apache::lonnet::tmpget($link_info{'ltoken'});
  333:                 if ($ltoken_info{'linkprot'}) {
  334:                     $link_info{'linkprot'} = $ltoken_info{'linkprot'};
  335:                 } elsif ($ltoken_info{'linkkey'} ne '') {
  336:                     $link_info{'linkkey'} = $ltoken_info{'linkkey'};
  337:                 }
  338:             }
  339:             &Apache::lonnet::tmpdel($link_info{'ltoken'});
  340:         }
  341:         if ($link_info{'linkprot'}) {
  342:             ($linkprotector,$linkproturi) = split(/:/,$link_info{'linkprot'},2);
  343:             if ($env{'user.linkprotector'}) {
  344:                 my @protectors = split(/,/,$env{'user.linkprotector'});
  345:                 unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
  346:                     push(@protectors,$linkprotector);
  347:                     @protectors = sort { $a <=> $b } @protectors;
  348:                     &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
  349:                 }
  350:             } else {
  351:                 &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
  352:             }
  353:             if ($env{'user.linkproturi'}) {
  354:                 my @proturis = split(/,/,$env{'user.linkproturi'});
  355:                 unless(grep(/^\Q$linkproturi\E$/,@proturis)) {
  356:                     push(@proturis,$linkproturi);
  357:                     @proturis = sort(@proturis);
  358:                     &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
  359:                 }
  360:             } else {
  361:                 &Apache::lonnet::appenv({'user.linkproturi' => $linkproturi});
  362:             }
  363:             if ($link_info{'linkprotexit'}) {
  364:                 $linkprotexit = $link_info{'linkprotexit'};
  365:             }
  366:             if ($link_info{'linkprotpbid'}) {
  367:                 $linkprotpbid = $link_info{'linkprotpbid'};
  368:             }
  369:             if ($link_info{'linkprotpburl'}) {
  370:                 $linkprotpburl = $link_info{'linkprotpburl'};
  371:             }
  372:         } elsif ($link_info{'linkkey'} ne '') {
  373:             $linkkey = $link_info{'linkkey'};
  374:             my $keyedlinkuri = $linkuri;
  375:             if ($env{'user.deeplinkkey'} ne '') {
  376:                 my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
  377:                 unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
  378:                     push(@linkkeys,$linkkey);
  379:                     &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
  380:                 }
  381:             } else {
  382:                 &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
  383:             }
  384:             if ($env{'user.keyedlinkuri'}) {
  385:                 my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
  386:                 unless (grep(/^\Q$keyedlinkuri\E$/,@keyeduris)) {
  387:                     push(@keyeduris,$keyedlinkuri);
  388:                     &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
  389:                 }
  390:             } else {
  391:                 &Apache::lonnet::appenv({'user.keyedlinkuri' => $keyedlinkuri});
  392:             }
  393:         }
  394:         if ($link_info{'checklaunch'}) {
  395:             $newlauncher = 1;
  396:         }
  397:         if ($link_info{'prevlaunch'} ne '') {
  398:             $prevlaunch = $link_info{'prevlaunch'};
  399:         }
  400:     }
  401:     my $currdeeplinklogin = $env{'request.deeplink.login'};
  402:     my $deeplink;
  403:     if ($symb =~ /\.(page|sequence)$/) {
  404:         my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($symb))[2]);
  405:         my $navmap = Apache::lonnavmaps::navmap->new();
  406:         if (ref($navmap)) {
  407:             $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
  408:         }
  409:     } else {
  410:         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
  411:     }
  412:     if ($deeplink ne '') {
  413:         my $disallow;
  414:         my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
  415:         if (($protect ne 'none') && ($protect ne '')) {
  416:             my ($acctype,$item) = split(/:/,$protect);
  417:             if ($acctype =~ /lti(c|d)$/) {
  418:                 my $ltitype = $1;
  419:                 if ($linkprotector) {
  420:                     unless ($linkprotector.':'.$linkproturi eq $item.$ltitype.':'.$linkuri) {
  421:                         $disallow = 1;
  422:                     }
  423:                 } else {
  424:                     $disallow = 1;
  425:                 }
  426:             } elsif ($acctype eq 'key') {
  427:                 if ($linkkey ne '') {
  428:                     unless ($linkkey eq $item) {
  429:                         $disallow = 1;
  430:                     }
  431:                 } else {
  432:                     $disallow = 1;
  433:                 }
  434:             }
  435:         }
  436:         if ($disallow) {
  437:             if ($currdeeplinklogin eq $linkuri) {
  438:                 &Apache::lonnet::delenv('request.deeplink.login');
  439:                 if ($env{'request.deeplink.target'} ne '') {
  440:                     &Apache::lonnet::delenv('request.deeplink.target');
  441:                 }
  442:                 if ($env{'request.linkprot'} ne '') {
  443:                     &Apache::lonnet::delenv('request.linkprot');
  444:                 }
  445:                 if ($env{'request.linkprotexit'} ne '') {
  446:                     &Apache::lonnet::delenv('request.linkprotexit');
  447:                 }
  448:                 if ($env{'request.linkprotpbid'} ne '') {
  449:                     &Apache::lonnet::delenv('request.linkprotpbid');
  450:                 }
  451:                 if ($env{'request.linkprotpburl'} ne '') {
  452:                     &Apache::lonnet::delenv('request.linkprotpburl');
  453:                 }
  454:             }
  455:         } else {
  456:             unless ($currdeeplinklogin eq $linkuri) {
  457:                 if (($linkprotector) || ($linkkey ne '')) {
  458:                     $newlauncher = 1;
  459:                 }
  460:             }
  461:             if ($linkprotector) {
  462:                 &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
  463:                 if ($linkprotpburl && $linkprotpbid) {
  464:                     my ($res,$error) = &store_passback_info($cdom,$cnum,$linkuri,$linkprotector,
  465:                                                         $scope,$symb,$linkprotpbid,$linkprotpburl,
  466:                                                         $currdeeplinklogin);
  467:                 }
  468:             } elsif ($env{'request.linkprot'}) {
  469:                 &Apache::lonnet::delenv('request.linkprot');
  470:             }
  471:             if ($linkkey ne '') {
  472:                 &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
  473:             } elsif ($env{'request.linkkey'} ne '') {
  474:                 &Apache::lonnet::delenv('request.linkkey');
  475:             }
  476:             if (($linkprotector) || ($linkkey ne '')) {
  477:                 if ($linkprotexit ne $env{'request.linkprotexit'}) {
  478:                     if ($linkprotexit) {
  479:                         &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
  480:                     } elsif ($env{'request.linkprotexit'}) {
  481:                         &Apache::lonnet::delenv('request.linkprotexit');
  482:                     }
  483:                 }
  484:                 if ($linkprotpbid ne $env{'request.linkprotpbid'}) {
  485:                     if ($linkprotpbid) {
  486:                         &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
  487:                     } elsif ($env{'request.linkprotpbid'}) {
  488:                         &Apache::lonnet::delenv('request.linkprotpbid');
  489:                     }
  490:                 }
  491:                 if ($linkprotpburl ne $env{'request.linkprotpburl'}) {
  492:                     if ($linkprotpburl) {
  493:                         &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
  494:                     } elsif ($env{'request.linkprotpburl'}) {
  495:                         &Apache::lonnet::delenv('request.linkprotpburl');
  496:                     }
  497:                 }
  498:             } elsif ($prevlaunch) {
  499:                 foreach my $requestkey ('linkprotpbid','linkprotpburl','linkprotexit') {
  500:                     if ($env{"request.$requestkey"}) {
  501:                         &Apache::lonnet::delenv("request.$requestkey");
  502:                     }
  503:                 }
  504:             }
  505:             &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
  506:             if ($target ne '') {
  507:                 &Apache::lonnet::appenv({'request.deeplink.target' => $target});
  508:             } elsif ($env{'request.deeplink.target'} ne '') {
  509:                 &Apache::lonnet::delenv('request.deeplink.target');
  510:             }
  511:         }
  512:     } else {
  513:         if ($linkprotector) {
  514:             &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
  515:         } elsif ($env{'request.linkprot'}) {
  516:             &Apache::lonnet::delenv('request.linkprot');
  517:         }
  518:         if ($linkprotexit) {
  519:             &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
  520:         } elsif ($env{'request.linkprotexit'}) {
  521:             &Apache::lonnet::delenv('request.linkprotexit');
  522:         }
  523:         if ($linkprotpbid) {
  524:             &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
  525:         } elsif ($env{'request.linkprotpbid'}) {
  526:             &Apache::lonnet::delenv('request.linkprotpbid');
  527:         }
  528:         if ($linkprotpburl) {
  529:             &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
  530:         } elsif ($env{'request.linkprotpburl'}) {
  531:             &Apache::lonnet::delenv('request.linkprotpburl');
  532:         }
  533:         if ($linkkey ne '') {
  534:             &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
  535:         } else {
  536:             &Apache::lonnet::delenv('request.linkkey');
  537:         }
  538:         &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
  539:         if ($env{'request.deeplink.target'} ne '') {
  540:             &Apache::lonnet::delenv('request.deeplink.target');
  541:         }
  542:     }
  543:     return $newlauncher;
  544: }
  545: 
  546: #
  547: # Store linkprotpburl and linkprotpbid in user's nohist_$cid_linkprot_pb.db
  548: # $linkuri\0$linkprotector\0$scope = [$linkprotpbid,$linkprotpburl]
  549: # Separately store $symb in course's nohist_linkprot_passback.db
  550: # which should trigger passback:
  551: # $symb => {$linkuri\0$linkprotector\0$scope => 1};
  552: #
  553: 
  554: sub store_passback_info {
  555:     my ($cdom,$cnum,$linkuri,$linkprotector,$scope,$symb,
  556:         $linkprotpbid,$linkprotpburl,$currdeeplinklogin) = @_;
  557:     my $key = join("\0",($linkuri,$linkprotector,$scope));
  558:     my $namespace = 'nohist_'.$cdom.'_'.$cnum.'_linkprot_pb';
  559:     if ($linkuri eq $currdeeplinklogin) {
  560:         my %pbinfo = &Apache::lonnet::get($namespace,[$key]);
  561:         if (ref($pbinfo{$key}) eq 'ARRAY') {
  562:             if (($pbinfo{$key}[0] eq $linkprotpbid) &&
  563:                 ($pbinfo{$key}[1] eq $linkprotpburl)) {
  564:                 return ('ok');
  565:             }
  566:         }
  567:     }
  568:     my $now = time;
  569:     my $result = &Apache::lonnet::cput($namespace,{$key => [$linkprotpbid,$linkprotpburl]});
  570:     my $error;
  571:     if (($result eq 'ok') || ($result eq 'con_delayed')) {
  572:         $namespace = 'nohist_linkprot_passback';
  573:         my %triggers = &Apache::lonnet::get($namespace,[$symb],$cdom,$cnum);
  574:         my $newtrigger;
  575:         if ((exists($triggers{$symb})) && (ref($triggers{$symb}) eq 'HASH')) {
  576:             unless (exists($triggers{$symb}{$key})) {
  577:                 $newtrigger = 1;
  578:             }
  579:         } else {
  580:             $newtrigger = 1;
  581:         }
  582:         if ($newtrigger) {
  583:             my ($lockhash,$tries,$gotlock);
  584:             $lockhash = {
  585:                           lock => $env{'user.name'}.
  586:                                   ':'.$env{'user.domain'},
  587:                         };
  588:             $tries = 0;
  589:             $gotlock = &Apache::lonnet::newput($namespace,$lockhash,$cdom,$cnum);
  590:             while (($gotlock ne 'ok') && ($tries<10)) {
  591:                 $tries ++;
  592:                 sleep (0.1);
  593:                 $gotlock = &Apache::lonnet::newput($namespace,$lockhash,$cdom,$cnum);
  594:             }
  595:             if ($gotlock eq 'ok') {
  596:                 %triggers = &Apache::lonnet::get($namespace,[$symb],$cdom,$cnum);
  597:                 $triggers{$symb}{$key} = 1;
  598:                 $result = &Apache::lonnet::cput($namespace,{$symb => $triggers{$symb}},$cdom,$cnum);
  599:                 my $dellockoutcome = &Apache::lonnet::del($namespace,['lock'],$cdom,$cnum);
  600:             } else {
  601:                 $error = 'nolock';
  602:             }
  603:         }
  604:     }
  605:     return ($result,$error);
  606: }
  607: 
  608: sub do_redirect {
  609:     my ($r,$destination,$linkprot) = @_;
  610:     my $windowname = 'loncapaclient';
  611:     if ($env{'request.lti.login'}) {
  612:         $windowname .= 'lti';
  613:     }
  614:     my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
  615:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
  616:     if ($linkprot) {
  617:         $args = {'only_body' => 1,
  618:                  'redirect'  => [0,$destination],};
  619:     }
  620:     &Apache::loncommon::content_type($r,'text/html');
  621:     $r->send_http_header;
  622:     if ($linkprot) {
  623:         $r->print(&Apache::loncommon::start_page('Valid link','',$args).
  624:                   &Apache::loncommon::end_page());
  625:     } else {
  626:         $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
  627:                   &Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
  628:                   '<h1>'.&mt('Welcome').'</h1>'.
  629:                   '<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>'.
  630:                   '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
  631:                   &Apache::loncommon::end_page());
  632:     }
  633:     return;
  634: }
  635: 
  636: sub show_roles {
  637:     my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
  638:         $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
  639:     my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
  640:     if (ref($crsenv) eq 'HASH') {
  641:         $crsdesc = $crsenv->{'description'};
  642:         $crstype = $crsenv->{'type'};
  643:         $cdom = $crsenv->{'domain'};
  644:         $cnum = $crsenv->{'num'};
  645:     }
  646:     if ($crstype eq '') {
  647:         $crstype = 'Course';
  648:     }
  649:     my $lc_crstype = lc($crstype);
  650:     if ($crsdesc ne '') {
  651:         $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
  652:                       '<i>'.$crsdesc.'</i>');
  653:     }
  654:     if (ref($possroles) eq 'HASH') {
  655:         if (keys(%{$possroles}) > 0) {
  656:             $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
  657:             if ($linkprot) {
  658:                 $args = {'only_body' => 1};
  659:             }
  660:             $title = 'Choose a role'; #Do not localize.
  661:             if ($crstype eq 'Community') {
  662:                 $preamble = &mt('You have the following active roles in this community:');
  663:             } else { 
  664:                 $preamble = &mt('You have the following active roles in this course:');
  665:             }
  666:             $datatable = '<form name="" action="/adm/roles">'.
  667:                          '<input type="hidden" name="newrole" value="" />'."\n".
  668:                          '<input type="hidden" name="selectrole" value="1" />'."\n".
  669:                          '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
  670:             if ($env{'form.ttoken'}) {
  671:                 $datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
  672:             }
  673:             $datatable .= &Apache::loncommon::start_data_table().
  674:                           &Apache::loncommon::start_data_table_header_row().
  675:                           '<th></th><th>'.&mt('User role').'</th>';
  676:             if ($hassection) {
  677:                 $datatable .= '<th>'.&mt('Section').'</th>';
  678:             }
  679:             if ($hascustom) {
  680:                 $datatable .= '<th>'.&mt('Information').'</th>';
  681:             }
  682:             $datatable .= &Apache::loncommon::end_data_table_header_row();
  683:             my @available = sort(keys(%{$possroles}));
  684:             foreach my $role ('ad','in','ta','ep','st','cr') {
  685:                 foreach my $key (@available) {
  686:                     if ($key =~ m{^$role($|/)}) {
  687:                         my $trolecode = "$key./$cdom/$cnum";
  688:                         my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
  689:                         my $sec = $possroles->{$key};
  690:                         if ($sec ne '') {
  691:                             $trolecode .= '/'.$sec;
  692:                         }
  693:                         my $buttonname=$trolecode;
  694:                         $buttonname=~s/\W//g;
  695:                         $datatable .= &Apache::loncommon::start_data_table_row().
  696:                                       '<td><input name="'.$buttonname.'" type="button" value="'.
  697:                                       &mt('Select').'" onclick="javascript:enterrole(this.form,'.
  698:                                       "'$trolecode','$buttonname'".');" /></td>';
  699:                         if ($key =~ /^cr\//) {
  700:                             my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
  701:                             $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
  702:                             if ($hassection) {
  703:                                 $datatable .= '<td>'.$sec.'</td>';
  704:                             }
  705:                             $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
  706:                                           &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
  707:                                           '</td>';
  708:                         } else {
  709:                             if ($hassection) {
  710:                                 $datatable .= '<td>'.$rolename.'</td>';
  711:                                 if ($hascustom) {
  712:                                     $datatable .= '<td colspan="2">'.$sec.'</td>';
  713:                                 } else {
  714:                                     $datatable .= '<td>'.$sec.'</td>';
  715:                                 }
  716:                             } elsif ($hascustom) {
  717:                                 $datatable .= '<td colspan="2">'.$rolename.'</td>';
  718:                             } else {
  719:                                 $datatable .= '<td>'.$rolename.'</td>';
  720:                             }
  721:                         }
  722:                         $datatable .= &Apache::loncommon::end_data_table_row();
  723:                     }
  724:                 }
  725:             }
  726:             $datatable .= &Apache::loncommon::end_data_table().
  727:                           '</form>';
  728:             my $standby = &mt('Role selected. Please stand by.');
  729:             $js = <<"ENDJS";
  730: <script type="text/javascript">
  731: // <![CDATA[
  732: 
  733: active=true;
  734: 
  735: function enterrole (thisform,rolecode,buttonname) {
  736:     if (active) {
  737:         active=false;
  738:         document.title='$standby';
  739:         window.status='$standby';
  740:         thisform.newrole.value=rolecode;
  741:         thisform.submit();
  742:     } else {
  743:        alert('$standby');
  744:     }
  745: }
  746: 
  747: // ]]>
  748: </script>
  749: ENDJS
  750:         } else {
  751:             if ($linkprot) {
  752:                 $title = 'No access';
  753:                 $preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
  754:                 $args->{'only_body'} = 1;
  755:             } else {
  756:                 $title = 'No active role';
  757:                 $preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
  758:                 $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
  759:             }
  760:             $header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
  761:                                                                                     $env{'user.domain'}).'</b>');
  762:             if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
  763:                 my @future = sort { $a <=> $b } (keys(%{$futureroles}));
  764:                 $preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
  765:                              ' '.&mt('Please try again then.').'</p>';
  766:             } elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
  767:                 my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
  768:                 $preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
  769:             } elsif ($linkprot) {
  770:                 if ($linkprotuser) {
  771:                     my ($uname,$udom) = split(/:/,$linkprotuser,2);
  772:                     $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>';
  773:                 } else {
  774:                     my $relogin;
  775:                     my %data = (
  776:                                 origurl => $r->uri,
  777:                                 linkprot => $linkprot,
  778:                                 linkprotexit => $linkprotexit,
  779:                                 linkprotpbid => $linkprotpbid,
  780:                                 linkprotpburl => $linkprotpburl,
  781:                     );
  782:                     my $token =
  783:                         &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
  784:                     unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
  785:                             ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
  786:                             $relogin = '/adm/relaunch?rtoken='.$token;
  787:                     }
  788:                     $preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
  789:                                        &mt('You are currently logged in as: [_1] in domain: [_2]',
  790:                                            '<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
  791:                     if ($relogin) {
  792:                         $preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
  793:                     }
  794:                 }
  795:             }
  796:             if ($env{'form.ttoken'}) {
  797:                 &Apache::lonnet::tmpdel($env{'form.ttoken'});
  798:             }
  799:             if ($ltoken) {
  800:                 &Apache::lonnet::tmpdel($ltoken);
  801:             }
  802:         }
  803:     }
  804:     &Apache::loncommon::content_type($r,'text/html');
  805:     $r->send_http_header;
  806:     $r->print(&Apache::loncommon::start_page($title,$js,$args).
  807:               '<h3>'.$header.'</h3>'.
  808:               '<div>'.$preamble.'</div>'.
  809:               $datatable.
  810:               &Apache::loncommon::end_page());
  811:     return;
  812: }
  813: 
  814: sub generic_error {
  815:     my ($r) = @_;
  816:     my $continuelink;
  817:     unless ($env{'request.lti.login'}) {
  818:         my $linktext;
  819:         if ($env{'user.adv'}) {
  820:             $linktext = &mt('Continue to your roles page');
  821:         } else {
  822:             $linktext = &mt('Continue to your courses page');
  823:         }
  824:         $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
  825:     }
  826:     my $msg = &mt('The page you requested does not exist.');
  827:     &Apache::loncommon::content_type($r,'text/html');
  828:     $r->send_http_header;
  829:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
  830:     $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
  831:               '<div class="LC_error">'.$msg.'</div>'.
  832:               '<p>'.$continuelink.'</p>'.
  833:               &Apache::loncommon::end_page());
  834:     return;
  835: }
  836: 
  837: 1;

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