Annotation of loncom/interface/lontiny.pm, revision 1.24
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.24 ! raeburn 5: # $Id: lontiny.pm,v 1.23 2024/11/17 04:48:15 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
1.23 raeburn 102: my $newlauncher = &launch_check($r->uri,$symb,$cdom,$cnum);
1.5 raeburn 103: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
104: if (&Apache::lonnet::is_on_map($url)) {
1.24 ! raeburn 105: my ($realuri,$reinitresult,$reinitchecked);
1.5 raeburn 106: if ((&Apache::lonnet::EXT('resource.0.hiddenresource',$symb) =~ /^yes$/i) &&
107: (!$env{'request.role.adv'})) {
1.24 ! raeburn 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: }
1.5 raeburn 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: }
1.24 ! raeburn 134: my $update;
1.5 raeburn 135: # Check if course needs to be re-initialized
1.7 raeburn 136: if ($newlauncher) {
1.5 raeburn 137: $update = 1;
1.24 ! raeburn 138: } elsif (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
! 139: $update = 1;
1.7 raeburn 140: } else {
1.24 ! raeburn 141: if (!$reinitchecked) {
! 142: my $loncaparev = $r->dir_config('lonVersion');
! 143: ($reinitresult,my @reinit) = &Apache::loncommon::needs_coursereinit($loncaparev);
! 144: }
1.17 raeburn 145: if (($reinitresult eq 'main') || ($reinitresult eq 'both')) {
1.7 raeburn 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: }
1.5 raeburn 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;
1.24 ! raeburn 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;
1.5 raeburn 177: }
178: }
1.17 raeburn 179: if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
180: my $possdel;
181: if ($reinitresult eq 'supp') {
182: $possdel = 1;
183: }
1.18 raeburn 184: my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
1.17 raeburn 185: unless ($refs_updated) {
186: &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
187: }
188: }
1.5 raeburn 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';
1.1 raeburn 197: }
1.5 raeburn 198: my $location = $protocol.'://'.$host.$realuri;
199: $r->headers_out->set(Location => $location);
200: return REDIRECT;
1.1 raeburn 201: }
202: }
1.5 raeburn 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: }
1.11 raeburn 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);
1.5 raeburn 216: if (keys(%roleshash)) {
1.11 raeburn 217: my $now = time;
1.5 raeburn 218: foreach my $entry (keys(%roleshash)) {
219: if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
1.11 raeburn 220: my ($role,$sec) = ($1,$2);
221: $possroles{$role} = $sec;
222: if ($sec ne '') {
1.5 raeburn 223: $hassection = 1;
224: }
1.11 raeburn 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: }
1.5 raeburn 240: }
1.4 raeburn 241: }
242: }
1.11 raeburn 243: my @allposs = keys(%active);
1.5 raeburn 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'});
1.4 raeburn 250: }
1.5 raeburn 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'.
1.11 raeburn 260: '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.5 raeburn 261: if ($env{'form.ltitarget'} eq 'iframe') {
262: $destination .= '<itarget=iframe';
263: }
264: &do_redirect($r,$destination);
265: return OK;
1.4 raeburn 266: }
267: }
268: }
269: }
1.5 raeburn 270: if (@allposs == 0) {
1.19 raeburn 271: &show_roles($r,\%crsenv,\%active,'','',\%future,\%expired,$linkprot,$linkprotuser,
272: $linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken);
1.5 raeburn 273: } elsif (@allposs == 1) {
274: my $newrole = "$allposs[0]./$cdom/$cnum";
275: $newrole = "$allposs[0]./$cdom/$cnum";
276: if ($possroles{$allposs[0]} ne '') {
1.11 raeburn 277: $newrole .= "/$possroles{$allposs[0]}";
1.1 raeburn 278: }
279: my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
1.11 raeburn 280: '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.8 raeburn 281: if ($env{'form.ttoken'}) {
282: $destination .= '&ttoken='.$env{'form.ttoken'};
283: }
1.11 raeburn 284: &do_redirect($r,$destination,$linkprot);
1.16 raeburn 285: } elsif (@allposs > 1) {
1.5 raeburn 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'.
1.11 raeburn 295: '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.8 raeburn 296: if ($env{'form.ttoken'}) {
297: $destination .= '&ttoken='.$env{'form.ttoken'};
298: }
1.11 raeburn 299: &do_redirect($r,$destination,$linkprot);
1.5 raeburn 300: } else {
301: my $hascustom;
302: if (grep(/^cr\//,@allposs)) {
303: $hascustom = 1;
304: }
1.16 raeburn 305: &show_roles($r,\%crsenv,\%active,$hassection,$hascustom);
1.1 raeburn 306: }
307: }
1.5 raeburn 308: return OK;
1.1 raeburn 309: }
310: }
311: }
312: }
313: }
314: }
315: &generic_error($r);
316: return OK;
317: } else {
318: return FORBIDDEN;
319: }
320: }
321:
1.7 raeburn 322: sub launch_check {
1.23 raeburn 323: my ($linkuri,$symb,$cdom,$cnum) = @_;
1.21 raeburn 324: my ($linkprotector,$linkproturi,$linkprotexit,$linkprotpbid,$linkprotpburl,
325: $linkkey,$newlauncher,$prevlaunch);
1.8 raeburn 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'});
1.10 raeburn 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: }
1.11 raeburn 339: &Apache::lonnet::tmpdel($link_info{'ltoken'});
1.10 raeburn 340: }
1.7 raeburn 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: }
1.15 raeburn 363: if ($link_info{'linkprotexit'}) {
364: $linkprotexit = $link_info{'linkprotexit'};
365: }
1.19 raeburn 366: if ($link_info{'linkprotpbid'}) {
367: $linkprotpbid = $link_info{'linkprotpbid'};
368: }
369: if ($link_info{'linkprotpburl'}) {
370: $linkprotpburl = $link_info{'linkprotpburl'};
371: }
1.8 raeburn 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: }
1.7 raeburn 393: }
1.8 raeburn 394: if ($link_info{'checklaunch'}) {
395: $newlauncher = 1;
1.7 raeburn 396: }
1.21 raeburn 397: if ($link_info{'prevlaunch'} ne '') {
398: $prevlaunch = $link_info{'prevlaunch'};
399: }
1.8 raeburn 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');
1.7 raeburn 408: }
1.8 raeburn 409: } else {
410: $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
1.7 raeburn 411: }
1.8 raeburn 412: if ($deeplink ne '') {
413: my $disallow;
1.15 raeburn 414: my ($state,$others,$listed,$scope,$protect,$display,$target,$exit) = split(/,/,$deeplink);
1.8 raeburn 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;
1.7 raeburn 425: }
1.8 raeburn 426: } elsif ($acctype eq 'key') {
427: if ($linkkey ne '') {
428: unless ($linkkey eq $item) {
429: $disallow = 1;
1.7 raeburn 430: }
1.8 raeburn 431: } else {
432: $disallow = 1;
1.7 raeburn 433: }
1.8 raeburn 434: }
435: }
436: if ($disallow) {
437: if ($currdeeplinklogin eq $linkuri) {
438: &Apache::lonnet::delenv('request.deeplink.login');
1.10 raeburn 439: if ($env{'request.deeplink.target'} ne '') {
440: &Apache::lonnet::delenv('request.deeplink.target');
441: }
1.15 raeburn 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: }
1.19 raeburn 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: }
1.8 raeburn 454: }
455: } else {
1.22 raeburn 456: unless ($currdeeplinklogin eq $linkuri) {
1.8 raeburn 457: if (($linkprotector) || ($linkkey ne '')) {
1.22 raeburn 458: $newlauncher = 1;
459: }
460: }
461: if ($linkprotector) {
462: &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
1.23 raeburn 463: if ($linkprotpburl && $linkprotpbid) {
464: my ($res,$error) = &store_passback_info($cdom,$cnum,$linkuri,$linkprotector,
465: $scope,$symb,$linkprotpbid,$linkprotpburl,
466: $currdeeplinklogin);
467: }
1.22 raeburn 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'}) {
1.15 raeburn 478: if ($linkprotexit) {
479: &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
480: } elsif ($env{'request.linkprotexit'}) {
481: &Apache::lonnet::delenv('request.linkprotexit');
482: }
1.22 raeburn 483: }
484: if ($linkprotpbid ne $env{'request.linkprotpbid'}) {
1.19 raeburn 485: if ($linkprotpbid) {
486: &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
487: } elsif ($env{'request.linkprotpbid'}) {
488: &Apache::lonnet::delenv('request.linkprotpbid');
489: }
1.22 raeburn 490: }
491: if ($linkprotpburl ne $env{'request.linkprotpburl'}) {
1.19 raeburn 492: if ($linkprotpburl) {
493: &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
494: } elsif ($env{'request.linkprotpburl'}) {
495: &Apache::lonnet::delenv('request.linkprotpburl');
496: }
1.22 raeburn 497: }
498: } elsif ($prevlaunch) {
499: foreach my $requestkey ('linkprotpbid','linkprotpburl','linkprotexit') {
500: if ($env{"request.$requestkey"}) {
501: &Apache::lonnet::delenv("request.$requestkey");
1.7 raeburn 502: }
503: }
504: }
505: &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
1.9 raeburn 506: if ($target ne '') {
507: &Apache::lonnet::appenv({'request.deeplink.target' => $target});
1.10 raeburn 508: } elsif ($env{'request.deeplink.target'} ne '') {
509: &Apache::lonnet::delenv('request.deeplink.target');
1.9 raeburn 510: }
1.7 raeburn 511: }
512: } else {
513: if ($linkprotector) {
514: &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
1.8 raeburn 515: } elsif ($env{'request.linkprot'}) {
1.14 raeburn 516: &Apache::lonnet::delenv('request.linkprot');
1.8 raeburn 517: }
1.15 raeburn 518: if ($linkprotexit) {
519: &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
520: } elsif ($env{'request.linkprotexit'}) {
521: &Apache::lonnet::delenv('request.linkprotexit');
522: }
1.19 raeburn 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: }
1.8 raeburn 533: if ($linkkey ne '') {
1.7 raeburn 534: &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
1.8 raeburn 535: } else {
1.13 raeburn 536: &Apache::lonnet::delenv('request.linkkey');
1.7 raeburn 537: }
1.8 raeburn 538: &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
1.10 raeburn 539: if ($env{'request.deeplink.target'} ne '') {
540: &Apache::lonnet::delenv('request.deeplink.target');
541: }
1.7 raeburn 542: }
543: return $newlauncher;
544: }
545:
1.23 raeburn 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:
1.1 raeburn 608: sub do_redirect {
1.11 raeburn 609: my ($r,$destination,$linkprot) = @_;
1.2 raeburn 610: my $windowname = 'loncapaclient';
611: if ($env{'request.lti.login'}) {
612: $windowname .= 'lti';
613: }
1.1 raeburn 614: my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
615: my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
1.11 raeburn 616: if ($linkprot) {
617: $args = {'only_body' => 1,
618: 'redirect' => [0,$destination],};
619: }
1.1 raeburn 620: &Apache::loncommon::content_type($r,'text/html');
621: $r->send_http_header;
1.11 raeburn 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: }
1.1 raeburn 633: return;
634: }
635:
636: sub show_roles {
1.19 raeburn 637: my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
638: $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
1.1 raeburn 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"},],};
1.11 raeburn 657: if ($linkprot) {
658: $args = {'only_body' => 1};
659: }
1.1 raeburn 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">'.
1.8 raeburn 667: '<input type="hidden" name="newrole" value="" />'."\n".
668: '<input type="hidden" name="selectrole" value="1" />'."\n".
1.11 raeburn 669: '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
1.8 raeburn 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>';
1.1 raeburn 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 {
1.11 raeburn 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,
1.12 raeburn 778: linkprotexit => $linkprotexit,
1.19 raeburn 779: linkprotpbid => $linkprotpbid,
780: linkprotpburl => $linkprotpburl,
1.11 raeburn 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: }
1.1 raeburn 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) = @_;
1.3 raeburn 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>';
1.1 raeburn 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>
![[BACK]](/icons/back.gif){kind=icon}
Return to lontiny.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface