Annotation of loncom/auth/lonlogin.pm, revision 1.192
1.160 kruse 1: # The LearningOnline Network
2: # Login Screen
3: #
1.192 ! raeburn 4: # $Id: lonlogin.pm,v 1.191 2021/10/10 23:22:30 raeburn Exp $
1.160 kruse 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28:
29: package Apache::lonlogin;
30:
31: use strict;
32: use Apache::Constants qw(:common);
33: use Apache::File ();
34: use Apache::lonnet;
35: use Apache::loncommon();
36: use Apache::lonauth();
37: use Apache::lonlocal;
38: use Apache::migrateuser();
39: use lib '/home/httpd/lib/perl/';
1.176 raeburn 40: use LONCAPA qw(:DEFAULT :match);
1.188 raeburn 41: use URI::Escape;
42: use HTML::Entities();
1.169 raeburn 43: use CGI::Cookie();
1.160 kruse 44:
45: sub handler {
46: my $r = shift;
47:
48: &Apache::loncommon::get_unprocessed_cgi
49: (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
50: $ENV{'REDIRECT_QUERY_STRING'}),
51: ['interface','username','domain','firsturl','localpath','localres',
1.192 ! raeburn 52: 'token','role','symb','iptoken','btoken','ltoken','linkkey','saml',
! 53: 'sso','retry']);
! 54: my $lonhost = $r->dir_config('lonHostID');
! 55: my $linkkey;
! 56: if (($env{'form.sso'}) || ($env{'form.retry'})) {
! 57: my $infotoken;
! 58: if ($env{'form.sso'}) {
! 59: $infotoken = $env{'form.sso'};
! 60: } else {
! 61: $infotoken = $env{'form.retry'};
! 62: }
! 63: my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
! 64: unless (($data=~/^error/) || ($data eq 'con_lost') ||
! 65: ($data eq 'no_such_host')) {
! 66: my %info = &decode_token($data);
! 67: foreach my $item (keys(%info)) {
! 68: $env{'form.'.$item} = $info{$item};
! 69: }
! 70: &Apache::lonnet::tmpdel($infotoken);
! 71: }
! 72: } else {
! 73: if ($env{'form.linkkey'}) {
! 74: $linkkey = $env{'form.linkkey'};
! 75: }
! 76: if (!defined($env{'form.firsturl'})) {
! 77: &Apache::lonacc::get_posted_cgi($r,['firsturl']);
! 78: }
! 79: if (!defined($env{'form.firsturl'})) {
! 80: if ($ENV{'REDIRECT_URL'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) {
! 81: $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
! 82: }
! 83: }
! 84: if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
! 85: (!$env{'form.ltoken'}) && (!$env{'form.linkkey'})) {
! 86: &Apache::lonacc::get_posted_cgi($r,['linkkey']);
! 87: }
! 88: if ($env{'form.firsturl'} eq '/adm/logout') {
! 89: delete($env{'form.firsturl'});
1.172 raeburn 90: }
91: }
1.160 kruse 92:
93: # -- check if they are a migrating user
94: if (defined($env{'form.token'})) {
95: return &Apache::migrateuser::handler($r);
96: }
97:
1.169 raeburn 98: # For "public user" - remove any exising "public" cookie, as user really wants to log-in
1.171 raeburn 99: my ($handle,$lonidsdir,$expirepub,$userdom);
1.176 raeburn 100: $lonidsdir=$r->dir_config('lonIDsDir');
1.169 raeburn 101: unless ($r->header_only) {
1.171 raeburn 102: $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
1.169 raeburn 103: if ($handle ne '') {
104: if ($handle=~/^publicuser\_/) {
105: unlink($r->dir_config('lonIDsDir')."/$handle.id");
106: undef($handle);
1.171 raeburn 107: undef($userdom);
108: $expirepub = 1;
1.169 raeburn 109: }
110: }
111: }
112:
1.160 kruse 113: &Apache::loncommon::no_cache($r);
114: &Apache::lonlocal::get_language_handle($r);
115: &Apache::loncommon::content_type($r,'text/html');
1.171 raeburn 116: if ($expirepub) {
1.170 raeburn 117: my $c = new CGI::Cookie(-name => 'lonPubID',
1.169 raeburn 118: -value => '',
119: -expires => '-10y',);
120: $r->header_out('Set-cookie' => $c);
1.171 raeburn 121: } elsif (($handle eq '') && ($userdom ne '')) {
1.173 raeburn 122: my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
123: foreach my $name (keys(%cookies)) {
124: next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
125: my $c = new CGI::Cookie(-name => $name,
126: -value => '',
127: -expires => '-10y',);
128: $r->headers_out->add('Set-cookie' => $c);
129: }
1.169 raeburn 130: }
1.160 kruse 131: $r->send_http_header;
132: return OK if $r->header_only;
133:
134:
135: # Are we re-routing?
136: my $londocroot = $r->dir_config('lonDocRoot');
137: if (-e "$londocroot/lon-status/reroute.txt") {
138: &Apache::lonauth::reroute($r);
139: return OK;
140: }
141:
1.174 raeburn 142: # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
143:
144: my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
145: if ($found_server) {
146: my $hostname = &Apache::lonnet::hostname($found_server);
147: if ($hostname ne '') {
148: my $protocol = $Apache::lonnet::protocol{$found_server};
149: $protocol = 'http' if ($protocol ne 'https');
150: my $dest = '/adm/roles';
151: if ($env{'form.firsturl'} ne '') {
1.188 raeburn 152: if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
153: $dest = &uri_escape_utf8($env{'form.firsturl'});
154: } else {
155: $dest = &uri_escape($env{'form.firsturl'});
156: }
157: $dest = &HTML::Entities::encode($dest,"'");
1.174 raeburn 158: }
1.176 raeburn 159: my %info = (
160: balcookie => $lonhost.':'.$balancer_cookie,
161: );
1.177 raeburn 162: if ($env{'form.ltoken'}) {
163: my %link_info = &Apache::lonnet::tmpget($env{'form.ltoken'});
164: if ($link_info{'linkprot'}) {
165: $info{'linkprot'} = $link_info{'linkprot'};
166: }
167: &Apache::lonnet::tmpdel($env{'form.ltoken'});
168: delete($env{'form.ltoken'});
1.179 raeburn 169: } elsif ($env{'form.linkkey'}) {
170: $info{'linkkey'} = $env{'form.linkkey'};
171: delete($env{'form.linkkey'});
1.177 raeburn 172: }
1.176 raeburn 173: my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
174: if ($balancer_token) {
1.187 raeburn 175: $dest .= (($dest=~/\?/)?'&':'?') . 'btoken='.$balancer_token;
1.176 raeburn 176: }
1.183 raeburn 177: unless ($found_server eq $lonhost) {
178: my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server);
179: $hostname = $alias if ($alias ne '');
180: }
1.174 raeburn 181: my $url = $protocol.'://'.$hostname.$dest;
182: my $start_page =
183: &Apache::loncommon::start_page('Switching Server ...',undef,
184: {'redirect' => [0,$url],});
185: my $end_page = &Apache::loncommon::end_page();
186: $r->print($start_page.$end_page);
187: return OK;
188: }
189: }
190:
1.171 raeburn 191: #
1.176 raeburn 192: # Check if a LON-CAPA load balancer sent user here because user's browser sent
193: # it a balancer cookie for an active session on this server.
194: #
195:
1.179 raeburn 196: my ($balcookie,$linkprot,$linkkey);
1.176 raeburn 197: if ($env{'form.btoken'}) {
198: my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
199: $balcookie = $info{'balcookie'};
1.177 raeburn 200: if ($balcookie) {
201: if ($info{'linkprot'}) {
202: $linkprot = $info{'linkprot'};
1.179 raeburn 203: } elsif ($info{'linkkey'}) {
204: $linkkey = $info{'linkkey'};
1.177 raeburn 205: }
206: }
1.176 raeburn 207: &Apache::lonnet::tmpdel($env{'form.btoken'});
208: delete($env{'form.btoken'});
209: }
210:
211: #
1.171 raeburn 212: # If browser sent an old cookie for which the session file had been removed
213: # check if configuration for user's domain has a portal URL set. If so
214: # switch user's log-in to the portal.
215: #
216:
217: if (($handle eq '') && ($userdom ne '')) {
218: my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom);
219: if ($domdefaults{'portal_def'} =~ /^https?\:/) {
220: my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
221: {'redirect' => [0,$domdefaults{'portal_def'}],});
222: my $end_page = &Apache::loncommon::end_page();
223: $r->print($start_page.$end_page);
224: return OK;
225: }
226: }
227:
1.160 kruse 228: # -------------------------------- Prevent users from attempting to login twice
229: if ($handle ne '') {
1.169 raeburn 230: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
231: my $start_page =
232: &Apache::loncommon::start_page('Already logged in');
233: my $end_page =
234: &Apache::loncommon::end_page();
235: my $dest = '/adm/roles';
236: if ($env{'form.firsturl'} ne '') {
1.188 raeburn 237: if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
238: $dest = &uri_escape_utf8($env{'form.firsturl'});
239: } else {
240: $dest = &uri_escape($env{'form.firsturl'});
241: }
242: $dest = &HTML::Entities::encode($dest,"'");
1.169 raeburn 243: }
1.177 raeburn 244: if (($env{'form.ltoken'}) || ($linkprot)) {
245: unless ($linkprot) {
246: my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
247: $linkprot = $info{'linkprot'};
248: my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
249: delete($env{'form.ltoken'});
250: }
251: if ($linkprot) {
252: my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
253: if ($env{'user.linkprotector'}) {
254: my @protectors = split(/,/,$env{'user.linkprotector'});
255: unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
256: push(@protectors,$linkprotector);
257: @protectors = sort { $a <=> $b } @protectors;
258: &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
259: }
260: } else {
261: &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
262: }
263: if ($env{'user.linkproturi'}) {
264: my @proturis = split(/,/,$env{'user.linkproturi'});
1.179 raeburn 265: unless (grep(/^\Q$deeplink\E$/,@proturis)) {
1.177 raeburn 266: push(@proturis,$deeplink);
267: @proturis = sort @proturis;
268: &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
269: }
270: } else {
271: &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
272: }
273: }
1.179 raeburn 274: } elsif (($env{'form.linkkey'}) || ($linkkey)) {
275: if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
276: if ($linkkey eq '') {
277: $linkkey = $env{'form.linkkey'};
278: }
279: if ($env{'user.deeplinkkey'}) {
280: my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
281: unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
282: push(@linkkeys,$linkkey);
283: &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
284: }
285: } else {
286: &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
287: }
288: my $deeplink = $env{'form.firsturl'};
289: if ($env{'user.keyedlinkuri'}) {
290: my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
291: unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
292: push(@keyeduris,$deeplink);
293: &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
294: }
295: } else {
296: &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
297: }
298: }
1.177 raeburn 299: }
1.169 raeburn 300: $r->print(
1.160 kruse 301: $start_page
302: .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
303: .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
304: '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'
305: .$end_page
306: );
1.169 raeburn 307: return OK;
1.160 kruse 308: }
309:
310: # ---------------------------------------------------- No valid token, continue
311:
312: # ---------------------------- Not possible to really login to domain "public"
313: if ($env{'form.domain'} eq 'public') {
314: $env{'form.domain'}='';
315: $env{'form.username'}='';
316: }
317:
318: # ------ Is this page requested because /adm/migrateuser detected an IP change?
319: my %sessiondata;
320: if ($env{'form.iptoken'}) {
321: %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'});
1.162 raeburn 322: unless ($sessiondata{'sessionserver'}) {
323: my $delete = &Apache::lonnet::tmpdel($env{'form.iptoken'});
324: delete($env{'form.iptoken'});
325: }
1.160 kruse 326: }
327: # ----------------------------------------------------------- Process Interface
328: $env{'form.interface'}=~s/\W//g;
329:
330: (undef,undef,undef,undef,undef,undef,my $clientmobile) =
1.192 ! raeburn 331: &Apache::loncommon::decode_user_agent($r);
1.160 kruse 332:
333: my $iconpath=
334: &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
335:
336: my $domain = &Apache::lonnet::default_login_domain();
1.161 raeburn 337: my $defdom = $domain;
1.160 kruse 338: if ($lonhost ne '') {
339: unless ($sessiondata{'sessionserver'}) {
1.192 ! raeburn 340: my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie,
! 341: $linkprot,$linkkey);
1.160 kruse 342: if ($redirect) {
343: $r->print($redirect);
344: return OK;
345: }
346: }
347: }
348:
349: if (($sessiondata{'domain'}) &&
1.175 raeburn 350: (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
1.160 kruse 351: $domain=$sessiondata{'domain'};
352: } elsif (($env{'form.domain'}) &&
353: (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
354: $domain=$env{'form.domain'};
355: }
356:
357: my $role = $r->dir_config('lonRole');
358: my $loadlim = $r->dir_config('lonLoadLim');
359: my $uloadlim= $r->dir_config('lonUserLoadLim');
360: my $servadm = $r->dir_config('lonAdmEMail');
361: my $tabdir = $r->dir_config('lonTabDir');
362: my $include = $r->dir_config('lonIncludes');
363: my $expire = $r->dir_config('lonExpire');
364: my $version = $r->dir_config('lonVersion');
365: my $host_name = &Apache::lonnet::hostname($lonhost);
366:
367: # --------------------------------------------- Default values for login fields
368:
369: my ($authusername,$authdomain);
370: if ($sessiondata{'username'}) {
371: $authusername=$sessiondata{'username'};
372: } else {
373: $env{'form.username'} = &Apache::loncommon::cleanup_html($env{'form.username'});
374: $authusername=($env{'form.username'}?$env{'form.username'}:'');
375: }
376: if ($sessiondata{'domain'}) {
377: $authdomain=$sessiondata{'domain'};
378: } else {
379: $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'});
380: $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
381: }
382:
383: # ---------------------------------------------------------- Determine own load
384: my $loadavg;
385: {
386: my $loadfile=Apache::File->new('/proc/loadavg');
387: $loadavg=<$loadfile>;
388: }
389: $loadavg =~ s/\s.*//g;
390:
391: my ($loadpercent,$userloadpercent);
392: if ($loadlim) {
393: $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
394: }
395: if ($uloadlim) {
396: $userloadpercent=&Apache::lonnet::userload();
397: }
398:
399: my $firsturl=
400: ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
401:
402: # ----------------------------------------------------------- Get announcements
403: my $announcements=&Apache::lonnet::getannounce();
404: # -------------------------------------------------------- Set login parameters
405:
406: my @hexstr=('0','1','2','3','4','5','6','7',
407: '8','9','a','b','c','d','e','f');
408: my $lkey='';
409: for (0..7) {
410: $lkey.=$hexstr[rand(15)];
411: }
412:
413: my $ukey='';
414: for (0..7) {
415: $ukey.=$hexstr[rand(15)];
416: }
417:
418: my $lextkey=hex($lkey);
419: if ($lextkey>2147483647) { $lextkey-=4294967296; }
420:
421: my $uextkey=hex($ukey);
422: if ($uextkey>2147483647) { $uextkey-=4294967296; }
423:
424: # -------------------------------------------------------- Store away log token
1.192 ! raeburn 425: my ($tokenextras,$tokentype);
! 426: my @names = ('role','symb','iptoken','ltoken','linkkey');
! 427: foreach my $name (@names) {
! 428: if ($env{'form.'.$name} ne '') {
! 429: if ($name eq 'ltoken') {
! 430: my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
! 431: if ($info{'linkprot'}) {
! 432: $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
! 433: $tokentype = 'link';
! 434: last;
! 435: }
! 436: } else {
! 437: $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
! 438: if ($name eq 'linkkey') {
! 439: $tokentype = 'link';
! 440: }
! 441: }
1.160 kruse 442: }
443: }
1.192 ! raeburn 444: if ($tokentype) {
! 445: $tokenextras .= ":$tokentype";
1.177 raeburn 446: }
1.160 kruse 447: my $logtoken=Apache::lonnet::reply(
448: 'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
449: $lonhost);
450:
451: # -- If we cannot talk to ourselves, or hostID does not map to a hostname
452: # we are in serious trouble
453:
454: if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
455: if ($logtoken eq 'no_such_host') {
456: &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
457: }
1.191 raeburn 458: if ($env{'form.ltoken'}) {
459: &Apache::lonnet::tmpdel($env{'form.ltoken'});
460: delete($env{'form.ltoken'});
461: }
1.160 kruse 462: my $spares='';
1.180 raeburn 463: my (@sparehosts,%spareservers);
464: my $sparesref = &Apache::lonnet::this_host_spares($defdom);
465: if (ref($sparesref) eq 'HASH') {
466: foreach my $key (keys(%{$sparesref})) {
467: if (ref($sparesref->{$key}) eq 'ARRAY') {
468: my @sorted = sort { &Apache::lonnet::hostname($a) cmp
469: &Apache::lonnet::hostname($b);
470: } @{$sparesref->{$key}};
471: if (@sorted) {
472: if ($key eq 'primary') {
473: unshift(@sparehosts,@sorted);
474: } elsif ($key eq 'default') {
475: push(@sparehosts,@sorted);
476: }
477: }
478: }
479: }
480: }
481: foreach my $hostid (@sparehosts) {
1.160 kruse 482: next if ($hostid eq $lonhost);
483: my $hostname = &Apache::lonnet::hostname($hostid);
1.180 raeburn 484: next if (($hostname eq '') || ($spareservers{$hostname}));
485: $spareservers{$hostname} = 1;
486: my $protocol = $Apache::lonnet::protocol{$hostid};
487: $protocol = 'http' if ($protocol ne 'https');
488: $spares.='<br /><span style="font-size: larger;"><a href="'.$protocol.'://'.
1.160 kruse 489: $hostname.
490: '/adm/login?domain='.$authdomain.'">'.
491: $hostname.'</a>'.
1.180 raeburn 492: ' '.&mt('(preferred)').'</span>'.$/;
1.160 kruse 493: }
494: if ($spares) {
495: $spares.= '<br />';
496: }
497: my %all_hostnames = &Apache::lonnet::all_hostnames();
498: foreach my $hostid (sort
499: {
500: &Apache::lonnet::hostname($a) cmp
501: &Apache::lonnet::hostname($b);
502: }
503: keys(%all_hostnames)) {
1.180 raeburn 504: next if ($hostid eq $lonhost);
1.160 kruse 505: my $hostname = &Apache::lonnet::hostname($hostid);
1.180 raeburn 506: next if (($hostname eq '') || ($spareservers{$hostname}));
1.181 raeburn 507: $spareservers{$hostname} = 1;
1.180 raeburn 508: my $protocol = $Apache::lonnet::protocol{$hostid};
509: $protocol = 'http' if ($protocol ne 'https');
510: $spares.='<br /><a href="'.$protocol.'://'.
1.160 kruse 511: $hostname.
512: '/adm/login?domain='.$authdomain.'">'.
513: $hostname.'</a>';
514: }
515: $r->print(
1.180 raeburn 516: '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
517: .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'
518: .'<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" /><title>'
1.160 kruse 519: .&mt('The LearningOnline Network with CAPA')
520: .'</title></head>'
521: .'<body bgcolor="#FFFFFF">'
522: .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
1.180 raeburn 523: .'<img src="/adm/lonKaputt/lonlogo_broken.gif" alt="broken icon" align="right" />'
1.160 kruse 524: .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
525: if ($spares) {
526: $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
527: .'</p>'
528: .$spares);
529: }
530: $r->print('</body>'
531: .'</html>'
532: );
533: return OK;
534: }
535:
536: # ----------------------------------------------- Apparently we are in business
537: $servadm=~s/\,/\<br \/\>/g;
538:
539: # ----------------------------------------------------------- Front page design
540: my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
541: my $font=&Apache::loncommon::designparm('login.font',$domain);
542: my $link=&Apache::loncommon::designparm('login.link',$domain);
543: my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
544: my $alink=&Apache::loncommon::designparm('login.alink',$domain);
545: my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
546: my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
547: my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
548: my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
549: my $logo=&Apache::loncommon::designparm('login.logo',$domain);
550: my $img=&Apache::loncommon::designparm('login.img',$domain);
551: my $domainlogo=&Apache::loncommon::domainlogo($domain);
552: my $showbanner = 1;
553: my $showmainlogo = 1;
554: if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
555: $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
556: }
557: if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
558: $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
559: }
560: my $showadminmail;
561: my @possdoms = &Apache::lonnet::current_machine_domains();
562: if (grep(/^\Q$domain\E$/,@possdoms)) {
563: $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
564: }
565: my $showcoursecat =
566: &Apache::loncommon::designparm('login.coursecatalog',$domain);
567: my $shownewuserlink =
568: &Apache::loncommon::designparm('login.newuser',$domain);
569: my $showhelpdesk =
570: &Apache::loncommon::designparm('login.helpdesk',$domain);
571: my $now=time;
572: my $js = (<<ENDSCRIPT);
573:
574: <script type="text/javascript" language="JavaScript">
575: // <![CDATA[
576: function send()
577: {
578: this.document.server.elements.uname.value
579: =this.document.client.elements.uname.value;
580:
581: this.document.server.elements.udom.value
582: =this.document.client.elements.udom.value;
583:
584: uextkey=this.document.client.elements.uextkey.value;
585: lextkey=this.document.client.elements.lextkey.value;
586: initkeys();
587:
588: if(this.document.server.action.substr(0,5) === 'http:'){
1.165 raeburn 589: this.document.server.elements.upass0.value
590: =getCrypted(this.document.client.elements.upass$now.value);
1.166 raeburn 591: } else {
592: this.document.server.elements.upass0.value
593: =this.document.client.elements.upass$now.value;
1.167 raeburn 594: }
1.160 kruse 595:
596: this.document.client.elements.uname.value='';
597: this.document.client.elements.upass$now.value='';
598:
599: this.document.server.submit();
600: return false;
601: }
602:
603: function enableInput() {
604: this.document.client.elements.upass$now.removeAttribute("readOnly");
605: this.document.client.elements.uname.removeAttribute("readOnly");
606: this.document.client.elements.udom.removeAttribute("readOnly");
607: return;
608: }
609:
610: // ]]>
611: </script>
612:
613: ENDSCRIPT
614:
1.184 raeburn 615: my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
616: $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip);
617: %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
618: @hosts = &Apache::lonnet::current_machine_ids();
619: $lonhost_in_use = $lonhost;
620: if (@hosts > 1) {
621: foreach my $hostid (@hosts) {
622: if (&Apache::lonnet::host_domain($hostid) eq $defdom) {
623: $lonhost_in_use = $hostid;
624: last;
625: }
626: }
627: }
628: $saml_prefix = $defdom.'.login.saml_';
629: if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) {
630: $saml_landing = 1;
631: $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use};
632: $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use};
633: $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use};
634: $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use};
635: $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use};
636: $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use};
637: }
638: if ($saml_landing) {
639: if ($samlssotext eq '') {
640: $samlssotext = 'SSO Login';
641: }
642: if ($samlnonsso eq '') {
643: $samlnonsso = 'Non-SSO Login';
644: }
645: $js .= <<"ENDSAMLJS";
646:
647: <script type="text/javascript">
648: // <![CDATA[
649: function toggleLClogin() {
650: if (document.getElementById('LC_standard_login')) {
651: if (document.getElementById('LC_standard_login').style.display == 'none') {
652: document.getElementById('LC_standard_login').style.display = 'inline-block';
653: if (document.getElementById('LC_login_text')) {
654: document.getElementById('LC_login_text').innerHTML = '$samlnonsso';
655: }
656: if (document.getElementById('LC_SSO_login')) {
657: document.getElementById('LC_SSO_login').style.display = 'none';
658: }
659: } else {
660: document.getElementById('LC_standard_login').style.display = 'none';
661: if (document.getElementById('LC_login_text')) {
662: document.getElementById('LC_login_text').innerHTML = '$samlssotext';
663: }
664: if (document.getElementById('LC_SSO_login')) {
665: document.getElementById('LC_SSO_login').style.display = 'inline-block';
666: }
667: }
668: }
669: return;
670: }
671:
672: // ]]>
673: </script>
674:
675: ENDSAMLJS
676: }
677:
1.160 kruse 678: # --------------------------------------------------- Print login screen header
679:
680: my %add_entries = (
681: bgcolor => "$mainbg",
682: text => "$font",
683: link => "$link",
684: vlink => "$vlink",
685: alink => "$alink",
686: onload => 'javascript:enableInput();',);
687:
1.186 raeburn 688: my ($headextra,$headextra_exempt);
1.164 raeburn 689: $headextra = $defaultdomconf{$defdom.'.login.headtag_'.$lonhost_in_use};
690: $headextra_exempt = $defaultdomconf{$domain.'.login.headtag_exempt_'.$lonhost_in_use};
1.161 raeburn 691: if ($headextra) {
692: my $omitextra;
693: if ($headextra_exempt ne '') {
694: my @exempt = split(',',$headextra_exempt);
1.182 raeburn 695: my $ip = &Apache::lonnet::get_requestor_ip();
1.161 raeburn 696: if (grep(/^\Q$ip\E$/,@exempt)) {
697: $omitextra = 1;
698: }
699: }
700: unless ($omitextra) {
701: my $confname = $defdom.'-domainconfig';
1.163 raeburn 702: if ($headextra =~ m{^\Q/res/$defdom/$confname/login/headtag/$lonhost_in_use/\E}) {
1.161 raeburn 703: my $extra = &Apache::lonnet::getfile(&Apache::lonnet::filelocation("",$headextra));
704: unless ($extra eq '-1') {
705: $js .= "\n".$extra."\n";
706: }
707: }
708: }
709: }
710:
1.160 kruse 711: $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
712: { 'redirect' => [$expire,'/adm/roles'],
713: 'add_entries' => \%add_entries,
714: 'only_body' => 1,}));
715:
716: # ----------------------------------------------------------------------- Texts
717:
718: my %lt=&Apache::lonlocal::texthash(
719: 'un' => 'Username',
720: 'pw' => 'Password',
721: 'dom' => 'Domain',
722: 'perc' => 'percent',
723: 'load' => 'Server Load',
724: 'userload' => 'User Load',
725: 'catalog' => 'Course/Community Catalog',
726: 'log' => 'Log in',
727: 'help' => 'Log-in Help',
728: 'serv' => 'Server',
729: 'servadm' => 'Server Administration',
730: 'helpdesk' => 'Contact Helpdesk',
731: 'forgotpw' => 'Forgot password?',
732: 'newuser' => 'New User?',
1.184 raeburn 733: 'change' => 'Change?',
1.160 kruse 734: );
735: # -------------------------------------------------- Change password field name
736:
737: my $forgotpw = &forgotpwdisplay(%lt);
738: $forgotpw .= '<br />' if $forgotpw;
739: my $loginhelp = &Apache::lonauth::loginhelpdisplay($authdomain);
740: if ($loginhelp) {
741: $loginhelp = '<a href="'.$loginhelp.'">'.$lt{'help'}.'</a><br />';
742: }
743:
744: # ---------------------------------------------------- Serve out DES JavaScript
745: {
746: my $jsh=Apache::File->new($include."/londes.js");
747: $r->print(<$jsh>);
748: }
749: # ---------------------------------------------------------- Serve rest of page
750:
751: $r->print(
752: '<div class="LC_Box"'
753: .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
754: );
755:
756: $r->print(<<ENDSERVERFORM);
757: <form name="server" action="/adm/authenticate" method="post" target="_top">
758: <input type="hidden" name="logtoken" value="$logtoken" />
759: <input type="hidden" name="serverid" value="$lonhost" />
760: <input type="hidden" name="uname" value="" />
761: <input type="hidden" name="upass0" value="" />
762: <input type="hidden" name="udom" value="" />
763: <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
764: <input type="hidden" name="localres" value="$env{'form.localres'}" />
765: </form>
766: ENDSERVERFORM
767: my $coursecatalog;
768: if (($showcoursecat eq '') || ($showcoursecat)) {
769: $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
770: }
771: my $newuserlink;
772: if ($shownewuserlink) {
773: $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
774: }
775: my $logintitle =
776: '<h2 class="LC_hcell"'
777: .' style="background:'.$loginbox_header_bgcol.';'
778: .' color:'.$loginbox_header_textcol.'">'
779: .$lt{'log'}
780: .'</h2>';
781:
782: my $noscript_warning='<noscript><span class="LC_warning"><b>'
783: .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
784: .'</b></span></noscript>';
785: my $helpdeskscript;
786: my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
787: $authdomain,\$helpdeskscript,
788: $showhelpdesk,\@possdoms);
789:
790: my $mobileargs;
791: if ($clientmobile) {
792: $mobileargs = 'autocapitalize="off" autocorrect="off"';
793: }
794: my $loginform=(<<LFORM);
1.184 raeburn 795: <form name="client" action="" onsubmit="return(send())" id="lclogin">
1.160 kruse 796: <input type="hidden" name="lextkey" value="$lextkey" />
797: <input type="hidden" name="uextkey" value="$uextkey" />
798: <b><label for="uname">$lt{'un'}</label>:</b><br />
799: <input type="text" name="uname" id="uname" size="15" value="$authusername" readonly="readonly" $mobileargs /><br />
800: <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
801: <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />
802: <b><label for="udom">$lt{'dom'}</label>:</b><br />
803: <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" $mobileargs /><br />
804: <input type="submit" value="$lt{'log'}" />
805: </form>
806: LFORM
807:
808: if ($showbanner) {
809: $r->print(<<HEADER);
810: <!-- The LON-CAPA Header -->
811: <div style="background:$pgbg;margin:0;width:100%;">
1.168 raeburn 812: <img src="$img" border="0" alt="The Learning Online Network with CAPA" class="LC_maxwidth" />
1.160 kruse 813: </div>
814: HEADER
815: }
1.184 raeburn 816:
817: my $stdauthformstyle = 'inline-block';
818: my $ssoauthstyle = 'none';
819: my $logintype;
820: $r->print('<div style="float:left;margin-top:0;">');
821: if ($saml_landing) {
822: $ssoauthstyle = 'inline-block';
823: $stdauthformstyle = 'none';
824: $logintype = $samlssotext;
825: my $ssologin = '/adm/sso';
826: if ($samlssourl ne '') {
827: $ssologin = $samlssourl;
828: }
1.192 ! raeburn 829: if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
! 830: my $querystring;
! 831: if ($env{'form.firsturl'} ne '') {
! 832: $querystring = 'origurl=';
! 833: if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
! 834: $querystring .= &uri_escape_utf8($env{'form.firsturl'});
! 835: } else {
! 836: $querystring .= &uri_escape($env{'form.firsturl'});
! 837: }
! 838: $querystring = &HTML::Entities::encode($querystring,"'");
! 839: }
! 840: if ($env{'form.ltoken'} ne '') {
! 841: $querystring .= (($querystring eq '')?'':'&') . 'ltoken='.
! 842: &HTML::Entities::encode(&uri_escape($env{'form.ltoken'}));
! 843: } elsif ($env{'form.linkkey'}) {
! 844: $querystring .= (($querystring eq '')?'':'&') . 'linkkey='.
! 845: &HTML::Entities::encode(&uri_escape($env{'form.linkkey'}));
! 846: }
! 847: if ($querystring ne '') {
! 848: $ssologin .= (($ssologin=~/\?/)?'&':'?') . $querystring;
1.188 raeburn 849: }
1.192 ! raeburn 850: } elsif ($logtoken ne '') {
! 851: $ssologin .= (($ssologin=~/\?/)?'&':'?') . 'logtoken='.$logtoken;
1.191 raeburn 852: }
1.184 raeburn 853: my $ssohref;
854: if ($samlssoimg ne '') {
855: $ssohref = '<a href="'.$ssologin.'" title="'.$samltooltip.'"><img src="'.$samlssoimg.'" alt="'.$samlssoalt.'" /></a>';
856: } else {
857: $ssohref = '<a href="'.$ssologin.'">'.$samlssotext.'</a>';
858: }
859: if (($env{'form.saml'} eq 'no') ||
860: (($env{'form.username'} ne '') && ($env{'form.domain'} ne ''))) {
861: $ssoauthstyle = 'none';
862: $stdauthformstyle = 'inline-block';
863: $logintype = $samlnonsso;
864: }
865: $r->print(<<ENDSAML);
866: <p>
867: Log-in type:
868: <span style="font-weight:bold" id="LC_login_text">$logintype</span><br />
869: <span><a href="javascript:toggleLClogin();" style="color:#000000">$lt{'change'}</a></span>
870: </p>
871: <div style="display:$ssoauthstyle" id="LC_SSO_login">
872: <div class="LC_Box" style="padding-top: 10px;">
873: $ssohref
874: $noscript_warning
875: </div>
876: <div class="LC_Box" style="padding-top: 10px;">
877: $loginhelp
878: $contactblock
879: $coursecatalog
880: </div>
881: </div>
882: ENDSAML
1.191 raeburn 883: } else {
884: if ($env{'form.ltoken'}) {
885: &Apache::lonnet::tmpdel($env{'form.ltoken'});
886: delete($env{'form.ltoken'});
887: }
1.184 raeburn 888: }
889:
890: $r->print(<<ENDLOGIN);
891: <div style="display:$stdauthformstyle;" id="LC_standard_login">
1.160 kruse 892: <div class="LC_Box" style="background:$loginbox_bg;">
893: $logintitle
894: $loginform
895: $noscript_warning
896: </div>
897:
898: <div class="LC_Box" style="padding-top: 10px;">
899: $loginhelp
900: $forgotpw
901: $contactblock
902: $newuserlink
903: $coursecatalog
904: </div>
905: </div>
906:
1.184 raeburn 907: ENDLOGIN
908: $r->print('</div><div>'."\n");
1.160 kruse 909: if ($showmainlogo) {
1.168 raeburn 910: $r->print(' <img src="'.$logo.'" alt="" class="LC_maxwidth" />'."\n");
1.160 kruse 911: }
912: $r->print(<<ENDTOP);
913: $announcements
914: </div>
915: <hr style="clear:both;" />
916: ENDTOP
917: my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
918: $domainrow = <<"END";
919: <tr>
920: <td align="left" valign="top">
921: <small><b>$lt{'dom'}: </b></small>
922: </td>
923: <td align="left" valign="top">
924: <small><tt> $domain</tt></small>
925: </td>
926: </tr>
927: END
928: $serverrow = <<"END";
929: <tr>
930: <td align="left" valign="top">
931: <small><b>$lt{'serv'}: </b></small>
932: </td>
933: <td align="left" valign="top">
934: <small><tt> $lonhost ($role)</tt></small>
935: </td>
936: </tr>
937: END
938: if ($loadlim) {
939: $loadrow = <<"END";
940: <tr>
941: <td align="left" valign="top">
942: <small><b>$lt{'load'}: </b></small>
943: </td>
944: <td align="left" valign="top">
945: <small><tt> $loadpercent $lt{'perc'}</tt></small>
946: </td>
947: </tr>
948: END
949: }
950: if ($uloadlim) {
951: $userloadrow = <<"END";
952: <tr>
953: <td align="left" valign="top">
954: <small><b>$lt{'userload'}: </b></small>
955: </td>
956: <td align="left" valign="top">
957: <small><tt> $userloadpercent $lt{'perc'}</tt></small>
958: </td>
959: </tr>
960: END
961: }
962: if (($version ne '') && ($version ne '<!-- VERSION -->')) {
963: $versionrow = <<"END";
964: <tr>
965: <td colspan="2" align="left">
966: <small>$version</small>
967: </td>
968: </tr>
969: END
970: }
971:
972: $r->print(<<ENDDOCUMENT);
973: <div style="float: left;">
974: <table border="0" cellspacing="0" cellpadding="0">
975: $domainrow
976: $serverrow
977: $loadrow
978: $userloadrow
979: $versionrow
980: </table>
981: </div>
982: <div style="float: right;">
983: $domainlogo
984: </div>
985: <br style="clear:both;" />
986: </div>
987:
988: <script type="text/javascript">
989: // <![CDATA[
990: // the if prevents the script error if the browser can not handle this
991: if ( document.client.uname ) { document.client.uname.focus(); }
992: // ]]>
993: </script>
994: $helpdeskscript
995:
996: ENDDOCUMENT
997: my %endargs = ( 'noredirectlink' => 1, );
998: $r->print(&Apache::loncommon::end_page(\%endargs));
999: return OK;
1000: }
1001:
1002: sub check_loginvia {
1.192 ! raeburn 1003: my ($domain,$lonhost,$lonidsdir,$balcookie,$linkprot,$linkkey) = @_;
1.176 raeburn 1004: if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') {
1.160 kruse 1005: return;
1006: }
1007: my %domconfhash = &Apache::loncommon::get_domainconf($domain);
1008: my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
1009: my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
1010: my $output;
1011: if ($loginvia ne '') {
1012: my $noredirect;
1.182 raeburn 1013: my $ip = &Apache::lonnet::get_requestor_ip();
1.160 kruse 1014: if ($ip eq '127.0.0.1') {
1015: $noredirect = 1;
1016: } else {
1017: if ($loginvia_exempt ne '') {
1018: my @exempt = split(',',$loginvia_exempt);
1019: if (grep(/^\Q$ip\E$/,@exempt)) {
1020: $noredirect = 1;
1021: }
1022: }
1023: }
1024: unless ($noredirect) {
1025: my ($newhost,$path);
1026: if ($loginvia =~ /:/) {
1027: ($newhost,$path) = split(':',$loginvia);
1028: } else {
1029: $newhost = $loginvia;
1030: }
1031: if ($newhost ne $lonhost) {
1032: if (&Apache::lonnet::hostname($newhost) ne '') {
1.176 raeburn 1033: if ($balcookie) {
1034: my ($balancer,$cookie) = split(/:/,$balcookie);
1035: if ($cookie =~ /^($match_domain)_($match_username)_([a-f0-9]+)$/) {
1036: my ($udom,$uname,$cookieid) = ($1,$2,$3);
1037: unless (&Apache::lonnet::delbalcookie($cookie,$balancer) eq 'ok') {
1038: if ((-d $lonidsdir) && (opendir(my $dh,$lonidsdir))) {
1039: while (my $filename=readdir($dh)) {
1040: if ($filename=~/^(\Q$uname\E_\d+_\Q$udom\E_$match_lonid)\.id$/) {
1041: my $handle = $1;
1042: my %hash =
1043: &Apache::lonnet::get_sessionfile_vars($handle,$lonidsdir,
1044: ['request.balancercookie',
1045: 'user.linkedenv']);
1046: if ($hash{'request.balancercookie'} eq "$balancer:$cookieid") {
1047: if (unlink("$lonidsdir/$filename")) {
1048: if (($hash{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
1049: (-l "$lonidsdir/$hash{'user.linkedenv'}.id") &&
1050: (readlink("$lonidsdir/$hash{'user.linkedenv'}.id") eq "$lonidsdir/$filename")) {
1051: unlink("$lonidsdir/$hash{'user.linkedenv'}.id");
1052: }
1053: }
1054: }
1055: last;
1056: }
1057: }
1058: closedir($dh);
1059: }
1060: }
1061: }
1062: }
1.192 ! raeburn 1063: $output = &redirect_page($newhost,$path,$linkprot,$linkkey);
1.160 kruse 1064: }
1065: }
1066: }
1067: }
1068: return $output;
1069: }
1070:
1071: sub redirect_page {
1.192 ! raeburn 1072: my ($desthost,$path,$linkprot,$linkkey) = @_;
1.178 raeburn 1073: my $hostname = &Apache::lonnet::hostname($desthost);
1.160 kruse 1074: my $protocol = $Apache::lonnet::protocol{$desthost};
1075: $protocol = 'http' if ($protocol ne 'https');
1076: unless ($path =~ m{^/}) {
1077: $path = '/'.$path;
1078: }
1.178 raeburn 1079: my $url = $protocol.'://'.$hostname.$path;
1.160 kruse 1080: if ($env{'form.firsturl'} ne '') {
1.188 raeburn 1081: my $querystring;
1082: if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
1083: $querystring = &uri_escape_utf8($env{'form.firsturl'});
1084: } else {
1085: $querystring = &uri_escape($env{'form.firsturl'});
1086: }
1087: $querystring = &HTML::Entities::encode($querystring,"'");
1.192 ! raeburn 1088: $url .='?firsturl='.$querystring;
1.160 kruse 1089: }
1.177 raeburn 1090: if ($linkprot) {
1091: my $ltoken = &Apache::lonnet::tmpput({linkprot => $linkprot},$desthost);
1092: if ($ltoken) {
1.187 raeburn 1093: $url .= (($url =~ /\?/) ? '&' : '?').'ltoken='.$ltoken;
1.177 raeburn 1094: }
1.192 ! raeburn 1095: } elsif ($linkkey) {
! 1096: $url .= (($url =~ /\?/) ? '&' : '?').'linkkey='.&uri_escape($linkkey);
1.177 raeburn 1097: }
1.160 kruse 1098: my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
1099: {'redirect' => [0,$url],});
1100: my $end_page = &Apache::loncommon::end_page();
1101: return $start_page.$end_page;
1102: }
1103:
1104: sub contactdisplay {
1105: my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk,
1106: $possdoms) = @_;
1107: my $contactblock;
1108: my $origmail;
1109: if (ref($possdoms) eq 'ARRAY') {
1110: if (grep(/^\Q$authdomain\E$/,@{$possdoms})) {
1111: $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
1112: }
1113: }
1114: my $requestmail =
1115: &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
1116: $authdomain,$origmail);
1117: unless ($showhelpdesk eq '0') {
1118: if ($requestmail =~ m/[^\@]+\@[^\@]+/) {
1119: $showhelpdesk = 1;
1120: } else {
1121: $showhelpdesk = 0;
1122: }
1123: }
1124: if ($servadm && $showadminmail) {
1125: $contactblock .= $$lt{'servadm'}.':<br />'.
1126: '<tt>'.$servadm.'</tt><br />';
1127: }
1128: if ($showhelpdesk) {
1129: $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
1130: my $thisurl = &escape('/adm/login');
1131: $$helpdeskscript = <<"ENDSCRIPT";
1132: <script type="text/javascript">
1133: // <![CDATA[
1134: function helpdesk() {
1135: var possdom = document.client.udom.value;
1136: var codedom = possdom.replace( new RegExp("[^A-Za-z0-9.\\-]","g"),'');
1137: if (codedom == '') {
1138: codedom = "$authdomain";
1139: }
1140: var querystr = "origurl=$thisurl&codedom="+codedom;
1141: document.location.href = "/adm/helpdesk?"+querystr;
1142: return;
1143: }
1144: // ]]>
1145: </script>
1146: ENDSCRIPT
1147: }
1148: return $contactblock;
1149: }
1150:
1151: sub forgotpwdisplay {
1152: my (%lt) = @_;
1153: my $prompt_for_resetpw = 1;
1154: if ($prompt_for_resetpw) {
1155: return '<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a>';
1156: }
1157: return;
1158: }
1159:
1160: sub coursecatalog_link {
1161: my ($linkname) = @_;
1162: return <<"END";
1163: <a href="/adm/coursecatalog">$linkname</a>
1164: END
1165: }
1166:
1167: sub newuser_link {
1168: my ($linkname) = @_;
1169: return '<a href="/adm/createaccount">'.$linkname.'</a>';
1170: }
1171:
1.192 ! raeburn 1172: sub decode_token {
! 1173: my ($info) = @_;
! 1174: my ($firsturl,@rest)=split(/\&/,$info);
! 1175: my %form;
! 1176: if ($firsturl ne '') {
! 1177: $form{'firsturl'} = &unescape($firsturl);
! 1178: }
! 1179: foreach my $item (@rest) {
! 1180: my ($key,$value) = split(/=/,$item);
! 1181: $form{$key} = &unescape($value);
! 1182: }
! 1183: return %form;
! 1184: }
! 1185:
1.160 kruse 1186: 1;
1187: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>