Annotation of loncom/interface/lontiny.pm, revision 1.21

1.1       raeburn     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: #
1.21    ! raeburn     5: # $Id: lontiny.pm,v 1.20 2023/06/04 00:36:18 raeburn Exp $
1.1       raeburn     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;
1.5       raeburn    38: use Apache::lonuserstate;
                     39: use Apache::lonnavmaps;
1.1       raeburn    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);
1.6       raeburn    47:     if ($handle ne '') {
1.5       raeburn    48:         my $lonidsdir=$r->dir_config('lonIDsDir');
                     49:         &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
1.1       raeburn    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') {
1.8       raeburn    70:                             &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['ttoken']);
1.19      raeburn    71:                             my ($linkprot,$linkprotuser,$linkprotexit,$ltoken,$linkprotpbid,$linkprotpburl);
1.11      raeburn    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'};
1.12      raeburn    80:                                         $linkprotexit = $ltoken_info{'linkprotexit'};
1.19      raeburn    81:                                         $linkprotpbid = $ltoken_info{'linkprotpbid'};
1.20      raeburn    82:                                         $linkprotpburl = $ltoken_info{'linkprotpburl'};
1.11      raeburn    83:                                     } elsif ($link_info{'linkprot'}) {
                     84:                                         $linkprot = $link_info{'linkprot'};
                     85:                                         if ($link_info{'linkprotuser'}) {
                     86:                                             $linkprotuser = $link_info{'linkprotuser'};
                     87:                                         }
1.12      raeburn    88:                                         if ($link_info{'linkprotexit'}) {
                     89:                                             $linkprotexit = $link_info{'linkprotexit'};
                     90:                                         }
1.19      raeburn    91:                                         if ($link_info{'linkprotpbid'}) {
                     92:                                             $linkprotpbid = $link_info{'linkprotpbid'};
                     93:                                         }
                     94:                                         if ($link_info{'linkprotpburl'}) {
                     95:                                             $linkprotpburl = $link_info{'linkprotpburl'};
                     96:                                         }
1.11      raeburn    97:                                     }
                     98:                                 }
                     99:                             }
1.5       raeburn   100:                             if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
1.8       raeburn   101:                                 # Check for ttoken
                    102:                                 my $newlauncher = &launch_check($r->uri,$symb);
1.5       raeburn   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:                                     }
1.17      raeburn   129:                                     my ($update,$reinitresult);
1.5       raeburn   130:                                     # Check if course needs to be re-initialized
1.7       raeburn   131:                                     if ($newlauncher) {
1.5       raeburn   132:                                         $update = 1;
1.7       raeburn   133:                                     } else {
                    134:                                         my $loncaparev = $r->dir_config('lonVersion');
1.17      raeburn   135:                                         ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
                    136:                                         if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
1.7       raeburn   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:                                                     }
1.5       raeburn   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:                                     }
1.17      raeburn   166:                                     if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
                    167:                                         my $possdel;
                    168:                                         if ($reinitresult eq 'supp') {
                    169:                                             $possdel = 1;
                    170:                                         }
1.18      raeburn   171:                                         my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
1.17      raeburn   172:                                         unless ($refs_updated) {
                    173:                                             &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
                    174:                                         }
                    175:                                     }
1.5       raeburn   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';
1.1       raeburn   184:                                         }
1.5       raeburn   185:                                         my $location = $protocol.'://'.$host.$realuri;
                    186:                                         $r->headers_out->set(Location => $location);
                    187:                                         return REDIRECT;
1.1       raeburn   188:                                     }
                    189:                                 }
1.5       raeburn   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:                                 }
1.11      raeburn   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);
1.5       raeburn   203:                                 if (keys(%roleshash)) {
1.11      raeburn   204:                                     my $now = time;
1.5       raeburn   205:                                     foreach my $entry (keys(%roleshash)) {
                    206:                                         if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
1.11      raeburn   207:                                             my ($role,$sec) = ($1,$2);
                    208:                                             $possroles{$role} = $sec;
                    209:                                             if ($sec ne '') {
1.5       raeburn   210:                                                 $hassection = 1;
                    211:                                             }
1.11      raeburn   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:                                             }
1.5       raeburn   227:                                         }
1.4       raeburn   228:                                     }
                    229:                                 }
1.11      raeburn   230:                                 my @allposs = keys(%active);
1.5       raeburn   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'});
1.4       raeburn   237:                                         }
1.5       raeburn   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'.
1.11      raeburn   247:                                                                    '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.5       raeburn   248:                                                 if ($env{'form.ltitarget'} eq 'iframe') {
                    249:                                                     $destination .= '&ltitarget=iframe';
                    250:                                                 }
                    251:                                                 &do_redirect($r,$destination);
                    252:                                                 return OK;
1.4       raeburn   253:                                             }
                    254:                                         }
                    255:                                     }
                    256:                                 }
1.5       raeburn   257:                                 if (@allposs == 0) {
1.19      raeburn   258:                                     &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,
                    259:                                                 $linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken);
1.5       raeburn   260:                                 } elsif (@allposs == 1) {
                    261:                                     my $newrole = "$allposs[0]./$cdom/$cnum";
                    262:                                     $newrole = "$allposs[0]./$cdom/$cnum";
                    263:                                     if ($possroles{$allposs[0]} ne '') {
1.11      raeburn   264:                                         $newrole .= "/$possroles{$allposs[0]}";
1.1       raeburn   265:                                     }
                    266:                                     my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
1.11      raeburn   267:                                                        '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.8       raeburn   268:                                     if ($env{'form.ttoken'}) {
                    269:                                         $destination .= '&ttoken='.$env{'form.ttoken'};
                    270:                                     }
1.11      raeburn   271:                                     &do_redirect($r,$destination,$linkprot);
1.16      raeburn   272:                                 } elsif (@allposs > 1) {
1.5       raeburn   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'.
1.11      raeburn   282:                                                            '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.8       raeburn   283:                                         if ($env{'form.ttoken'}) {
                    284:                                             $destination .= '&ttoken='.$env{'form.ttoken'};
                    285:                                         }
1.11      raeburn   286:                                         &do_redirect($r,$destination,$linkprot);
1.5       raeburn   287:                                     } else {
                    288:                                         my $hascustom;
                    289:                                         if (grep(/^cr\//,@allposs)) {
                    290:                                             $hascustom = 1;
                    291:                                         }
1.16      raeburn   292:                                         &show_roles($r,\%crsenv,\%active,$hassection,$hascustom);
1.1       raeburn   293:                                     }
                    294:                                 }
1.5       raeburn   295:                                 return OK;
1.1       raeburn   296:                             }
                    297:                         }
                    298:                     }
                    299:                 }
                    300:             }
                    301:         }
                    302:         &generic_error($r);
                    303:         return OK;
                    304:     } else {
                    305:         return FORBIDDEN;
                    306:     }
                    307: }
                    308: 
1.7       raeburn   309: sub launch_check {
1.8       raeburn   310:     my ($linkuri,$symb) = @_;
1.21    ! raeburn   311:     my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,
        !           312:         $linkkey,$newlauncher,$prevlaunch);
1.8       raeburn   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'});
1.10      raeburn   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:             }
1.11      raeburn   326:             &Apache::lonnet::tmpdel($link_info{'ltoken'});
1.10      raeburn   327:         }
1.7       raeburn   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:             }
1.15      raeburn   350:             if ($link_info{'linkprotexit'}) {
                    351:                 $linkprotexit = $link_info{'linkprotexit'};
                    352:             }
1.19      raeburn   353:             if ($link_info{'linkprotpbid'}) {
                    354:                 $linkprotpbid = $link_info{'linkprotpbid'};
                    355:             }
                    356:             if ($link_info{'linkprotpburl'}) {
                    357:                 $linkprotpburl = $link_info{'linkprotpburl'};
                    358:             }
1.8       raeburn   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:             }
1.7       raeburn   380:         }
1.8       raeburn   381:         if ($link_info{'checklaunch'}) {
                    382:             $newlauncher = 1;
1.7       raeburn   383:         }
1.21    ! raeburn   384:         if ($link_info{'prevlaunch'} ne '') {
        !           385:             $prevlaunch = $link_info{'prevlaunch'};
        !           386:         }
1.8       raeburn   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');
1.7       raeburn   395:         }
1.8       raeburn   396:     } else {
                    397:         $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
1.7       raeburn   398:     }
1.8       raeburn   399:     if ($deeplink ne '') {
                    400:         my $disallow;
1.15      raeburn   401:         my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
1.8       raeburn   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;
1.7       raeburn   412:                 }
1.8       raeburn   413:             } elsif ($acctype eq 'key') {
                    414:                 if ($linkkey ne '') {
                    415:                     unless ($linkkey eq $item) {
                    416:                         $disallow = 1;
1.7       raeburn   417:                     }
1.8       raeburn   418:                 } else {
                    419:                     $disallow = 1;
1.7       raeburn   420:                 }
1.8       raeburn   421:             }
                    422:         }
                    423:         if ($disallow) {
                    424:             if ($currdeeplinklogin eq $linkuri) {
                    425:                 &Apache::lonnet::delenv('request.deeplink.login');
1.10      raeburn   426:                 if ($env{'request.deeplink.target'} ne '') {
                    427:                     &Apache::lonnet::delenv('request.deeplink.target');
                    428:                 }
1.15      raeburn   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:                 }
1.19      raeburn   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:                 }
1.8       raeburn   441:             }
                    442:         } else {
1.21    ! raeburn   443:             if (($currdeeplinklogin ne $linkuri) ||
        !           444:                 (($prevlaunch ne '') && ($currdeeplinklogin ne $prevlaunch))) {
1.8       raeburn   445:                 if (($linkprotector) || ($linkkey ne '')) {
                    446:                     if ($linkprotector) {
                    447:                         &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
                    448:                     } elsif ($env{'request.linkprot'}) {
1.14      raeburn   449:                         &Apache::lonnet::delenv('request.linkprot');
1.7       raeburn   450:                     }
1.15      raeburn   451:                     if ($linkprotexit) {
                    452:                         &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
                    453:                     } elsif ($env{'request.linkprotexit'}) {
                    454:                         &Apache::lonnet::delenv('request.linkprotexit');
                    455:                     }
1.19      raeburn   456:                     if ($linkprotpbid) {
                    457:                         &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
                    458:                     } elsif ($env{'request.linkprotpbid'}) {
                    459:                         &Apache::lonnet::delenv('request.linkprotpbid');
                    460:                     }
                    461:                     if ($linkprotpburl) {
                    462:                         &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
                    463:                     } elsif ($env{'request.linkprotpburl'}) {
                    464:                         &Apache::lonnet::delenv('request.linkprotpburl');
                    465:                     }
1.8       raeburn   466:                     if ($linkkey ne '') {
                    467:                         &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
                    468:                     } elsif ($env{'request.linkkey'} ne '') {
1.13      raeburn   469:                         &Apache::lonnet::delenv('request.linkkey');
1.7       raeburn   470:                     }
1.8       raeburn   471:                     $newlauncher = 1;
1.7       raeburn   472:                 }
                    473:             }
                    474:             &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
1.9       raeburn   475:             if ($target ne '') {
                    476:                 &Apache::lonnet::appenv({'request.deeplink.target' => $target});
1.10      raeburn   477:             } elsif ($env{'request.deeplink.target'} ne '') {
                    478:                 &Apache::lonnet::delenv('request.deeplink.target');
1.9       raeburn   479:             }
1.7       raeburn   480:         }
                    481:     } else {
                    482:         if ($linkprotector) {
                    483:             &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
1.8       raeburn   484:         } elsif ($env{'request.linkprot'}) {
1.14      raeburn   485:             &Apache::lonnet::delenv('request.linkprot');
1.8       raeburn   486:         }
1.15      raeburn   487:         if ($linkprotexit) {
                    488:             &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
                    489:         } elsif ($env{'request.linkprotexit'}) {
                    490:             &Apache::lonnet::delenv('request.linkprotexit');
                    491:         }
1.19      raeburn   492:         if ($linkprotpbid) {
                    493:             &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
                    494:         } elsif ($env{'request.linkprotpbid'}) {
                    495:             &Apache::lonnet::delenv('request.linkprotpbid');
                    496:         }
                    497:         if ($linkprotpburl) {
                    498:             &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
                    499:         } elsif ($env{'request.linkprotpburl'}) {
                    500:             &Apache::lonnet::delenv('request.linkprotpburl');
                    501:         }
1.8       raeburn   502:         if ($linkkey ne '') {
1.7       raeburn   503:             &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
1.8       raeburn   504:         } else {
1.13      raeburn   505:             &Apache::lonnet::delenv('request.linkkey');
1.7       raeburn   506:         }
1.8       raeburn   507:         &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
1.10      raeburn   508:         if ($env{'request.deeplink.target'} ne '') {
                    509:             &Apache::lonnet::delenv('request.deeplink.target');
                    510:         }
1.7       raeburn   511:     }
                    512:     return $newlauncher;
                    513: }
                    514: 
1.1       raeburn   515: sub do_redirect {
1.11      raeburn   516:     my ($r,$destination,$linkprot) = @_;
1.2       raeburn   517:     my $windowname = 'loncapaclient';
                    518:     if ($env{'request.lti.login'}) {
                    519:         $windowname .= 'lti';
                    520:     }
1.1       raeburn   521:     my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
                    522:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
1.11      raeburn   523:     if ($linkprot) {
                    524:         $args = {'only_body' => 1,
                    525:                  'redirect'  => [0,$destination],};
                    526:     }
1.1       raeburn   527:     &Apache::loncommon::content_type($r,'text/html');
                    528:     $r->send_http_header;
1.11      raeburn   529:     if ($linkprot) {
                    530:         $r->print(&Apache::loncommon::start_page('Valid link','',$args).
                    531:                   &Apache::loncommon::end_page());
                    532:     } else {
                    533:         $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
                    534:                   &Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
                    535:                   '<h1>'.&mt('Welcome').'</h1>'.
                    536:                   '<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>'.
                    537:                   '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
                    538:                   &Apache::loncommon::end_page());
                    539:     }
1.1       raeburn   540:     return;
                    541: }
                    542: 
                    543: sub show_roles {
1.19      raeburn   544:     my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
                    545:         $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
1.1       raeburn   546:     my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
                    547:     if (ref($crsenv) eq 'HASH') {
                    548:         $crsdesc = $crsenv->{'description'};
                    549:         $crstype = $crsenv->{'type'};
                    550:         $cdom = $crsenv->{'domain'};
                    551:         $cnum = $crsenv->{'num'};
                    552:     }
                    553:     if ($crstype eq '') {
                    554:         $crstype = 'Course';
                    555:     }
                    556:     my $lc_crstype = lc($crstype);
                    557:     if ($crsdesc ne '') {
                    558:         $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
                    559:                       '<i>'.$crsdesc.'</i>');
                    560:     }
                    561:     if (ref($possroles) eq 'HASH') {
                    562:         if (keys(%{$possroles}) > 0) {
                    563:             $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
1.11      raeburn   564:             if ($linkprot) {
                    565:                 $args = {'only_body' => 1};
                    566:             }
1.1       raeburn   567:             $title = 'Choose a role'; #Do not localize.
                    568:             if ($crstype eq 'Community') {
                    569:                 $preamble = &mt('You have the following active roles in this community:');
                    570:             } else { 
                    571:                 $preamble = &mt('You have the following active roles in this course:');
                    572:             }
                    573:             $datatable = '<form name="" action="/adm/roles">'.
1.8       raeburn   574:                          '<input type="hidden" name="newrole" value="" />'."\n".
                    575:                          '<input type="hidden" name="selectrole" value="1" />'."\n".
1.11      raeburn   576:                          '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
1.8       raeburn   577:             if ($env{'form.ttoken'}) {
                    578:                 $datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
                    579:             }
                    580:             $datatable .= &Apache::loncommon::start_data_table().
                    581:                           &Apache::loncommon::start_data_table_header_row().
                    582:                           '<th></th><th>'.&mt('User role').'</th>';
1.1       raeburn   583:             if ($hassection) {
                    584:                 $datatable .= '<th>'.&mt('Section').'</th>';
                    585:             }
                    586:             if ($hascustom) {
                    587:                 $datatable .= '<th>'.&mt('Information').'</th>';
                    588:             }
                    589:             $datatable .= &Apache::loncommon::end_data_table_header_row();
                    590:             my @available = sort(keys(%{$possroles}));
                    591:             foreach my $role ('ad','in','ta','ep','st','cr') {
                    592:                 foreach my $key (@available) {
                    593:                     if ($key =~ m{^$role($|/)}) {
                    594:                         my $trolecode = "$key./$cdom/$cnum";
                    595:                         my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
                    596:                         my $sec = $possroles->{$key};
                    597:                         if ($sec ne '') {
                    598:                             $trolecode .= '/'.$sec;
                    599:                         }
                    600:                         my $buttonname=$trolecode;
                    601:                         $buttonname=~s/\W//g;
                    602:                         $datatable .= &Apache::loncommon::start_data_table_row().
                    603:                                       '<td><input name="'.$buttonname.'" type="button" value="'.
                    604:                                       &mt('Select').'" onclick="javascript:enterrole(this.form,'.
                    605:                                       "'$trolecode','$buttonname'".');" /></td>';
                    606:                         if ($key =~ /^cr\//) {
                    607:                             my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
                    608:                             $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
                    609:                             if ($hassection) {
                    610:                                 $datatable .= '<td>'.$sec.'</td>';
                    611:                             }
                    612:                             $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
                    613:                                           &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
                    614:                                           '</td>';
                    615:                         } else {
                    616:                             if ($hassection) {
                    617:                                 $datatable .= '<td>'.$rolename.'</td>';
                    618:                                 if ($hascustom) {
                    619:                                     $datatable .= '<td colspan="2">'.$sec.'</td>';
                    620:                                 } else {
                    621:                                     $datatable .= '<td>'.$sec.'</td>';
                    622:                                 }
                    623:                             } elsif ($hascustom) {
                    624:                                 $datatable .= '<td colspan="2">'.$rolename.'</td>';
                    625:                             } else {
                    626:                                 $datatable .= '<td>'.$rolename.'</td>';
                    627:                             }
                    628:                         }
                    629:                         $datatable .= &Apache::loncommon::end_data_table_row();
                    630:                     }
                    631:                 }
                    632:             }
                    633:             $datatable .= &Apache::loncommon::end_data_table().
                    634:                           '</form>';
                    635:             my $standby = &mt('Role selected. Please stand by.');
                    636:             $js = <<"ENDJS";
                    637: <script type="text/javascript">
                    638: // <![CDATA[
                    639: 
                    640: active=true;
                    641: 
                    642: function enterrole (thisform,rolecode,buttonname) {
                    643:     if (active) {
                    644:         active=false;
                    645:         document.title='$standby';
                    646:         window.status='$standby';
                    647:         thisform.newrole.value=rolecode;
                    648:         thisform.submit();
                    649:     } else {
                    650:        alert('$standby');
                    651:     }
                    652: }
                    653: 
                    654: // ]]>
                    655: </script>
                    656: ENDJS
                    657:         } else {
1.11      raeburn   658:             if ($linkprot) {
                    659:                 $title = 'No access';
                    660:                 $preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
                    661:                 $args->{'only_body'} = 1;
                    662:             } else {
                    663:                 $title = 'No active role';
                    664:                 $preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
                    665:                 $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
                    666:             }
                    667:             $header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
                    668:                                                                                     $env{'user.domain'}).'</b>');
                    669:             if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
                    670:                 my @future = sort { $a <=> $b } (keys(%{$futureroles}));
                    671:                 $preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
                    672:                              ' '.&mt('Please try again then.').'</p>';
                    673:             } elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
                    674:                 my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
                    675:                 $preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
                    676:             } elsif ($linkprot) {
                    677:                 if ($linkprotuser) {
                    678:                     my ($uname,$udom) = split(/:/,$linkprotuser,2);
                    679:                     $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>';
                    680:                 } else {
                    681:                     my $relogin;
                    682:                     my %data = (
                    683:                                 origurl => $r->uri,
                    684:                                 linkprot => $linkprot,
1.12      raeburn   685:                                 linkprotexit => $linkprotexit,
1.19      raeburn   686:                                 linkprotpbid => $linkprotpbid,
                    687:                                 linkprotpburl => $linkprotpburl,
1.11      raeburn   688:                     );
                    689:                     my $token =
                    690:                         &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
                    691:                     unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
                    692:                             ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
                    693:                             $relogin = '/adm/relaunch?rtoken='.$token;
                    694:                     }
                    695:                     $preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
                    696:                                        &mt('You are currently logged in as: [_1] in domain: [_2]',
                    697:                                            '<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
                    698:                     if ($relogin) {
                    699:                         $preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
                    700:                     }
                    701:                 }
                    702:             }
                    703:             if ($env{'form.ttoken'}) {
                    704:                 &Apache::lonnet::tmpdel($env{'form.ttoken'});
                    705:             }
                    706:             if ($ltoken) {
                    707:                 &Apache::lonnet::tmpdel($ltoken);
                    708:             }
1.1       raeburn   709:         }
                    710:     }
                    711:     &Apache::loncommon::content_type($r,'text/html');
                    712:     $r->send_http_header;
                    713:     $r->print(&Apache::loncommon::start_page($title,$js,$args).
                    714:               '<h3>'.$header.'</h3>'.
                    715:               '<div>'.$preamble.'</div>'.
                    716:               $datatable.
                    717:               &Apache::loncommon::end_page());
                    718:     return;
                    719: }
                    720: 
                    721: sub generic_error {
                    722:     my ($r) = @_;
1.3       raeburn   723:     my $continuelink;
                    724:     unless ($env{'request.lti.login'}) {
                    725:         my $linktext;
                    726:         if ($env{'user.adv'}) {
                    727:             $linktext = &mt('Continue to your roles page');
                    728:         } else {
                    729:             $linktext = &mt('Continue to your courses page');
                    730:         }
                    731:         $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
1.1       raeburn   732:     }
                    733:     my $msg = &mt('The page you requested does not exist.');
                    734:     &Apache::loncommon::content_type($r,'text/html');
                    735:     $r->send_http_header;
                    736:     my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
                    737:     $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
                    738:               '<div class="LC_error">'.$msg.'</div>'.
                    739:               '<p>'.$continuelink.'</p>'.
                    740:               &Apache::loncommon::end_page());
                    741:     return;
                    742: }
                    743: 
                    744: 1;

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