Annotation of loncom/interface/lontiny.pm, revision 1.8.2.6
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.8.2.6 ! raeburn 5: # $Id: lontiny.pm,v 1.8.2.5 2023/07/05 19:20:19 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.8.2.5 raeburn 71: my ($linkprot,$linkprotuser,$linkprotexit,$ltoken,$linkprotpbid,$linkprotpburl);
1.8.2.3 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'};
80: $linkprotexit = $ltoken_info{'linkprotexit'};
1.8.2.5 raeburn 81: $linkprotpbid = $ltoken_info{'linkprotpbid'};
82: $linkprotpburl = $ltoken_info{'linkprotpburl'};
1.8.2.3 raeburn 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: }
1.8.2.5 raeburn 91: if ($link_info{'linkprotpbid'}) {
92: $linkprotpbid = $link_info{'linkprotpbid'};
93: }
94: if ($link_info{'linkprotpburl'}) {
95: $linkprotpburl = $link_info{'linkprotpburl'};
96: }
1.8.2.3 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.8.2.4 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.8.2.4 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.8.2.4 raeburn 166: if (($reinitresult eq 'both') || ($reinitresult eq 'supp')) {
167: my $possdel;
168: if ($reinitresult eq 'supp') {
169: $possdel = 1;
170: }
171: my ($supplemental,$refs_updated) = &Apache::loncommon::get_supplemental($cnum,$cdom,'',$possdel);
172: unless ($refs_updated) {
173: &Apache::loncommon::set_supp_httprefs($cnum,$cdom,$supplemental,$possdel);
174: }
175: }
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.8.2.3 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.8.2.3 raeburn 204: my $now = time;
1.5 raeburn 205: foreach my $entry (keys(%roleshash)) {
206: if ($entry =~ /^\Q$cnum:$cdom:\E([^:]+):([^:]*)$/) {
1.8.2.3 raeburn 207: my ($role,$sec) = ($1,$2);
208: $possroles{$role} = $sec;
209: if ($sec ne '') {
1.5 raeburn 210: $hassection = 1;
211: }
1.8.2.3 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.8.2.3 raeburn 230: my @allposs = keys(%active);
1.8.2.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'});
237: }
238: }
239: if ($env{'form.selectrole'}) {
240: foreach my $role (@allposs) {
241: my $newrole = "$role./$cdom/$cnum";
242: if ($possroles{$allposs[0]} ne '') {
243: $newrole .= "/$possroles{$role}";
244: }
245: if ($env{"form.$newrole"}) {
246: my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
247: '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
248: if ($env{'form.ltitarget'} eq 'iframe') {
249: $destination .= '<itarget=iframe';
250: }
251: &do_redirect($r,$destination);
252: return OK;
253: }
254: }
255: }
256: }
1.5 raeburn 257: if (@allposs == 0) {
1.8.2.5 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.8.2.5 raeburn 264: $newrole .= "/$possroles{$allposs[0]}";
1.1 raeburn 265: }
266: my $destination .= '/adm/roles?selectrole=1&'.$newrole.'=1'.
1.8.2.3 raeburn 267: '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.8 raeburn 268: if ($env{'form.ttoken'}) {
269: $destination .= '&ttoken='.$env{'form.ttoken'};
270: }
1.8.2.3 raeburn 271: &do_redirect($r,$destination,$linkprot);
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.8.2.3 raeburn 282: '&destinationurl='.&HTML::Entities::encode($r->uri,'&<>"');
1.8 raeburn 283: if ($env{'form.ttoken'}) {
284: $destination .= '&ttoken='.$env{'form.ttoken'};
285: }
1.8.2.3 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.8.2.3 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.8.2.6 ! 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.8.2.2 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.8.2.3 raeburn 326: &Apache::lonnet::tmpdel($link_info{'ltoken'});
1.8.2.2 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.8.2.3 raeburn 350: if ($link_info{'linkprotexit'}) {
351: $linkprotexit = $link_info{'linkprotexit'};
352: }
1.8.2.5 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.8.2.6 ! 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.8.2.3 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.8.2.2 raeburn 426: if ($env{'request.deeplink.target'} ne '') {
427: &Apache::lonnet::delenv('request.deeplink.target');
428: }
1.8.2.3 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.8.2.5 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 {
443: unless ($currdeeplinklogin eq $linkuri) {
444: if (($linkprotector) || ($linkkey ne '')) {
1.8.2.6 ! raeburn 445: $newlauncher = 1;
! 446: }
! 447: }
! 448: if ($linkprotector) {
! 449: &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
! 450: } elsif ($env{'request.linkprot'}) {
! 451: &Apache::lonnet::delenv('request.linkprot');
! 452: }
! 453: if ($linkkey ne '') {
! 454: &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
! 455: } elsif ($env{'request.linkkey'} ne '') {
! 456: &Apache::lonnet::delenv('request.linkkey');
! 457: }
! 458: if (($linkprotector) || ($linkkey ne '')) {
! 459: if ($linkprotexit ne $env{'request.linkprotexit'}) {
1.8.2.3 raeburn 460: if ($linkprotexit) {
461: &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
462: } elsif ($env{'request.linkprotexit'}) {
463: &Apache::lonnet::delenv('request.linkprotexit');
1.7 raeburn 464: }
1.8.2.6 ! raeburn 465: }
! 466: if ($linkprotpbid ne $env{'request.linkprotpbid'}) {
1.8.2.5 raeburn 467: if ($linkprotpbid) {
468: &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
469: } elsif ($env{'request.linkprotpbid'}) {
470: &Apache::lonnet::delenv('request.linkprotpbid');
471: }
1.8.2.6 ! raeburn 472: }
! 473: if ($linkprotpburl ne $env{'request.linkprotpburl'}) {
1.8.2.5 raeburn 474: if ($linkprotpburl) {
475: &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
476: } elsif ($env{'request.linkprotpburl'}) {
477: &Apache::lonnet::delenv('request.linkprotpburl');
478: }
1.8.2.6 ! raeburn 479: }
! 480: } elsif ($prevlaunch) {
! 481: foreach my $requestkey ('linkprotpbid','linkprotpburl','linkprotexit') {
! 482: if ($env{"request.$requestkey"}) {
! 483: &Apache::lonnet::delenv("request.$requestkey");
1.7 raeburn 484: }
485: }
486: }
487: &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
1.8.2.2 raeburn 488: if ($target ne '') {
489: &Apache::lonnet::appenv({'request.deeplink.target' => $target});
490: } elsif ($env{'request.deeplink.target'} ne '') {
491: &Apache::lonnet::delenv('request.deeplink.target');
492: }
1.7 raeburn 493: }
494: } else {
495: if ($linkprotector) {
496: &Apache::lonnet::appenv({'request.linkprot' => $linkprotector.':'.$linkproturi});
1.8 raeburn 497: } elsif ($env{'request.linkprot'}) {
1.8.2.3 raeburn 498: &Apache::lonnet::delenv('request.linkprot');
499: }
500: if ($linkprotexit) {
501: &Apache::lonnet::appenv({'request.linkprotexit' => $linkprotexit});
502: } elsif ($env{'request.linkprotexit'}) {
503: &Apache::lonnet::delenv('request.linkprotexit');
1.8 raeburn 504: }
1.8.2.5 raeburn 505: if ($linkprotpbid) {
506: &Apache::lonnet::appenv({'request.linkprotpbid' => $linkprotpbid});
507: } elsif ($env{'request.linkprotpbid'}) {
508: &Apache::lonnet::delenv('request.linkprotpbid');
509: }
510: if ($linkprotpburl) {
511: &Apache::lonnet::appenv({'request.linkprotpburl' => $linkprotpburl});
512: } elsif ($env{'request.linkprotpburl'}) {
513: &Apache::lonnet::delenv('request.linkprotpburl');
514: }
1.8 raeburn 515: if ($linkkey ne '') {
1.7 raeburn 516: &Apache::lonnet::appenv({'request.linkkey' => $linkkey});
1.8 raeburn 517: } else {
1.8.2.3 raeburn 518: &Apache::lonnet::delenv('request.linkkey');
1.7 raeburn 519: }
1.8 raeburn 520: &Apache::lonnet::appenv({'request.deeplink.login' => $linkuri});
1.8.2.2 raeburn 521: if ($env{'request.deeplink.target'} ne '') {
522: &Apache::lonnet::delenv('request.deeplink.target');
523: }
1.7 raeburn 524: }
525: return $newlauncher;
526: }
527:
1.1 raeburn 528: sub do_redirect {
1.8.2.3 raeburn 529: my ($r,$destination,$linkprot) = @_;
1.2 raeburn 530: my $windowname = 'loncapaclient';
1.8.2.5 raeburn 531: if ($env{'request.lti.login'}) {
532: $windowname .= 'lti';
533: }
1.1 raeburn 534: my $header = '<meta HTTP-EQUIV="Refresh" CONTENT="0; url='.$destination.'" />';
535: my $args = {'bread_crumbs' => [{'href' => '','text' => 'Role initialization'},],};
1.8.2.3 raeburn 536: if ($linkprot) {
537: $args = {'only_body' => 1,
538: 'redirect' => [0,$destination],};
539: }
1.1 raeburn 540: &Apache::loncommon::content_type($r,'text/html');
541: $r->send_http_header;
1.8.2.3 raeburn 542: if ($linkprot) {
543: $r->print(&Apache::loncommon::start_page('Valid link','',$args).
544: &Apache::loncommon::end_page());
545: } else {
546: $r->print(&Apache::loncommon::start_page('Valid link',$header,$args).
547: &Apache::lonhtmlcommon::scripttag('self.name="'.$windowname.'";').
548: '<h1>'.&mt('Welcome').'</h1>'.
549: '<p>'.&mt('Welcome to the Learning[_1]Online[_2] Network with CAPA. Please wait while your session is being set up.','<i>','</i>').'</p><p>'.
550: '<a href="'.$destination.'">'.&mt('Continue').'</a></p>'.
551: &Apache::loncommon::end_page());
552: }
1.1 raeburn 553: return;
554: }
555:
556: sub show_roles {
1.8.2.5 raeburn 557: my ($r,$crsenv,$possroles,$hassection,$hascustom,$futureroles,$expiredroles,
558: $linkprot,$linkprotuser,$linkprotexit,$linkprotpbid,$linkprotpburl,$ltoken) = @_;
1.1 raeburn 559: my ($crsdesc,$crstype,$cdom,$cnum,$header,$title,$preamble,$datatable,$js,$args);
560: if (ref($crsenv) eq 'HASH') {
561: $crsdesc = $crsenv->{'description'};
562: $crstype = $crsenv->{'type'};
563: $cdom = $crsenv->{'domain'};
564: $cnum = $crsenv->{'num'};
565: }
566: if ($crstype eq '') {
567: $crstype = 'Course';
568: }
569: my $lc_crstype = lc($crstype);
570: if ($crsdesc ne '') {
571: $header = &mt("The page you requested belongs to the following $lc_crstype: [_1]",
572: '<i>'.$crsdesc.'</i>');
573: }
574: if (ref($possroles) eq 'HASH') {
575: if (keys(%{$possroles}) > 0) {
576: $args = {'bread_crumbs' => [{'href' => '','text' => "Choose role in $lc_crstype"},],};
1.8.2.3 raeburn 577: if ($linkprot) {
578: $args = {'only_body' => 1};
579: }
1.1 raeburn 580: $title = 'Choose a role'; #Do not localize.
581: if ($crstype eq 'Community') {
582: $preamble = &mt('You have the following active roles in this community:');
583: } else {
584: $preamble = &mt('You have the following active roles in this course:');
585: }
586: $datatable = '<form name="" action="/adm/roles">'.
1.8 raeburn 587: '<input type="hidden" name="newrole" value="" />'."\n".
588: '<input type="hidden" name="selectrole" value="1" />'."\n".
1.8.2.3 raeburn 589: '<input type="hidden" name="destinationurl" value="'.&HTML::Entities::encode($r->uri,'&<>"').'" />'."\n";
1.8 raeburn 590: if ($env{'form.ttoken'}) {
591: $datatable .= '<input type="hidden" name="ttoken" value="'.$env{'form.ttoken'}.'" />'."\n";
592: }
593: $datatable .= &Apache::loncommon::start_data_table().
594: &Apache::loncommon::start_data_table_header_row().
595: '<th></th><th>'.&mt('User role').'</th>';
1.1 raeburn 596: if ($hassection) {
597: $datatable .= '<th>'.&mt('Section').'</th>';
598: }
599: if ($hascustom) {
600: $datatable .= '<th>'.&mt('Information').'</th>';
601: }
602: $datatable .= &Apache::loncommon::end_data_table_header_row();
603: my @available = sort(keys(%{$possroles}));
604: foreach my $role ('ad','in','ta','ep','st','cr') {
605: foreach my $key (@available) {
606: if ($key =~ m{^$role($|/)}) {
607: my $trolecode = "$key./$cdom/$cnum";
608: my $rolename = &Apache::lonnet::plaintext($key,$crstype,$cdom.'_'.$cnum);
609: my $sec = $possroles->{$key};
610: if ($sec ne '') {
611: $trolecode .= '/'.$sec;
612: }
613: my $buttonname=$trolecode;
614: $buttonname=~s/\W//g;
615: $datatable .= &Apache::loncommon::start_data_table_row().
616: '<td><input name="'.$buttonname.'" type="button" value="'.
617: &mt('Select').'" onclick="javascript:enterrole(this.form,'.
618: "'$trolecode','$buttonname'".');" /></td>';
619: if ($key =~ /^cr\//) {
620: my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$key);
621: $datatable .= '<td><span class="LC_nobreak">'.$rolename.'</span></td>';
622: if ($hassection) {
623: $datatable .= '<td>'.$sec.'</td>';
624: }
625: $datatable.= '<td><span class="LC_fontsize_small LC_cusr_emph">'.
626: &mt('Custom role defined by [_1]',$rauthor.':'.$rdomain).
627: '</td>';
628: } else {
629: if ($hassection) {
630: $datatable .= '<td>'.$rolename.'</td>';
631: if ($hascustom) {
632: $datatable .= '<td colspan="2">'.$sec.'</td>';
633: } else {
634: $datatable .= '<td>'.$sec.'</td>';
635: }
636: } elsif ($hascustom) {
637: $datatable .= '<td colspan="2">'.$rolename.'</td>';
638: } else {
639: $datatable .= '<td>'.$rolename.'</td>';
640: }
641: }
642: $datatable .= &Apache::loncommon::end_data_table_row();
643: }
644: }
645: }
646: $datatable .= &Apache::loncommon::end_data_table().
647: '</form>';
648: my $standby = &mt('Role selected. Please stand by.');
649: $js = <<"ENDJS";
650: <script type="text/javascript">
651: // <![CDATA[
652:
653: active=true;
654:
655: function enterrole (thisform,rolecode,buttonname) {
656: if (active) {
657: active=false;
658: document.title='$standby';
659: window.status='$standby';
660: thisform.newrole.value=rolecode;
661: thisform.submit();
662: } else {
663: alert('$standby');
664: }
665: }
666:
667: // ]]>
668: </script>
669: ENDJS
670: } else {
1.8.2.3 raeburn 671: if ($linkprot) {
672: $title = 'No access';
673: $preamble = '<p>'.&mt('Access unavailable for this LON-CAPA content.').'</p>';
674: $args->{'only_body'} = 1;
675: } else {
676: $title = 'No active role';
677: $preamble = '<p>'.&mt("You have no active roles in this $lc_crstype so the page is currently unavailable to you.").'</p>';
678: $args = {'bread_crumbs' => [{'href' => '','text' => 'Role status'},],};
679: }
680: $header = &mt('No access for: [_1]','<b>'.&Apache::loncommon::plainname($env{'user.name'},
681: $env{'user.domain'}).'</b>');
682: if ((ref($futureroles) eq 'HASH') && (keys(%{$futureroles}) > 0)) {
683: my @future = sort { $a <=> $b } (keys(%{$futureroles}));
684: $preamble .= '<p>'.&mt('Access will begin: [_1].',&Apache::lonlocal::locallocaltime($future[0])).
685: ' '.&mt('Please try again then.').'</p>';
686: } elsif ((ref($expiredroles) eq 'HASH') && (keys(%{$expiredroles}) > 0)) {
687: my @expired = sort { $b <=> $a } (keys(%{$expiredroles}));
688: $preamble .= '<p>'.&mt('Access ended: [_1].',&Apache::lonlocal::locallocaltime($expired[0])).'</p>';
689: } elsif ($linkprot) {
690: if ($linkprotuser) {
691: my ($uname,$udom) = split(/:/,$linkprotuser,2);
692: $preamble .= '<p>'.&mt('As you followed a link from another system, while logged into that other system with the username: [_1], it is recommended that you contact your instructor.','<i>'.$uname.'</i>').'</p>';
693: } else {
694: my $relogin;
695: my %data = (
696: origurl => $r->uri,
697: linkprot => $linkprot,
698: linkprotexit => $linkprotexit,
1.8.2.5 raeburn 699: linkprotpbid => $linkprotpbid,
700: linkprotpburl => $linkprotpburl,
1.8.2.3 raeburn 701: );
702: my $token =
703: &Apache::lonnet::tmpput(\%data,$r->dir_config('lonHostID'),'retry');
704: unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
705: ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
706: $relogin = '/adm/relaunch?rtoken='.$token;
707: }
708: $preamble .= '<p>'.&mt('You might try logging in with a different username and/or domain.').' '.
709: &mt('You are currently logged in as: [_1] in domain: [_2]',
710: '<i>'.$env{'user.name'}.'</i>','<i>'.$env{'user.domain'}.'</i>').'</p>';
711: if ($relogin) {
712: $preamble .= '<p>'.&mt('[_1]Log-in again[_2]','<a href="'.$relogin.'" target="_self">','</a>').'</p>';
713: }
714: }
715: }
716: if ($env{'form.ttoken'}) {
717: &Apache::lonnet::tmpdel($env{'form.ttoken'});
718: }
719: if ($ltoken) {
720: &Apache::lonnet::tmpdel($ltoken);
721: }
1.1 raeburn 722: }
723: }
724: &Apache::loncommon::content_type($r,'text/html');
725: $r->send_http_header;
726: $r->print(&Apache::loncommon::start_page($title,$js,$args).
727: '<h3>'.$header.'</h3>'.
728: '<div>'.$preamble.'</div>'.
729: $datatable.
730: &Apache::loncommon::end_page());
731: return;
732: }
733:
734: sub generic_error {
735: my ($r) = @_;
1.3 raeburn 736: my $continuelink;
1.8.2.5 raeburn 737: unless ($env{'request.lti.login'}) {
738: my $linktext;
739: if ($env{'user.adv'}) {
740: $linktext = &mt('Continue to your roles page');
741: } else {
742: $linktext = &mt('Continue to your courses page');
743: }
744: $continuelink='<a href="/adm/roles">'.$linktext.'</a>';
1.1 raeburn 745: }
746: my $msg = &mt('The page you requested does not exist.');
747: &Apache::loncommon::content_type($r,'text/html');
748: $r->send_http_header;
749: my $args = {'bread_crumbs' => [{'href' => '','text' => 'Link status'},],};
750: $r->print(&Apache::loncommon::start_page('Invalid URL',undef,$args).
751: '<div class="LC_error">'.$msg.'</div>'.
752: '<p>'.$continuelink.'</p>'.
753: &Apache::loncommon::end_page());
754: return;
755: }
756:
757: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[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