[BACK]Return to lonlogin.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/lonlogin.pm between versions 1.110 and 1.158.2.14

version 1.110, 2008/12/03 13:07:15 version 1.158.2.14, 2022/01/16 19:43:41
Line 37  use Apache::lonauth(); Line 37  use Apache::lonauth();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::migrateuser();  use Apache::migrateuser();
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
   use URI::Escape;
   use HTML::Entities();
   use CGI::Cookie();
     
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
Line 46  sub handler { Line 49  sub handler {
  (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
       $ENV{'REDIRECT_QUERY_STRING'}),        $ENV{'REDIRECT_QUERY_STRING'}),
  ['interface','username','domain','firsturl','localpath','localres',   ['interface','username','domain','firsturl','localpath','localres',
   'token']);    'token','role','symb','iptoken','btoken','saml','sso','retry']);
     if (!defined($env{'form.firsturl'})) {  
         &Apache::lonacc::get_posted_cgi($r,['firsturl']);  
     }  
   
 # -- check if they are a migrating user  # -- check if they are a migrating user
     if (defined($env{'form.token'})) {      if (defined($env{'form.token'})) {
  return &Apache::migrateuser::handler($r);   return &Apache::migrateuser::handler($r);
     }      }
   
       my $lonhost = $r->dir_config('lonHostID');
       if (($env{'form.sso'}) || ($env{'form.retry'})) {
           my $infotoken;
           if ($env{'form.sso'}) {
               $infotoken = $env{'form.sso'};
           } else {
               $infotoken = $env{'form.retry'};
           }
           my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
           unless (($data=~/^error/) || ($data eq 'con_lost') ||
                   ($data eq 'no_such_host')) {
               my %info = &decode_token($data);
               foreach my $item (keys(%info)) {
                   $env{'form.'.$item} = $info{$item};
               }
               &Apache::lonnet::tmpdel($infotoken);
           }
       } else {
           if (!defined($env{'form.firsturl'})) {
               &Apache::lonacc::get_posted_cgi($r,['firsturl']);
           }
           if ($env{'form.firsturl'} eq '/adm/logout') {
               delete($env{'form.firsturl'});
           }
       }
   
   # For "public user" - remove any exising "public" cookie, as user really wants to log-in
       my ($handle,$lonidsdir,$expirepub,$userdom);
       $lonidsdir=$r->dir_config('lonIDsDir');
       unless ($r->header_only) {
           $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
           if ($handle ne '') {
               if ($handle=~/^publicuser\_/) {
                   unlink($r->dir_config('lonIDsDir')."/$handle.id");
                   undef($handle);
                   undef($userdom);
                   $expirepub = 1;
               }
           }
       }
   
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
     &Apache::lonlocal::get_language_handle($r);      &Apache::lonlocal::get_language_handle($r);
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
       if ($expirepub) {
           my $c = new CGI::Cookie(-name    => 'lonPubID',
                                   -value   => '',
                                   -expires => '-10y',);
           $r->header_out('Set-cookie' => $c);
       } elsif (($handle eq '') && ($userdom ne '')) {
           my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
           foreach my $name (keys(%cookies)) {
               next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
               my $c = new CGI::Cookie(-name    => $name,
                                       -value   => '',
                                       -expires => '-10y',);
               $r->headers_out->add('Set-cookie' => $c);
           }
       }
     $r->send_http_header;      $r->send_http_header;
     return OK if $r->header_only;      return OK if $r->header_only;
   
   
 # Are we re-routing?  # Are we re-routing?
     if (-e '/home/httpd/html/lon-status/reroute.txt') {      my $londocroot = $r->dir_config('lonDocRoot'); 
       if (-e "$londocroot/lon-status/reroute.txt") {
  &Apache::lonauth::reroute($r);   &Apache::lonauth::reroute($r);
  return OK;   return OK;
     }      }
   
   # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
   
       my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
       if ($found_server) {
           my $hostname = &Apache::lonnet::hostname($found_server);
           if ($hostname ne '') {
               my $protocol = $Apache::lonnet::protocol{$found_server};
               $protocol = 'http' if ($protocol ne 'https');
               my $dest = '/adm/roles';
               if ($env{'form.firsturl'} ne '') {
                   $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
               }
               my %info = (
                            balcookie => $lonhost.':'.$balancer_cookie,
                          );
               if ($env{'form.role'}) {
                   $info{'role'} = $env{'form.role'};
               }
               if ($env{'form.symb'}) {
                   $info{'symb'} = $env{'form.symb'};
               }
               my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
               unless (($balancer_token eq 'con_lost') || ($balancer_token eq 'refused') ||
                       ($balancer_token eq 'unknown_cmd') || ($balancer_token eq 'no_such_host')) {
                   $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'btoken='.$balancer_token;
               }
               unless ($found_server eq $lonhost) {
                   my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server);
                   $hostname = $alias if ($alias ne '');
               }
               my $url = $protocol.'://'.$hostname.$dest;
               my $start_page =
                   &Apache::loncommon::start_page('Switching Server ...',undef,
                                                  {'redirect'       => [0,$url],});
               my $end_page   = &Apache::loncommon::end_page();
               $r->print($start_page.$end_page);
               return OK;
           }
       }
   
   #
   # Check if a LON-CAPA load balancer sent user here because user's browser sent
   # it a balancer cookie for an active session on this server.
   #
   
       my $balcookie;
       if ($env{'form.btoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
           $balcookie = $info{'balcookie'};
           &Apache::lonnet::tmpdel($env{'form.btoken'});
           delete($env{'form.btoken'});
       }
   
   #
   # If browser sent an old cookie for which the session file had been removed
   # check if configuration for user's domain has a portal URL set.  If so
   # switch user's log-in to the portal.
   #
   
       if (($handle eq '') && ($userdom ne '')) {
           my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom);
           if ($domdefaults{'portal_def'} =~ /^https?\:/) {
               my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                             {'redirect' => [0,$domdefaults{'portal_def'}],});
               my $end_page   = &Apache::loncommon::end_page();
               $r->print($start_page.$end_page);
               return OK;
           }
       }
   
 # -------------------------------- Prevent users from attempting to login twice  # -------------------------------- Prevent users from attempting to login twice
     my $handle = &Apache::lonnet::check_for_valid_session($r);      if ($handle ne '') {
     if ($handle=~/^publicuser\_/) {          &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
 # For "public user" - remove it, we apparently really want to login  
  unlink($r->dir_config('lonIDsDir')."/$handle.id");  
     } elsif ($handle ne '') {  
 # Indeed, a valid token is found  
  my $start_page =    my $start_page = 
     &Apache::loncommon::start_page('Already logged in');      &Apache::loncommon::start_page('Already logged in');
  my $end_page =    my $end_page = 
     &Apache::loncommon::end_page();      &Apache::loncommon::end_page();
           my $dest = '/adm/roles';
           if ($env{'form.firsturl'} ne '') {
               $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
           }
  $r->print(   $r->print(
                   $start_page                $start_page
                  .'<h1>'.&mt('You are already logged in!').'</h1>'               .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
                  .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]logout[_4].',               .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
                   '<a href="/adm/roles">','</a>','<a href="/adm/logout">','</a>').'</p>'                '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'
                  .'<p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'               .$end_page
                  .$end_page               );
                  );  
         return OK;          return OK;
     }      }
   
 # ---------------------------------------------------- No valid token, continue  # ---------------------------------------------------- No valid token, continue
   
  # ---------------------------- Not possible to really login to domain "public"  # ---------------------------- Not possible to really login to domain "public"
     if ($env{'form.domain'} eq 'public') {      if ($env{'form.domain'} eq 'public') {
  $env{'form.domain'}='';   $env{'form.domain'}='';
  $env{'form.username'}='';   $env{'form.username'}='';
     }      }
   
   # ------ Is this page requested because /adm/migrateuser detected an IP change?
       my %sessiondata;
       if ($env{'form.iptoken'}) {
           %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'});
           unless ($sessiondata{'sessionserver'}) {
               my $delete = &Apache::lonnet::tmpdel($env{'form.iptoken'});
               delete($env{'form.iptoken'});
           }
       }
 # ----------------------------------------------------------- Process Interface  # ----------------------------------------------------------- Process Interface
     $env{'form.interface'}=~s/\W//g;      $env{'form.interface'}=~s/\W//g;
   
    # my $textbrowsers=$r->dir_config('lonTextBrowsers');      (undef,undef,undef,undef,undef,undef,my $clientmobile) =
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};          &Apache::loncommon::decode_user_agent($r);
       
    # foreach (split(/\:/,$textbrowsers)) {  
 # if ($httpbrowser=~/$_/i) {  
 #    $env{'form.interface'}='textual';  
 #        }  
 #    }  
   
     my $fullgraph=($env{'form.interface'} ne 'textual');  
   
     my $iconpath=       my $iconpath= 
  &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));   &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
   
     my $domain = &Apache::lonnet::default_login_domain();      my $domain = &Apache::lonnet::default_login_domain();
     if (($env{'form.domain'}) &&       my $defdom = $domain;
       if ($lonhost ne '') {
           unless ($sessiondata{'sessionserver'}) {
               my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie);
               if ($redirect) {
                   $r->print($redirect);
                   return OK;
               }
           }
       }
   
       if (($sessiondata{'domain'}) &&
           (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
           $domain=$sessiondata{'domain'};
       } elsif (($env{'form.domain'}) && 
  (&Apache::lonnet::domain($env{'form.domain'},'description'))) {   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
  $domain=$env{'form.domain'};   $domain=$env{'form.domain'};
     }      }
   
     my $role    = $r->dir_config('lonRole');      my $role    = $r->dir_config('lonRole');
     my $loadlim = $r->dir_config('lonLoadLim');      my $loadlim = $r->dir_config('lonLoadLim');
       my $uloadlim= $r->dir_config('lonUserLoadLim');
     my $servadm = $r->dir_config('lonAdmEMail');      my $servadm = $r->dir_config('lonAdmEMail');
     my $lonhost = $r->dir_config('lonHostID');  
     my $tabdir  = $r->dir_config('lonTabDir');      my $tabdir  = $r->dir_config('lonTabDir');
     my $include = $r->dir_config('lonIncludes');      my $include = $r->dir_config('lonIncludes');
     my $expire  = $r->dir_config('lonExpire');      my $expire  = $r->dir_config('lonExpire');
Line 132  sub handler { Line 274  sub handler {
     my $host_name = &Apache::lonnet::hostname($lonhost);      my $host_name = &Apache::lonnet::hostname($lonhost);
   
 # --------------------------------------------- Default values for login fields  # --------------------------------------------- Default values for login fields
       
     my $authusername=($env{'form.username'}?$env{'form.username'}:'');      my ($authusername,$authdomain);
     my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);      if ($sessiondata{'username'}) {
           $authusername=$sessiondata{'username'};
       } else {
           $env{'form.username'} = &Apache::loncommon::cleanup_html($env{'form.username'});
           $authusername=($env{'form.username'}?$env{'form.username'}:'');
       }
       if ($sessiondata{'domain'}) {
           $authdomain=$sessiondata{'domain'};
       } else {
           $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'});
           $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
       }
   
 # ---------------------------------------------------------- Determine own load  # ---------------------------------------------------------- Determine own load
     my $loadavg;      my $loadavg;
Line 143  sub handler { Line 296  sub handler {
  $loadavg=<$loadfile>;   $loadavg=<$loadfile>;
     }      }
     $loadavg =~ s/\s.*//g;      $loadavg =~ s/\s.*//g;
     my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);  
     my $userloadpercent=&Apache::lonnet::userload();  
   
 # ------------------------------------------------------- Do the load balancing      my ($loadpercent,$userloadpercent);
     my $otherserver= &Apache::lonnet::absolute_url($host_name);      if ($loadlim) {
           $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
       }
       if ($uloadlim) {
           $userloadpercent=&Apache::lonnet::userload();
       }
   
     my $firsturl=      my $firsturl=
     ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});      ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
 # ---------------------------------------------------------- Are we overloaded?  
     if ((($userloadpercent>100.0)||($loadpercent>100.0))) {  
         my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent);  
  if ($unloaded) { $otherserver=$unloaded; }  
     }  
   
 # ----------------------------------------------------------- Get announcements  # ----------------------------------------------------------- Get announcements
     my $announcements=&Apache::lonnet::getannounce();      my $announcements=&Apache::lonnet::getannounce();
Line 179  sub handler { Line 331  sub handler {
     if ($uextkey>2147483647) { $uextkey-=4294967296; }      if ($uextkey>2147483647) { $uextkey-=4294967296; }
   
 # -------------------------------------------------------- Store away log token  # -------------------------------------------------------- Store away log token
       my $tokenextras;
       my @names = ('role','symb','iptoken');
       foreach my $name (@names) {
           if ($env{'form.'.$name} ne '') {
               $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
           }
       }
     my $logtoken=Apache::lonnet::reply(      my $logtoken=Apache::lonnet::reply(
        'tmpput:'.$ukey.$lkey.'&'.$firsturl,         'tmpput:'.$ukey.$lkey.'&'.&escape($firsturl).$tokenextras,
        $lonhost);         $lonhost);
   
 # ------------------- If we cannot talk to ourselves, we are in serious trouble  # -- If we cannot talk to ourselves, or hostID does not map to a hostname
   #    we are in serious trouble
   
     if ($logtoken eq 'con_lost') {      if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
           if ($logtoken eq 'no_such_host') {
               &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
           }
         my $spares='';          my $spares='';
  my $last;          my (@sparehosts,%spareservers);
         foreach my $hostid (sort          my $sparesref = &Apache::lonnet::this_host_spares($defdom);
     {          if (ref($sparesref) eq 'HASH') {
  &Apache::lonnet::hostname($a) cmp              foreach my $key (keys(%{$sparesref})) {
     &Apache::lonnet::hostname($b);                  if (ref($sparesref->{$key}) eq 'ARRAY') {
     }                      my @sorted = sort { &Apache::lonnet::hostname($a) cmp
     keys(%Apache::lonnet::spareid)) {                                          &Apache::lonnet::hostname($b);
                                         } @{$sparesref->{$key}};
                       if (@sorted) {
                           if ($key eq 'primary') {
                               unshift(@sparehosts,@sorted);
                           } elsif ($key eq 'default') {
                               push(@sparehosts,@sorted);
                           }
                       }
                   }
               }
           }
           foreach my $hostid (@sparehosts) {
             next if ($hostid eq $lonhost);              next if ($hostid eq $lonhost);
     my $hostname = &Apache::lonnet::hostname($hostid);      my $hostname = &Apache::lonnet::hostname($hostid);
     next if ($last eq $hostname);      next if (($hostname eq '') || ($spareservers{$hostname}));
             $spares.='<br /><font size="+1"><a href="http://'.              $spareservers{$hostname} = 1;
               my $protocol = $Apache::lonnet::protocol{$hostid};
               $protocol = 'http' if ($protocol ne 'https');
               $spares.='<br /><span style="font-size: larger;"><a href="'.$protocol.'://'.
                 $hostname.                  $hostname.
                 '/adm/login?domain='.$authdomain.'">'.                  '/adm/login?domain='.$authdomain.'">'.
                 $hostname.'</a>'.                  $hostname.'</a>'.
                 ' '.&mt('(preferred)').'</font>'.$/;                  ' '.&mt('(preferred)').'</span>'.$/;
     $last=$hostname;          }
           if ($spares) {
               $spares.= '<br />';
         }          }
 $spares.= '<br />';          my %all_hostnames = &Apache::lonnet::all_hostnames();
 my %all_hostnames = &Apache::lonnet::all_hostnames();          foreach my $hostid (sort
 foreach my $hostid (sort  
     {      {
  &Apache::lonnet::hostname($a) cmp   &Apache::lonnet::hostname($a) cmp
     &Apache::lonnet::hostname($b);      &Apache::lonnet::hostname($b);
     }      }
     keys(%all_hostnames)) {      keys(%all_hostnames)) {
     next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});              next if ($hostid eq $lonhost);
     my $hostname = &Apache::lonnet::hostname($hostid);              my $hostname = &Apache::lonnet::hostname($hostid);
     next if ($last eq $hostname);              next if (($hostname eq '') || ($spareservers{$hostname}));
     $spares.='<br /><a href="http://'.              $spareservers{$hostname} = 1;
  $hostname.              my $protocol = $Apache::lonnet::protocol{$hostid};
  '/adm/login?domain='.$authdomain.'">'.              $protocol = 'http' if ($protocol ne 'https');
  $hostname.'</a>';              $spares.='<br /><a href="'.$protocol.'://'.
     $last=$hostname;               $hostname.
 }               '/adm/login?domain='.$authdomain.'">'.
 $r->print(               $hostname.'</a>';
    '<html>'           }
   .'<head><title>'           $r->print(
      '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
     .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'
     .'<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" /><title>'
   .&mt('The LearningOnline Network with CAPA')    .&mt('The LearningOnline Network with CAPA')
   .'</title></head>'    .'</title></head>'
   .'<body bgcolor="#FFFFFF">'    .'<body bgcolor="#FFFFFF">'
   .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'    .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
   .'<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />'    .'<img src="/adm/lonKaputt/lonlogo_broken.gif" alt="broken icon" align="right" />'
   .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>'    .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
   .'<p>'.&mt('Please attempt to login to one of the following servers:').'</p>'          if ($spares) {
   .$spares              $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
   .'</body>'                       .'</p>'
   .'</html>'                       .$spares);
 );          }
 return OK;          $r->print('</body>'
 }                   .'</html>'
           );
           return OK;
       }
   
 # ----------------------------------------------- Apparently we are in business  # ----------------------------------------------- Apparently we are in business
 $servadm=~s/\,/\<br \/\>/g;      $servadm=~s/\,/\<br \/\>/g;
   
 # ----------------------------------------------------------- Front page design  # ----------------------------------------------------------- Front page design
 my $pgbg=      my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
 ($fullgraph?&Apache::loncommon::designparm('login.pgbg',$domain):'#FFFFFF');      my $font=&Apache::loncommon::designparm('login.font',$domain);
 my $font=      my $link=&Apache::loncommon::designparm('login.link',$domain);
 ($fullgraph?&Apache::loncommon::designparm('login.font',$domain):'#000000');      my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
 my $link=      my $alink=&Apache::loncommon::designparm('login.alink',$domain);
 ($fullgraph?&Apache::loncommon::designparm('login.link',$domain):'#0000FF');      my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
 my $vlink=      my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
 ($fullgraph?&Apache::loncommon::designparm('login.vlink',$domain):'#0000FF');      my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
 my $alink=&Apache::loncommon::designparm('login.alink',$domain);      my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
 my $mainbg=      my $logo=&Apache::loncommon::designparm('login.logo',$domain);
 ($fullgraph?&Apache::loncommon::designparm('login.mainbg',$domain):'#FFFFFF');      my $img=&Apache::loncommon::designparm('login.img',$domain);
 my $textcol =       my $domainlogo=&Apache::loncommon::domainlogo($domain);
 ($fullgraph?&Apache::loncommon::designparm('login.textcol',$domain):'#000000');      my $showbanner = 1;
 my $bgcol =      my $showmainlogo = 1;
 ($fullgraph?&Apache::loncommon::designparm('login.bgcol',$domain):'#FFFFFF');      if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
 my $logo=&Apache::loncommon::designparm('login.logo',$domain);          $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
 my $img=&Apache::loncommon::designparm('login.img',$domain);      }
 my $domainlogo=&Apache::loncommon::domainlogo($domain);      if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
 my $login=&Apache::loncommon::designparm('login.login',$domain);          $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
 if ($login eq '') {      }
 $login = $iconpath.'/'.&mt('userauthentication.gif');      my $showadminmail;
 }      my @possdoms = &Apache::lonnet::current_machine_domains();
 my $showbanner = 1;      if (grep(/^\Q$domain\E$/,@possdoms)) {
 my $showmainlogo = 1;          $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
 if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {      }
     $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);      my $showcoursecat =
 }          &Apache::loncommon::designparm('login.coursecatalog',$domain);
 if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {      my $shownewuserlink = 
     $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);          &Apache::loncommon::designparm('login.newuser',$domain);
 }      my $showhelpdesk =
 my $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);          &Apache::loncommon::designparm('login.helpdesk',$domain);
 my $showcoursecat =      my $now=time;
 &Apache::loncommon::designparm('login.coursecatalog',$domain);      my $js = (<<ENDSCRIPT);
 my $loginheader =&Apache::loncommon::designparm('login.loginheader',$domain);  
 my $shownewuserlink =   
 &Apache::loncommon::designparm('login.newuser',$domain);  
 my $now=time;  
 my $js = (<<ENDSCRIPT);  
   
 <script language="JavaScript">  <script type="text/javascript" language="JavaScript">
   // <![CDATA[
 function send()  function send()
 {  {
 this.document.server.elements.uname.value  this.document.server.elements.uname.value
Line 295  lextkey=this.document.client.elements.le Line 476  lextkey=this.document.client.elements.le
 initkeys();  initkeys();
   
 this.document.server.elements.upass0.value  this.document.server.elements.upass0.value
     =crypted(this.document.client.elements.upass$now.value.substr(0,15));      =getCrypted(this.document.client.elements.upass$now.value);
 this.document.server.elements.upass1.value  
     =crypted(this.document.client.elements.upass$now.value.substr(15,15));  
 this.document.server.elements.upass2.value  
     =crypted(this.document.client.elements.upass$now.value.substr(30,15));  
   
 this.document.client.elements.uname.value='';  this.document.client.elements.uname.value='';
 this.document.client.elements.upass$now.value='';  this.document.client.elements.upass$now.value='';
Line 307  this.document.client.elements.upass$now. Line 484  this.document.client.elements.upass$now.
 this.document.server.submit();  this.document.server.submit();
 return false;  return false;
 }  }
   
   function enableInput() {
       this.document.client.elements.upass$now.removeAttribute("readOnly");
       this.document.client.elements.uname.removeAttribute("readOnly");
       this.document.client.elements.udom.removeAttribute("readOnly");
       return;
   }
   
   // ]]>
 </script>  </script>
   
 ENDSCRIPT  ENDSCRIPT
   
       my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
           $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip);
       %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
       @hosts = &Apache::lonnet::current_machine_ids();
       $lonhost_in_use = $lonhost;
       if (@hosts > 1) {
           foreach my $hostid (@hosts) {
               if (&Apache::lonnet::host_domain($hostid) eq $defdom) {
                   $lonhost_in_use = $hostid;
                   last;
               }
           }
       }
       $saml_prefix = $defdom.'.login.saml_';
       if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) {
           $saml_landing = 1;
           $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use};
           $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use};
           $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use};
           $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use};
           $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use};
           $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use};
       }
       if ($saml_landing) {
          if ($samlssotext eq '') {
              $samlssotext = 'SSO Login';
          }
          if ($samlnonsso eq '') {
              $samlnonsso = 'Non-SSO Login';
          }
          $js .= <<"ENDSAMLJS";
   
   <script type="text/javascript">
   // <![CDATA[
   function toggleLClogin() {
       if (document.getElementById('LC_standard_login')) {
           if (document.getElementById('LC_standard_login').style.display == 'none') {
               document.getElementById('LC_standard_login').style.display = 'inline-block';
               if (document.getElementById('LC_login_text')) {
                   document.getElementById('LC_login_text').innerHTML = '$samlnonsso';
               }
               if (document.getElementById('LC_SSO_login')) {
                   document.getElementById('LC_SSO_login').style.display = 'none';
               }
           } else {
               document.getElementById('LC_standard_login').style.display = 'none';
               if (document.getElementById('LC_login_text')) {
                   document.getElementById('LC_login_text').innerHTML = '$samlssotext';
               }
               if (document.getElementById('LC_SSO_login')) {
                   document.getElementById('LC_SSO_login').style.display = 'inline-block';
               }
           }
       }
       return;
   }
   
   // ]]>
   </script>
   
   ENDSAMLJS
       }
   
 # --------------------------------------------------- Print login screen header  # --------------------------------------------------- Print login screen header
   
 my %add_entries = (topmargin    => "0",      my %add_entries = (
        leftmargin   => "0",  
        marginheight => "0",  
        marginwidth  => "0",  
        bgcolor      => "$mainbg",         bgcolor      => "$mainbg",
        text         => "$font",         text         => "$font",
        link         => "$link",         link         => "$link",
        vlink        => "$vlink",         vlink        => "$vlink",
        alink        => "$alink",);         alink        => "$alink",
                  onload       => 'javascript:enableInput();',);
   
 $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,      my ($headextra,$headextra_exempt);
       $headextra = $defaultdomconf{$defdom.'.login.headtag_'.$lonhost_in_use};
       $headextra_exempt = $defaultdomconf{$domain.'.login.headtag_exempt_'.$lonhost_in_use};
       if ($headextra) {
           my $omitextra;
           if ($headextra_exempt ne '') {
               my @exempt = split(',',$headextra_exempt);
               my $ip = &Apache::lonnet::get_requestor_ip();
               if (grep(/^\Q$ip\E$/,@exempt)) {
                   $omitextra = 1;
               }
           }
           unless ($omitextra) {
               my $confname = $defdom.'-domainconfig';
               if ($headextra =~ m{^\Q/res/$defdom/$confname/login/headtag/$lonhost_in_use/\E}) {
                   my $extra = &Apache::lonnet::getfile(&Apache::lonnet::filelocation("",$headextra));
                   unless ($extra eq '-1') {
                       $js .= "\n".$extra."\n";
                   }
               }
           }
       }
   
       $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
        { 'redirect'       => [$expire,'/adm/roles'],          { 'redirect'       => [$expire,'/adm/roles'], 
  'add_entries' => \%add_entries,   'add_entries' => \%add_entries,
  'only_body'   => 1,}));   'only_body'   => 1,}));
   
 # ----------------------------------------------------------------------- Texts  # ----------------------------------------------------------------------- Texts
   
 my %lt=&Apache::lonlocal::texthash(      my %lt=&Apache::lonlocal::texthash(
   'un'  => 'Username',            'un'       => 'Username',
   'pw'  => 'Password',            'pw'       => 'Password',
   'dom' => 'Domain',            'dom'      => 'Domain',
   'perc' => 'percent',            'perc'     => 'percent',
   'load' => 'Server Load',            'load'     => 'Server Load',
   'userload' => 'User Load',            'userload' => 'User Load',
   'about'  => 'About LON-CAPA',            'catalog'  => 'Course/Community Catalog',
   'catalog' => 'Course Catalog',            'log'      => 'Log in',
   'log' => 'Log in',            'help'     => 'Log-in Help',
   'help' => 'Log-in Help',            'serv'     => 'Server',
   'serv' => 'Server',            'servadm'  => 'Server Administration',
   'servadm' => 'Server Administration',            'helpdesk' => 'Contact Helpdesk',
   'helpdesk' => 'Contact Helpdesk',            'forgotpw' => 'Forgot password?',
   'forgotpw' => 'Forgot password?',            'newuser'  => 'New User?',
   'newuser'  => 'New User?',            'change'   => 'Change?',
   'options_headline' => 'Select Accessibility Options',         );
   'sprs_img' => 'Suppress rendering of images',  
   'sprs_applet' => 'Suppress Java applets',  
   'sprs_embed' => 'Suppress rendering of embedded multimedia',  
   'sprs_font' => 'Increase font size',  
   'sprs_blackwhite' => 'Switch to black and white mode',  
   'remember' => 'Remember these settings for next login');  
 # -------------------------------------------------- Change password field name  # -------------------------------------------------- Change password field name
 my $forgotpw = &forgotpwdisplay(%lt);  
 my $loginhelp = &loginhelpdisplay(%lt);      my $forgotpw = &forgotpwdisplay(%lt);
       $forgotpw .= '<br />' if $forgotpw;
       my $loginhelp = &Apache::lonauth::loginhelpdisplay($authdomain);
       if ($loginhelp) {
           $loginhelp = '<a href="'.$loginhelp.'">'.$lt{'help'}.'</a><br />';
       }
   
 # ---------------------------------------------------- Serve out DES JavaScript  # ---------------------------------------------------- Serve out DES JavaScript
 {      {
 my $jsh=Apache::File->new($include."/londes.js");      my $jsh=Apache::File->new($include."/londes.js");
 $r->print(<$jsh>);      $r->print(<$jsh>);
 }      }
 # ---------------------------------------------------------- Serve rest of page  # ---------------------------------------------------------- Serve rest of page
   
 if ($fullgraph) {      $r->print(
 $r->print(      '<div class="LC_Box"'
   '<div class="LC_loginpage_container">');     .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
 }  );
   
 $r->print(<<ENDSERVERFORM);      $r->print(<<ENDSERVERFORM);
 <form name="server" action="$otherserver/adm/authenticate" method="post" target="_top">  <form name="server" action="/adm/authenticate" method="post" target="_top">
    <input type="hidden" name="logtoken" value="$logtoken" />     <input type="hidden" name="logtoken" value="$logtoken" />
    <input type="hidden" name="serverid" value="$lonhost" />     <input type="hidden" name="serverid" value="$lonhost" />
    <input type="hidden" name="uname" value="" />     <input type="hidden" name="uname" value="" />
    <input type="hidden" name="upass0" value="" />     <input type="hidden" name="upass0" value="" />
    <input type="hidden" name="upass1" value="" />  
    <input type="hidden" name="upass2" value="" />  
    <input type="hidden" name="udom" value="" />     <input type="hidden" name="udom" value="" />
    <input type="hidden" name="localpath" value="$env{'form.localpath'}" />     <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
    <input type="hidden" name="localres" value="$env{'form.localres'}" />     <input type="hidden" name="localres" value="$env{'form.localres'}" />
   </form>    </form>
 ENDSERVERFORM  ENDSERVERFORM
 my $coursecatalog;      my $coursecatalog;
 if (($showcoursecat eq '') || ($showcoursecat)) {      if (($showcoursecat eq '') || ($showcoursecat)) {
     $coursecatalog = &coursecatalog_link($lt{'catalog'});          $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
 }      }
 my $newuserlink;      my $newuserlink;
 if ($shownewuserlink) {      if ($shownewuserlink) {
     $newuserlink = &newuser_link($lt{'newuser'});          $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
 }      }
 my $logintitle;      my $logintitle =
 if ($loginheader eq 'text') {          '<h2 class="LC_hcell"'
     $logintitle = $lt{'log'};         .' style="background:'.$loginbox_header_bgcol.';'
 } else {         .' color:'.$loginbox_header_textcol.'">'
     $logintitle = '<img src="'.$login.'" alt="'.         .$lt{'log'}
                   &mt('User Authentication').'" />';         .'</h2>';
 }  
       my $noscript_warning='<noscript><span class="LC_warning"><b>'
 my $noscript_warning='<noscript><span class="LC_warning"><b>'                          .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
                      .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')                          .'</b></span></noscript>';
                     .'</b></span></noscript>';      my $helpdeskscript;
 my $helpdeskscript;      my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
 my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,                                         $authdomain,\$helpdeskscript,
                             $version,$authdomain,\$helpdeskscript);                                         $showhelpdesk,\@possdoms);
   
 my $loginform=(<<LFORM);      my $mobileargs;
 <form name="client" onsubmit="return(send())">      if ($clientmobile) {
   <input type="hidden" name="lextkey" value="$lextkey">          $mobileargs = 'autocapitalize="off" autocorrect="off"'; 
   <input type="hidden" name="uextkey" value="$uextkey">      }
       my $loginform=(<<LFORM);
   <form name="client" action="" onsubmit="return(send())" id="lclogin">
     <input type="hidden" name="lextkey" value="$lextkey" />
     <input type="hidden" name="uextkey" value="$uextkey" />
   <b><label for="uname">$lt{'un'}</label>:</b><br />    <b><label for="uname">$lt{'un'}</label>:</b><br />
   <input type="text" name="uname" size="10" value="$authusername" /><br />    <input type="text" name="uname" id="uname" size="15" value="$authusername" readonly="readonly" $mobileargs /><br />
   <b><label for="upass$now">$lt{'pw'}</label>:</b><br />    <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
   <input type="password" name="upass$now" size="10" /><br />    <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />
   <b><label for="udom">$lt{'dom'}</label>:</b><br />    <b><label for="udom">$lt{'dom'}</label>:</b><br />
   <input type="text" name="udom" size="10" value="$authdomain" /><br />    <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" $mobileargs /><br />
   <input type="submit" value="$lt{'log'}" />    <input type="submit" value="$lt{'log'}" />
 </form>  </form>
 LFORM  LFORM
   
 if ($fullgraph) {  
     if ($showbanner) {      if ($showbanner) {
           my $alttext = &Apache::loncommon::designparm('login.alttext_img',$domain);
           if ($alttext eq '') {
               $alttext = 'The Learning Online Network with CAPA';
           }
         $r->print(<<HEADER);          $r->print(<<HEADER);
 <!-- The LON-CAPA Header -->  <!-- The LON-CAPA Header -->
 <table border="0" align="left" width="100%" cellspacing="0" cellpadding="1">  <div style="background:$pgbg;margin:0;width:100%;">
  <tr>    <img src="$img" border="0" alt="$alttext" class="LC_maxwidth" id="lcloginbanner" />
   <td align="left" valign="top" bgcolor="$pgbg">  </div>
       <img src="$img" border=0 alt="The Learning Online Network with CAPA" />  
   </td>  
  </tr>  
 </table>  
 HEADER  HEADER
     }      }
     if ($showmainlogo) {  
         $r->print('<div class="LC_loginpage_space">&nbsp;</div>'."\n".      my $stdauthformstyle = 'inline-block';
                   '    <img src="'.$logo.'" alt="" />'."\n");      my $ssoauthstyle = 'none';
       my $logintype;
       $r->print('<div style="float:left;margin-top:0;">');
       if ($saml_landing) {
           $ssoauthstyle = 'inline-block';
           $stdauthformstyle = 'none';
           $logintype = $samlssotext;
           my $ssologin = '/adm/sso';
           if ($samlssourl  ne '') {
               $ssologin = $samlssourl;
           }
           if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
               my $querystring;
               if ($env{'form.firsturl'} ne '') {
                   $querystring = 'origurl=';
                   if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
                       $querystring .= &uri_escape_utf8($env{'form.firsturl'});
                   } else {
                       $querystring .= &uri_escape($env{'form.firsturl'});
                   }
                   $querystring = &HTML::Entities::encode($querystring,"'");
               }
               if ($querystring ne '') {
                   $ssologin .= (($ssologin=~/\?/)?'&amp;':'?') . $querystring;
               }
           } elsif ($logtoken ne '') {
               $ssologin .= (($ssologin=~/\?/)?'&amp;':'?') . 'logtoken='.$logtoken;
           }
           my $ssohref;
           if ($samlssoimg ne '') {
               $ssohref = '<a href="'.$ssologin.'" title="'.$samltooltip.'">'.
                          '<img src="'.$samlssoimg.'" alt="'.$samlssoalt.'" id="lcssobutton" /></a>';
           } else {
               $ssohref = '<a href="'.$ssologin.'">'.$samlssotext.'</a>';
           }
           if (($env{'form.saml'} eq 'no') ||
               (($env{'form.username'} ne '') && ($env{'form.domain'} ne ''))) {
               $ssoauthstyle = 'none';
               $stdauthformstyle = 'inline-block';
               $logintype = $samlnonsso;
           }
           $r->print(<<ENDSAML);
   <p>
   Log-in type:
   <span style="font-weight:bold" id="LC_login_text">$logintype</span><br />
   <span><a href="javascript:toggleLClogin();" style="color:#000000">$lt{'change'}</a></span>
   </p>
   <div style="display:$ssoauthstyle" id="LC_SSO_login">
   <div class="LC_Box" style="padding-top: 10px;">
   $ssohref
   $noscript_warning
   </div>
   <div class="LC_Box" style="padding-top: 10px;">
   $loginhelp
   $contactblock
   $coursecatalog
   </div>
   </div>
   ENDSAML
     }      }
     $r->print(<<ENDTOP);  
 <div class="LC_loginpage_loginContainer">      $r->print(<<ENDLOGIN);
  <fieldset class="LC_loginpage_fieldset">  <div style="display:$stdauthformstyle;" id="LC_standard_login">
   <legend class="LC_loginpage_legend">$logintitle</legend>  <div class="LC_Box" style="background:$loginbox_bg;">
    <table border="0" align="left" cellspacing="1" cellpadding="1" width="100%">    $logintitle
       <tr>    $loginform
       <td width="50%" align="center" valign="top">    $noscript_warning
  $domainlogo  
    </td>  
    <td>  
  $loginform  
            </td>  
       </tr>  
    </table>    
    $noscript_warning  
  </fieldset>  
 </div>  </div>
       
 <div class="LC_loginpage_loginInfo">  <div class="LC_Box" style="padding-top: 10px;">
         $loginhelp<br />    $loginhelp
         $forgotpw<br /><br />    $forgotpw
         $newuserlink<br />    $contactblock
         $coursecatalog<br /><br />    $newuserlink
         <a href="/adm/about.html"><b>$lt{'about'}</b></a><br />    $coursecatalog
         $helpdeskscript  </div>
 </div>  </div>
   
 <div class="LC_loginpage_space">&nbsp;</div>  ENDLOGIN
       $r->print('</div><div>'."\n");
       if ($showmainlogo) {
           my $alttext = &Apache::loncommon::designparm('login.alttext_logo',$domain);
           $r->print(' <img src="'.$logo.'" alt="'.$alttext.'" class="LC_maxwidth" id="lcloginmainlogo" />'."\n");
       }
   $r->print(<<ENDTOP);
 $announcements  $announcements
   </div>
   <hr style="clear:both;" />
 ENDTOP  ENDTOP
 }      my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
       $domainrow = <<"END";
 if($announcements){$r->print('<div class="LC_loginpage_space">&nbsp;</div>');}  
   
 if ($fullgraph) {  
 $r->print(<<ENDDOCUMENT);  
      <table border=0 cellspacing=0 cellpadding=0>  
       <tr>        <tr>
        <td  align="left" valign="top">         <td  align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'dom'}:&nbsp;</b></small>          <small><b>$lt{'dom'}:&nbsp;</b></small>
        </td>         </td>
        <td  align="left" valign="top">         <td  align="left" valign="top">
         <small><tt>&nbsp;$domain</tt></small>          <small><tt>&nbsp;$domain</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       $serverrow = <<"END";
       <tr>        <tr>
        <td  align="left" valign="top">         <td  align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'serv'}:&nbsp;</b></small>          <small><b>$lt{'serv'}:&nbsp;</b></small>
        </td>         </td>
        <td align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$lonhost ($role)</tt></small>          <small><tt>&nbsp;$lonhost ($role)</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       if ($loadlim) {
           $loadrow = <<"END";
       <tr>        <tr>
        <td align="left" valign="top">         <td align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'load'}:&nbsp;</b></small>          <small><b>$lt{'load'}:&nbsp;</b></small>
        </td>         </td>
        <td align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>          <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       }
       if ($uloadlim) {
           $userloadrow = <<"END";
       <tr>        <tr>
        <td align="left" valign="top">         <td align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'userload'}:&nbsp;</b></small>          <small><b>$lt{'userload'}:&nbsp;</b></small>
        </td>         </td>
        <td align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>          <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>
        </td>         </td>
       </tr>        </tr>
      </table>  END
            }
     $contactblock      if (($version ne '') && ($version ne '<!-- VERSION -->')) {
           $versionrow = <<"END";
         <tr>
          <td colspan="2" align="left">
           <small>$version</small>
          </td>
         </tr>
   END
       }
   
       $r->print(<<ENDDOCUMENT);
       <div style="float: left;">
        <table border="0" cellspacing="0" cellpadding="0">
   $domainrow
   $serverrow
   $loadrow    
   $userloadrow
   $versionrow
        </table>
       </div>
       <div style="float: right;">
       $domainlogo
       </div>
       <br style="clear:both;" />
  </div>   </div>
   
 <script type="text/javascript">  <script type="text/javascript">
   // <![CDATA[
 // the if prevents the script error if the browser can not handle this  // the if prevents the script error if the browser can not handle this
 if ( document.client.uname ) { document.client.uname.focus(); }  if ( document.client.uname ) { document.client.uname.focus(); }
   // ]]>
 </script>  </script>
 $helpdeskscript  $helpdeskscript
   
 ENDDOCUMENT  ENDDOCUMENT
 }  
     my %endargs = ( 'noredirectlink' => 1, );      my %endargs = ( 'noredirectlink' => 1, );
     $r->print(&Apache::loncommon::end_page(\%endargs));      $r->print(&Apache::loncommon::end_page(\%endargs));
     return OK;      return OK;
 }  }
   
   sub check_loginvia {
       my ($domain,$lonhost,$lonidsdir,$balcookie) = @_;
       if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') {
           return;
       }
       my %domconfhash = &Apache::loncommon::get_domainconf($domain);
       my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
       my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
       my $output;
       if ($loginvia ne '') {
           my $noredirect;
           my $ip = &Apache::lonnet::get_requestor_ip();
           if ($ip eq '127.0.0.1') {
               $noredirect = 1;
           } else {
               if ($loginvia_exempt ne '') {
                   my @exempt = split(',',$loginvia_exempt);
                   if (grep(/^\Q$ip\E$/,@exempt)) {
                       $noredirect = 1;
                   }
               }
           }
           unless ($noredirect) {
               my ($newhost,$path);
               if ($loginvia =~ /:/) {
                   ($newhost,$path) = split(':',$loginvia);
               } else {
                   $newhost = $loginvia;
               }
               if ($newhost ne $lonhost) {
                   if (&Apache::lonnet::hostname($newhost) ne '') {
                       if ($balcookie) {
                           my ($balancer,$cookie) = split(/:/,$balcookie);
                           if ($cookie =~ /^($match_domain)_($match_username)_([a-f0-9]+)$/) {
                               my ($udom,$uname,$cookieid) = ($1,$2,$3);
                               unless (&Apache::lonnet::delbalcookie($cookie,$balancer) eq 'ok') {
                                   if ((-d $lonidsdir) && (opendir(my $dh,$lonidsdir))) {
                                       while (my $filename=readdir($dh)) {
                                           if ($filename=~/^(\Q$uname\E_\d+_\Q$udom\E_$match_lonid)\.id$/) {
                                               my $handle = $1;
                                               my %hash =
                                                   &Apache::lonnet::get_sessionfile_vars($handle,$lonidsdir,
                                                                                        ['request.balancercookie',
                                                                                         'user.linkedenv']);
                                               if ($hash{'request.balancercookie'} eq "$balancer:$cookieid") {
                                                   if (unlink("$lonidsdir/$filename")) {
                                                       if (($hash{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
                                                           (-l "$lonidsdir/$hash{'user.linkedenv'}.id") &&
                                                           (readlink("$lonidsdir/$hash{'user.linkedenv'}.id") eq "$lonidsdir/$filename")) {
                                                           unlink("$lonidsdir/$hash{'user.linkedenv'}.id");
                                                       }
                                                   }
                                               }
                                               last;
                                           }
                                       }
                                       closedir($dh);
                                   }
                               }
                           }
                       }
                       $output = &redirect_page($newhost,$path);
                   }
               }
           }
       }
       return $output;
   }
   
   sub redirect_page {
       my ($desthost,$path) = @_;
       my $hostname = &Apache::lonnet::hostname($desthost);
       my $protocol = $Apache::lonnet::protocol{$desthost};
       $protocol = 'http' if ($protocol ne 'https');
       unless ($path =~ m{^/}) {
           $path = '/'.$path;
       }
       my $url = $protocol.'://'.$hostname.$path;
       if ($env{'form.firsturl'} ne '') {
           my $querystring;
           if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
               $querystring = &uri_escape_utf8($env{'form.firsturl'});
           } else {
               $querystring = &uri_escape($env{'form.firsturl'});
           }
           $querystring = &HTML::Entities::encode($querystring,"'");
           $url .='?firsturl='.$querystring;
       }
       my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                                       {'redirect' => [0,$url],});
       my $end_page   = &Apache::loncommon::end_page();
       return $start_page.$end_page;
   }
   
 sub contactdisplay {  sub contactdisplay {
     my ($lt,$servadm,$showadminmail,$version,$authdomain,$helpdeskscript) = @_;      my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk,
           $possdoms) = @_;
     my $contactblock;      my $contactblock;
     my $showhelpdesk = 0;      my $origmail;
     my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};      if (ref($possdoms) eq 'ARRAY') {
     if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {          if (grep(/^\Q$authdomain\E$/,@{$possdoms})) { 
         $showhelpdesk = 1;              $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
           }
       }
       my $requestmail = 
           &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
                                                    $authdomain,$origmail);
       unless ($showhelpdesk eq '0') {
           if ($requestmail =~ m/[^\@]+\@[^\@]+/) {
               $showhelpdesk = 1;
           } else {
               $showhelpdesk = 0;
           }
     }      }
     if ($servadm && $showadminmail) {      if ($servadm && $showadminmail) {
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;'.$$lt{'servadm'}.':</b><br />'.          $contactblock .= $$lt{'servadm'}.':<br />'.
                          '<tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.$servadm.'</tt><br />&nbsp;<br />';                           '<tt>'.$servadm.'</tt><br />';
     }      }
     if ($showhelpdesk) {      if ($showhelpdesk) {
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;<a href="javascript:helpdesk()"><font size="+1">'.$lt->{'helpdesk'}.'</font></a></b><br />';          $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
         my $thisurl = &escape('/adm/login');          my $thisurl = &escape('/adm/login');
         $$helpdeskscript = <<"ENDSCRIPT";          $$helpdeskscript = <<"ENDSCRIPT";
 <script type="text/javascript">  <script type="text/javascript">
   // <![CDATA[
 function helpdesk() {  function helpdesk() {
     var codedom = document.client.udom.value;      var possdom = document.client.udom.value;
       var codedom = possdom.replace( new RegExp("[^A-Za-z0-9.\\-]","g"),'');
     if (codedom == '') {      if (codedom == '') {
         codedom = "$authdomain";          codedom = "$authdomain";
     }      }
Line 550  function helpdesk() { Line 1012  function helpdesk() {
     document.location.href = "/adm/helpdesk?"+querystr;      document.location.href = "/adm/helpdesk?"+querystr;
     return;      return;
 }  }
   // ]]>
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     }      }
     $contactblock .= <<"ENDBLOCK";  
      &nbsp;&nbsp;&nbsp;$version  
 ENDBLOCK  
     return $contactblock;      return $contactblock;
 }  }
   
Line 568  sub forgotpwdisplay { Line 1028  sub forgotpwdisplay {
     return;      return;
 }  }
   
 sub loginhelpdisplay {  
     my (%lt) = @_;  
     my $login_help = 1;  
     if ($login_help) {  
         return '<a href="/adm/loginproblems.html">'.$lt{'help'}.'</a>';  
     }  
     return;  
 }  
   
 sub coursecatalog_link {  sub coursecatalog_link {
     my ($linkname) = @_;      my ($linkname) = @_;
     return <<"END";      return <<"END";
Line 586  END Line 1037  END
   
 sub newuser_link {  sub newuser_link {
     my ($linkname) = @_;      my ($linkname) = @_;
     return '&nbsp;&nbsp;&nbsp;<a href="/adm/createaccount"><b>'.$linkname.'</b></a><br />';      return '<a href="/adm/createaccount">'.$linkname.'</a>';
   }
   
   sub decode_token {
       my ($info) = @_;
       my ($firsturl,@rest)=split(/\&/,$info);
       my %form;
       if ($firsturl ne '') {
           $form{'firsturl'} = &unescape($firsturl);
       }
       foreach my $item (@rest) {
           my ($key,$value) = split(/=/,$item);
           $form{$key} = &unescape($value);
       }
       return %form;
 }  }
   
 1;  1;
Removed from v.1.110  
changed lines
  Added in v.1.158.2.14

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.