Annotation of loncom/auth/lonlogin.pm, revision 1.184

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.