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

Diff for /loncom/auth/lonlogin.pm between versions 1.140 and 1.198

version 1.140, 2010/08/25 16:34:32 version 1.198, 2022/06/01 12:12:32
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network
 # Login Screen  # Login Screen
 #  #
 # $Id$  # $Id$
 #  #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 #  #
 # LON-CAPA is free software; you can redistribute it and/or modify  # LON-CAPA is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by  # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2 of the License, or  # the Free Software Foundation; either version 2 of the License, or
 # (at your option) any later version.  # (at your option) any later version.
 #  #
 # LON-CAPA is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
 # You should have received a copy of the GNU General Public License  # You should have received a copy of the GNU General Public License
 # along with LON-CAPA; if not, write to the Free Software  # along with LON-CAPA; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #  #
 # /home/httpd/html/adm/gpl.txt  # /home/httpd/html/adm/gpl.txt
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
   
 package Apache::lonlogin;  package Apache::lonlogin;
   
 use strict;  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::File ();  use Apache::File ();
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
 use Apache::lonauth();  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;
 sub handler {  use HTML::Entities();
     my $r = shift;  use CGI::Cookie();
    
     &Apache::loncommon::get_unprocessed_cgi  sub handler {
  (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},      my $r = shift;
       $ENV{'REDIRECT_QUERY_STRING'}),  
  ['interface','username','domain','firsturl','localpath','localres',      &Apache::loncommon::get_unprocessed_cgi
   'token','role','symb']);   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
     if (!defined($env{'form.firsturl'})) {        $ENV{'REDIRECT_QUERY_STRING'}),
         &Apache::lonacc::get_posted_cgi($r,['firsturl']);   ['interface','username','domain','firsturl','localpath','localres',
     }    'token','role','symb','iptoken','btoken','ltoken','ttoken','linkkey',
             'saml','sso','retry']);
 # -- check if they are a migrating user  
     if (defined($env{'form.token'})) {  # -- check if they are a migrating user
  return &Apache::migrateuser::handler($r);      if (defined($env{'form.token'})) {
     }          return &Apache::migrateuser::handler($r);
       }
     &Apache::loncommon::no_cache($r);  
     &Apache::lonlocal::get_language_handle($r);      my $lonhost = $r->dir_config('lonHostID');
     &Apache::loncommon::content_type($r,'text/html');      if ($env{'form.ttoken'}) {
     $r->send_http_header;          my %info = &Apache::lonnet::tmpget($env{'form.ttoken'});
     return OK if $r->header_only;          &Apache::lonnet::tmpdel($env{'form.ttoken'});
           if ($info{'origurl'}) {
               $env{'form.firsturl'} = $info{'origurl'};
 # Are we re-routing?          }
     if (-e '/home/httpd/html/lon-status/reroute.txt') {          if ($info{'ltoken'}) {
  &Apache::lonauth::reroute($r);              $env{'form.ltoken'} = $info{'ltoken'};
  return OK;          } elsif ($info{'linkprot'}) {
     }              $env{'form.linkprot'} = $info{'linkprot'};
           } elsif ($info{'linkkey'} ne '') {
               $env{'form.linkkey'} = $info{'linkkey'};
 # -------------------------------- Prevent users from attempting to login twice          }
     my $handle = &Apache::lonnet::check_for_valid_session($r);      } elsif (($env{'form.sso'}) || ($env{'form.retry'})) {
     if ($handle ne '') {          my $infotoken;
         my $lonidsdir=$r->dir_config('lonIDsDir');          if ($env{'form.sso'}) {
         if ($handle=~/^publicuser\_/) {              $infotoken = $env{'form.sso'};
 # For "public user" - remove it, we apparently really want to login          } else {
     unlink($r->dir_config('lonIDsDir')."/$handle.id");              $infotoken = $env{'form.retry'};
         } else {          }
 # Indeed, a valid token is found          my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
             &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);          unless (($data=~/^error/) || ($data eq 'con_lost') ||
     my $start_page =                   ($data eq 'no_such_host')) {
         &Apache::loncommon::start_page('Already logged in');              my %info = &decode_token($data);
     my $end_page =               foreach my $item (keys(%info)) {
         &Apache::loncommon::end_page();                  $env{'form.'.$item} = $info{$item};
             my $dest = '/adm/roles';              }
             if ($env{'form.firsturl'} ne '') {              &Apache::lonnet::tmpdel($infotoken);
                 $dest = $env{'form.firsturl'};           }
             }      } else {
     $r->print(          if (!defined($env{'form.firsturl'})) {
                   $start_page              &Apache::lonacc::get_posted_cgi($r,['firsturl']);
                  .'<h1>'.&mt('You are already logged in!').'</h1>'          }
                  .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',          if (!defined($env{'form.firsturl'})) {
                   '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'              if ($ENV{'REDIRECT_URL'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) {
                  .$end_page                  $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
                  );              }
             return OK;          }
         }          if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
     }              (!$env{'form.ltoken'}) && (!$env{'form.linkprot'}) && (!$env{'form.linkkey'})) {
               &Apache::lonacc::get_posted_cgi($r,['linkkey']);
 # ---------------------------------------------------- No valid token, continue          }
           if ($env{'form.firsturl'} eq '/adm/logout') {
  # ---------------------------- Not possible to really login to domain "public"              delete($env{'form.firsturl'});
     if ($env{'form.domain'} eq 'public') {          }
  $env{'form.domain'}='';      }
  $env{'form.username'}='';  
     }  # For "public user" - remove any exising "public" cookie, as user really wants to log-in
 # ----------------------------------------------------------- Process Interface      my ($handle,$lonidsdir,$expirepub,$userdom);
     $env{'form.interface'}=~s/\W//g;      $lonidsdir=$r->dir_config('lonIDsDir');
       unless ($r->header_only) {
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};          $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
           if ($handle ne '') {
     my $iconpath=               if ($handle=~/^publicuser\_/) {
  &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));                  unlink($r->dir_config('lonIDsDir')."/$handle.id");
                   undef($handle);
     my $lonhost = $r->dir_config('lonHostID');                  undef($userdom);
     my $domain = &Apache::lonnet::default_login_domain();                  $expirepub = 1;
     if ($lonhost ne '') {              }
         my $redirect = &check_loginvia($domain,$lonhost);          }
         if ($redirect) {      }
             $r->print($redirect);  
             return OK;      &Apache::loncommon::no_cache($r);
         }       &Apache::lonlocal::get_language_handle($r);
     }      &Apache::loncommon::content_type($r,'text/html');
       if ($expirepub) {
     if (($env{'form.domain'}) &&           my $c = new CGI::Cookie(-name    => 'lonPubID',
  (&Apache::lonnet::domain($env{'form.domain'},'description'))) {                                  -value   => '',
  $domain=$env{'form.domain'};                                  -expires => '-10y',);
     }          $r->header_out('Set-cookie' => $c);
     my $role    = $r->dir_config('lonRole');      } elsif (($handle eq '') && ($userdom ne '')) {
     my $loadlim = $r->dir_config('lonLoadLim');          my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
     my $servadm = $r->dir_config('lonAdmEMail');          foreach my $name (keys(%cookies)) {
     my $tabdir  = $r->dir_config('lonTabDir');              next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
     my $include = $r->dir_config('lonIncludes');              my $c = new CGI::Cookie(-name    => $name,
     my $expire  = $r->dir_config('lonExpire');                                      -value   => '',
     my $version = $r->dir_config('lonVersion');                                      -expires => '-10y',);
     my $host_name = &Apache::lonnet::hostname($lonhost);              $r->headers_out->add('Set-cookie' => $c);
           }
 # --------------------------------------------- Default values for login fields      }
       $r->send_http_header;
     my $authusername=($env{'form.username'}?$env{'form.username'}:'');      return OK if $r->header_only;
     my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);  
   
 # ---------------------------------------------------------- Determine own load  # Are we re-routing?
     my $loadavg;      my $londocroot = $r->dir_config('lonDocRoot');
     {      if (-e "$londocroot/lon-status/reroute.txt") {
  my $loadfile=Apache::File->new('/proc/loadavg');   &Apache::lonauth::reroute($r);
  $loadavg=<$loadfile>;   return OK;
     }      }
     $loadavg =~ s/\s.*//g;  
     my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);  # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
     my $userloadpercent=&Apache::lonnet::userload();  
       my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
     my $firsturl=      if ($found_server) {
     ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});          my $hostname = &Apache::lonnet::hostname($found_server);
 # ----------------------------------------------------------- Get announcements          if ($hostname ne '') {
     my $announcements=&Apache::lonnet::getannounce();              my $protocol = $Apache::lonnet::protocol{$found_server};
 # -------------------------------------------------------- Set login parameters              $protocol = 'http' if ($protocol ne 'https');
               my $dest = '/adm/roles';
     my @hexstr=('0','1','2','3','4','5','6','7',              if ($env{'form.firsturl'} ne '') {
                 '8','9','a','b','c','d','e','f');                  $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
     my $lkey='';              }
     for (0..7) {              my %info = (
         $lkey.=$hexstr[rand(15)];                           balcookie => $lonhost.':'.$balancer_cookie,
     }                         );
               if ($env{'form.role'}) {
     my $ukey='';                  $info{'role'} = $env{'form.role'};
     for (0..7) {              }
         $ukey.=$hexstr[rand(15)];              if ($env{'form.symb'}) {
     }                  $info{'symb'} = $env{'form.symb'};
               }
     my $lextkey=hex($lkey);              my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
     if ($lextkey>2147483647) { $lextkey-=4294967296; }              unless (($balancer_token eq 'con_lost') || ($balancer_token eq 'refused') ||
                       ($balancer_token eq 'unknown_cmd') || ($balancer_token eq 'no_such_host')) {
     my $uextkey=hex($ukey);                  $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'btoken='.$balancer_token;
     if ($uextkey>2147483647) { $uextkey-=4294967296; }              }
               if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
 # -------------------------------------------------------- Store away log token                  my %link_info;
     my $tokenextras;                  if ($env{'form.ltoken'}) {
     if ($env{'form.role'}) {                      $link_info{'ltoken'} = $env{'form.ltoken'};
         $tokenextras = '&role='.&escape($env{'form.role'});                  } elsif ($env{'form.linkprot'}) {
     }                      $link_info{'linkprot'} = $env{'form.linkprot'};
     if ($env{'form.symb'}) {                  } elsif ($env{'form.linkkey'} ne '') {
         if (!$tokenextras) {                      $link_info{'linkkey'} = $env{'form.linkkey'};
             $tokenextras = '&';                  }
         }                  if (keys(%link_info)) {
         $tokenextras .= '&symb='.&escape($env{'form.symb'});                      $link_info{'origurl'} = $env{'form.firsturl'};
     }                      my $token = &Apache::lonnet::tmpput(\%link_info,$found_server,'link');
     my $logtoken=Apache::lonnet::reply(                      unless (($token eq 'con_lost') || ($token eq 'refused') ||
        'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,                              ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
        $lonhost);                          $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'ttoken='.$token;
                       }
 # ------------------- If we cannot talk to ourselves, we are in serious trouble                  }
               }
     if ($logtoken eq 'con_lost') {              unless ($found_server eq $lonhost) {
         my $spares='';                  my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server);
  my $last;                  $hostname = $alias if ($alias ne '');
         foreach my $hostid (sort              }
     {              my $url = $protocol.'://'.$hostname.$dest;
  &Apache::lonnet::hostname($a) cmp              my $start_page =
     &Apache::lonnet::hostname($b);                  &Apache::loncommon::start_page('Switching Server ...',undef,
     }                                                 {'redirect'       => [0,$url],});
     keys(%Apache::lonnet::spareid)) {              my $end_page   = &Apache::loncommon::end_page();
             next if ($hostid eq $lonhost);              $r->print($start_page.$end_page);
     my $hostname = &Apache::lonnet::hostname($hostid);              return OK;
     next if ($last eq $hostname);          }
             $spares.='<br /><font size="+1"><a href="http://'.      }
                 $hostname.  
                 '/adm/login?domain='.$authdomain.'">'.  #
                 $hostname.'</a>'.  # Check if a LON-CAPA load balancer sent user here because user's browser sent
                 ' '.&mt('(preferred)').'</font>'.$/;  # it a balancer cookie for an active session on this server.
     $last=$hostname;  #
         }  
 $spares.= '<br />';      my $balcookie;
 my %all_hostnames = &Apache::lonnet::all_hostnames();      if ($env{'form.btoken'}) {
 foreach my $hostid (sort          my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
     {          $balcookie = $info{'balcookie'};
  &Apache::lonnet::hostname($a) cmp          &Apache::lonnet::tmpdel($env{'form.btoken'});
     &Apache::lonnet::hostname($b);          delete($env{'form.btoken'});
     }      }
     keys(%all_hostnames)) {  
     next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});  #
     my $hostname = &Apache::lonnet::hostname($hostid);  # If browser sent an old cookie for which the session file had been removed
     next if ($last eq $hostname);  # check if configuration for user's domain has a portal URL set.  If so
     $spares.='<br /><a href="http://'.  # switch user's log-in to the portal.
  $hostname.  #
  '/adm/login?domain='.$authdomain.'">'.  
  $hostname.'</a>';      if (($handle eq '') && ($userdom ne '')) {
     $last=$hostname;          my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom);
 }          if ($domdefaults{'portal_def'} =~ /^https?\:/) {
 $r->print(              my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
    '<html>'                                            {'redirect' => [0,$domdefaults{'portal_def'}],});
   .'<head><title>'              my $end_page   = &Apache::loncommon::end_page();
   .&mt('The LearningOnline Network with CAPA')              $r->print($start_page.$end_page);
   .'</title></head>'              return OK;
   .'<body bgcolor="#FFFFFF">'          }
   .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'      }
   .'<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />'  
   .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>'  # -------------------------------- Prevent users from attempting to login twice
   .'<p>'.&mt('Please attempt to login to one of the following servers:').'</p>'      if ($handle ne '') {
   .$spares          &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
   .'</body>'   my $start_page =
   .'</html>'      &Apache::loncommon::start_page('Already logged in');
 );   my $end_page =
 return OK;      &Apache::loncommon::end_page();
 }          my $dest = '/adm/roles';
           if ($env{'form.firsturl'} ne '') {
 # ----------------------------------------------- Apparently we are in business              $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
 $servadm=~s/\,/\<br \/\>/g;          }
           if (($env{'form.ltoken'}) || ($env{'form.linkprot'})) {
 # ----------------------------------------------------------- Front page design              my $linkprot;
 my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);              if ($env{'form.ltoken'}) {
 my $font=&Apache::loncommon::designparm('login.font',$domain);                  my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
 my $link=&Apache::loncommon::designparm('login.link',$domain);                  $linkprot = $info{'linkprot'};
 my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);                  my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
 my $alink=&Apache::loncommon::designparm('login.alink',$domain);              } else {
 my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);                  $linkprot = $env{'form.linkprot'};
 my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);              }
 my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);              if ($linkprot) {
 my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);                  my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
 my $logo=&Apache::loncommon::designparm('login.logo',$domain);                  if ($env{'user.linkprotector'}) {
 my $img=&Apache::loncommon::designparm('login.img',$domain);                      my @protectors = split(/,/,$env{'user.linkprotector'});
 my $domainlogo='<div>'.&Apache::loncommon::domainlogo($domain).'</div>';                      unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
 my $showbanner = 1;                          push(@protectors,$linkprotector);
 my $showmainlogo = 1;                          @protectors = sort { $a <=> $b } @protectors;
 if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {                          &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
     $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);                      }
 }                  } else {
 if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {                      &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
     $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);                  }
 }                  if ($env{'user.linkproturi'}) {
 my $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);                      my @proturis = split(/,/,$env{'user.linkproturi'});
 my $showcoursecat =                      unless (grep(/^\Q$deeplink\E$/,@proturis)) {
 &Apache::loncommon::designparm('login.coursecatalog',$domain);                          push(@proturis,$deeplink);
 my $shownewuserlink =                           @proturis = sort @proturis;
 &Apache::loncommon::designparm('login.newuser',$domain);                          &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
 my $now=time;                      }
 my $js = (<<ENDSCRIPT);                  } else {
                       &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
 <script type="text/javascript" language="JavaScript">                  }
 // <![CDATA[              }
 function send()          } elsif ($env{'form.linkkey'} ne '') {
 {              if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
 this.document.server.elements.uname.value                  my $linkkey = $env{'form.linkkey'};
 =this.document.client.elements.uname.value;                  if ($env{'user.deeplinkkey'}) {
                       my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
 this.document.server.elements.udom.value                      unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
 =this.document.client.elements.udom.value;                          push(@linkkeys,$linkkey);
                           &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
 uextkey=this.document.client.elements.uextkey.value;                      }
 lextkey=this.document.client.elements.lextkey.value;                  } else {
 initkeys();                      &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
                   }
 this.document.server.elements.upass0.value                  my $deeplink = $env{'form.firsturl'};
     =crypted(this.document.client.elements.upass$now.value.substr(0,15));                  if ($env{'user.keyedlinkuri'}) {
 this.document.server.elements.upass1.value                      my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
     =crypted(this.document.client.elements.upass$now.value.substr(15,15));                      unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
 this.document.server.elements.upass2.value                          push(@keyeduris,$deeplink);
     =crypted(this.document.client.elements.upass$now.value.substr(30,15));                          &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
                       }
 this.document.client.elements.uname.value='';                  } else {
 this.document.client.elements.upass$now.value='';                      &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
                   }
 this.document.server.submit();              }
 return false;          }
 }   $r->print(
                     $start_page
 function enableInput() {                   .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
     this.document.client.elements.upass$now.removeAttribute("readonly");                   .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
     this.document.client.elements.uname.removeAttribute("readonly");                    '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'
     this.document.client.elements.udom.removeAttribute("readonly");                   .$end_page
     return;                   );
 }          return OK;
       }
 // ]]>  
 </script>  # ---------------------------------------------------- No valid token, continue
   
 ENDSCRIPT  # ---------------------------- Not possible to really login to domain "public"
       if ($env{'form.domain'} eq 'public') {
 # --------------------------------------------------- Print login screen header   $env{'form.domain'}='';
    $env{'form.username'}='';
 my %add_entries = (      }
        bgcolor      => "$mainbg",  
        text         => "$font",  # ------ Is this page requested because /adm/migrateuser detected an IP change?
        link         => "$link",      my %sessiondata;
        vlink        => "$vlink",      if ($env{'form.iptoken'}) {
        alink        => "$alink",          %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'});
                onload       => 'javascript:enableInput();',);          unless ($sessiondata{'sessionserver'}) {
               my $delete = &Apache::lonnet::tmpdel($env{'form.iptoken'});
 $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,              delete($env{'form.iptoken'});
        { 'redirect'       => [$expire,'/adm/roles'],           }
  'add_entries' => \%add_entries,      }
  'only_body'   => 1,}));  # ----------------------------------------------------------- Process Interface
       $env{'form.interface'}=~s/\W//g;
 # ----------------------------------------------------------------------- Texts  
       (undef,undef,undef,undef,undef,undef,my $clientmobile) =
 my %lt=&Apache::lonlocal::texthash(          &Apache::loncommon::decode_user_agent($r);
           'un'       => 'Username',  
           'pw'       => 'Password',      my $iconpath=
           'dom'      => 'Domain',   &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
           'perc'     => 'percent',  
           'load'     => 'Server Load',      my $domain = &Apache::lonnet::default_login_domain();
           'userload' => 'User Load',      my $defdom = $domain;
           'catalog'  => 'Course/Community Catalog',      if ($lonhost ne '') {
           'log'      => 'Log in',          unless ($sessiondata{'sessionserver'}) {
           'help'     => 'Log-in Help',              my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie);
           'serv'     => 'Server',              if ($redirect) {
           'servadm'  => 'Server Administration',                  $r->print($redirect);
           'helpdesk' => 'Contact Helpdesk',                  return OK;
           'forgotpw' => 'Forgot password?',              }
           'newuser'  => 'New User?',          }
        );      }
 # -------------------------------------------------- Change password field name  
       if (($sessiondata{'domain'}) &&
 my $forgotpw = &forgotpwdisplay(%lt);          (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
 $forgotpw .= '<br />' if $forgotpw;          $domain=$sessiondata{'domain'};
 my $loginhelp = &loginhelpdisplay($authdomain,%lt);      } elsif (($env{'form.domain'}) &&
 $loginhelp .= '<br />' if $loginhelp;   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
    $domain=$env{'form.domain'};
 # ---------------------------------------------------- Serve out DES JavaScript      }
 {  
 my $jsh=Apache::File->new($include."/londes.js");      my $role    = $r->dir_config('lonRole');
 $r->print(<$jsh>);      my $loadlim = $r->dir_config('lonLoadLim');
 }      my $uloadlim= $r->dir_config('lonUserLoadLim');
 # ---------------------------------------------------------- Serve rest of page      my $servadm = $r->dir_config('lonAdmEMail');
       my $tabdir  = $r->dir_config('lonTabDir');
 $r->print(      my $include = $r->dir_config('lonIncludes');
     '<div class="LC_Box"'      my $expire  = $r->dir_config('lonExpire');
    .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'      my $version = $r->dir_config('lonVersion');
 );      my $host_name = &Apache::lonnet::hostname($lonhost);
   
 #  # --------------------------------------------- Default values for login fields
 #  If the loadbalancing yielded just http:// because perhaps there's no loadbalancing?     
 #  then just us a relative link to authenticate:      my ($authusername,$authdomain);
 #      if ($sessiondata{'username'}) {
           $authusername=$sessiondata{'username'};
 $r->print(<<ENDSERVERFORM);      } else {
 <form name="server" action="/adm/authenticate" method="post" target="_top">          $env{'form.username'} = &Apache::loncommon::cleanup_html($env{'form.username'});
    <input type="hidden" name="logtoken" value="$logtoken" />          $authusername=($env{'form.username'}?$env{'form.username'}:'');
    <input type="hidden" name="serverid" value="$lonhost" />      }
    <input type="hidden" name="uname" value="" />      if ($sessiondata{'domain'}) {
    <input type="hidden" name="upass0" value="" />          $authdomain=$sessiondata{'domain'};
    <input type="hidden" name="upass1" value="" />      } else {
    <input type="hidden" name="upass2" value="" />          $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'});
    <input type="hidden" name="udom" value="" />          $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
    <input type="hidden" name="localpath" value="$env{'form.localpath'}" />      }
    <input type="hidden" name="localres" value="$env{'form.localres'}" />  
   </form>  # ---------------------------------------------------------- Determine own load
 ENDSERVERFORM      my $loadavg;
 my $coursecatalog;      {
 if (($showcoursecat eq '') || ($showcoursecat)) {   my $loadfile=Apache::File->new('/proc/loadavg');
     $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';   $loadavg=<$loadfile>;
 }      }
 my $newuserlink;      $loadavg =~ s/\s.*//g;
 if ($shownewuserlink) {  
     $newuserlink = &newuser_link($lt{'newuser'}).'<br />';      my ($loadpercent,$userloadpercent);
 }      if ($loadlim) {
 my $logintitle =          $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
     '<h2 class="LC_hcell"'      }
    .' style="background:'.$loginbox_header_bgcol.';'      if ($uloadlim) {
    .' color:'.$loginbox_header_textcol.'">'          $userloadpercent=&Apache::lonnet::userload();
    .$lt{'log'}      }
    .'</h2>';  
       my $firsturl=
 my $noscript_warning='<noscript><span class="LC_warning"><b>'      ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
                      .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')  
                     .'</b></span></noscript>';  # ----------------------------------------------------------- Get announcements
 my $helpdeskscript;      my $announcements=&Apache::lonnet::getannounce();
 my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,  # -------------------------------------------------------- Set login parameters
                                    $authdomain,\$helpdeskscript);  
       my @hexstr=('0','1','2','3','4','5','6','7',
 my $loginform=(<<LFORM);                  '8','9','a','b','c','d','e','f');
 <form name="client" action="" onsubmit="return(send())">      my $lkey='';
   <input type="hidden" name="lextkey" value="$lextkey" />      for (0..7) {
   <input type="hidden" name="uextkey" value="$uextkey" />          $lkey.=$hexstr[rand(15)];
   <b><label for="uname">$lt{'un'}</label>:</b><br />      }
   <input type="text" name="uname" id="uname" size="15" value="$authusername" readonly="readonly" /><br />  
   <b><label for="upass$now">$lt{'pw'}</label>:</b><br />      my $ukey='';
   <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />      for (0..7) {
   <b><label for="udom">$lt{'dom'}</label>:</b><br />          $ukey.=$hexstr[rand(15)];
   <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" /><br />      }
   <input type="submit" value="$lt{'log'}" />  
 </form>      my $lextkey=hex($lkey);
 LFORM      if ($lextkey>2147483647) { $lextkey-=4294967296; }
   
     if ($showbanner) {      my $uextkey=hex($ukey);
         $r->print(<<HEADER);      if ($uextkey>2147483647) { $uextkey-=4294967296; }
 <!-- The LON-CAPA Header -->  
 <div style="background:$pgbg;margin:0;width:100%;">  # -------------------------------------------------------- Store away log token
   <img src="$img" border="0" alt="The Learning Online Network with CAPA" />      my ($tokenextras,$tokentype,$linkprot_for_login);
 </div>      my @names = ('role','symb','iptoken','ltoken','linkprot','linkkey');
 HEADER      foreach my $name (@names) {
     }          if ($env{'form.'.$name} ne '') {
     $r->print(<<ENDTOP);              if ($name eq 'ltoken') {
 <div style="float:left;">                  my %info = &Apache::lonnet::tmpget($env{'form.'.$name});
 <div class="LC_Box" style="background:$loginbox_bg;">                  if ($info{'linkprot'}) {
   $logintitle                      $linkprot_for_login = $info{'linkprot'};
   $loginform                      $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
   $noscript_warning                      $tokentype = 'link';
 </div>                      last;
                     }
 <div class="LC_Box" style="padding-top: 10px;">              } else {
   $loginhelp                  $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
   $forgotpw                  if (($name eq 'linkkey') || ($name eq 'linkprot')) {
   $contactblock                      if ((($env{'form.retry'}) || ($env{'form.sso'})) &&
   $newuserlink                          (!$env{'form.ltoken'}) && ($name eq 'linkprot')) {
   $coursecatalog                          $linkprot_for_login = $env{'form.linkprot'};
 </div>                      }
 </div>                      $tokentype = 'link';
                   }
 <div>              }
 ENDTOP          }
     if ($showmainlogo) {      }
         $r->print(' <img src="'.$logo.'" alt="" />'."\n");      if ($tokentype) {
     }          $tokenextras .= ":$tokentype";
 $r->print(<<ENDTOP);      }
 $announcements      my $logtoken=Apache::lonnet::reply(
 $domainlogo         'tmpput:'.$ukey.$lkey.'&'.&escape($firsturl).$tokenextras,
 </div>         $lonhost);
 <hr style="clear:both;" />  
 ENDTOP  # -- If we cannot talk to ourselves, or hostID does not map to a hostname
   #    we are in serious trouble
 $r->print(<<ENDDOCUMENT);  
      <table border="0" cellspacing="0" cellpadding="0">      if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
       <tr>          if ($logtoken eq 'no_such_host') {
        <td  align="left" valign="top">              &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
         <small><b>$lt{'dom'}:&nbsp;</b></small>          }
        </td>          if ($env{'form.ltoken'}) {
        <td  align="left" valign="top">              &Apache::lonnet::tmpdel($env{'form.ltoken'});
         <small><tt>&nbsp;$domain</tt></small>              delete($env{'form.ltoken'});
        </td>          }
       </tr>          my $spares='';
       <tr>          my (@sparehosts,%spareservers);
        <td  align="left" valign="top">          my $sparesref = &Apache::lonnet::this_host_spares($defdom);
         <small><b>$lt{'serv'}:&nbsp;</b></small>          if (ref($sparesref) eq 'HASH') {
        </td>              foreach my $key (keys(%{$sparesref})) {
        <td align="left" valign="top">                  if (ref($sparesref->{$key}) eq 'ARRAY') {
         <small><tt>&nbsp;$lonhost ($role)</tt></small>                      my @sorted = sort { &Apache::lonnet::hostname($a) cmp
        </td>                                          &Apache::lonnet::hostname($b);
       </tr>                                        } @{$sparesref->{$key}};
       <tr>                      if (@sorted) {
        <td align="left" valign="top">                          if ($key eq 'primary') {
         <small><b>$lt{'load'}:&nbsp;</b></small>                              unshift(@sparehosts,@sorted);
        </td>                          } elsif ($key eq 'default') {
        <td align="left" valign="top">                              push(@sparehosts,@sorted);
         <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>                          }
        </td>                      }
       </tr>                  }
       <tr>              }
        <td align="left" valign="top">          }
         <small><b>$lt{'userload'}:&nbsp;</b></small>          foreach my $hostid (@sparehosts) {
        </td>              next if ($hostid eq $lonhost);
        <td align="left" valign="top">      my $hostname = &Apache::lonnet::hostname($hostid);
         <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>      next if (($hostname eq '') || ($spareservers{$hostname}));
        </td>              $spareservers{$hostname} = 1;
       </tr>              my $protocol = $Apache::lonnet::protocol{$hostid};
       <tr>              $protocol = 'http' if ($protocol ne 'https');
        <td colspan="2" align="left">              $spares.='<br /><span style="font-size: larger;"><a href="'.$protocol.'://'.
         <small>$version</small>                  $hostname.
        </td>                  '/adm/login?domain='.$authdomain.'">'.
       </tr>                  $hostname.'</a>'.
      </table>                  ' '.&mt('(preferred)').'</span>'.$/;
  </div>          }
           if ($spares) {
 <script type="text/javascript">              $spares.= '<br />';
 // <![CDATA[          }
 // the if prevents the script error if the browser can not handle this          my %all_hostnames = &Apache::lonnet::all_hostnames();
 if ( document.client.uname ) { document.client.uname.focus(); }          foreach my $hostid (sort
 // ]]>      {
 </script>   &Apache::lonnet::hostname($a) cmp
 $helpdeskscript      &Apache::lonnet::hostname($b);
       }
 ENDDOCUMENT      keys(%all_hostnames)) {
     my %endargs = ( 'noredirectlink' => 1, );              next if ($hostid eq $lonhost);
     $r->print(&Apache::loncommon::end_page(\%endargs));              my $hostname = &Apache::lonnet::hostname($hostid);
     return OK;              next if (($hostname eq '') || ($spareservers{$hostname}));
 }              $spareservers{$hostname} = 1;
               my $protocol = $Apache::lonnet::protocol{$hostid};
 sub check_loginvia {              $protocol = 'http' if ($protocol ne 'https');
     my ($domain,$lonhost) = @_;              $spares.='<br /><a href="'.$protocol.'://'.
     if ($domain eq '' || $lonhost eq '') {               $hostname.
         return;               '/adm/login?domain='.$authdomain.'">'.
     }               $hostname.'</a>';
     my %domconfhash = &Apache::loncommon::get_domainconf($domain);           }
     my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};           $r->print(
     my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};     '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
     my $output;    .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'
     if ($loginvia ne '') {    .'<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" /><title>'
         my $noredirect;    .&mt('The LearningOnline Network with CAPA')
         my $ip = $ENV{'REMOTE_ADDR'};    .'</title></head>'
         if ($ip eq '127.0.0.1') {    .'<body bgcolor="#FFFFFF">'
             $noredirect = 1;    .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
         } else {    .'<img src="/adm/lonKaputt/lonlogo_broken.gif" alt="broken icon" align="right" />'
             if ($loginvia_exempt ne '') {    .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
                 my @exempt = split(',',$loginvia_exempt);          if ($spares) {
                 if (grep(/^\Q$ip\E$/,@exempt)) {              $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
                     $noredirect = 1;                       .'</p>'
                 }                       .$spares);
             }          }
         }          $r->print('</body>'
         unless ($noredirect) {                   .'</html>'
             my ($newhost,$path);          );
             if ($loginvia =~ /:/) {          return OK;
                 ($newhost,$path) = split(':',$loginvia);      }
             } else {  
                 $newhost = $loginvia;  # ----------------------------------------------- Apparently we are in business
             }      $servadm=~s/\,/\<br \/\>/g;
             if ($newhost ne $lonhost) {  
                 if (&Apache::lonnet::hostname($newhost) ne '') {  # ----------------------------------------------------------- Front page design
                     $output = &redirect_page($newhost,$path);      my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
                 }      my $font=&Apache::loncommon::designparm('login.font',$domain);
             }      my $link=&Apache::loncommon::designparm('login.link',$domain);
         }      my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
     }      my $alink=&Apache::loncommon::designparm('login.alink',$domain);
     return $output;      my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
 }      my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
       my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
 sub redirect_page {      my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
     my ($desthost,$path) = @_;      my $logo=&Apache::loncommon::designparm('login.logo',$domain);
     my $protocol = $Apache::lonnet::protocol{$desthost};      my $img=&Apache::loncommon::designparm('login.img',$domain);
     $protocol = 'http' if ($protocol ne 'https');      my $domainlogo=&Apache::loncommon::domainlogo($domain);
     unless ($path =~ m{^/}) {      my $showbanner = 1;
         $path = '/'.$path;      my $showmainlogo = 1;
     }      if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
     my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;          $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
     if ($env{'form.firsturl'} ne '') {      }
         $url .='?firsturl='.$env{'form.firsturl'};      if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
     }          $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
     my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,      }
                                                     {'redirect' => [0,$url],});      my $showadminmail;
     my $end_page   = &Apache::loncommon::end_page();      my @possdoms = &Apache::lonnet::current_machine_domains();
     return $start_page.$end_page;      if (grep(/^\Q$domain\E$/,@possdoms)) {
 }          $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
       }
 sub contactdisplay {      my $showcoursecat =
     my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript) = @_;          &Apache::loncommon::designparm('login.coursecatalog',$domain);
     my $contactblock;      my $shownewuserlink =
     my $showhelpdesk = 0;          &Apache::loncommon::designparm('login.newuser',$domain);
     my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};      my $showhelpdesk =
     if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {          &Apache::loncommon::designparm('login.helpdesk',$domain);
         $showhelpdesk = 1;      my $now=time;
     }      my $js = (<<ENDSCRIPT);
     if ($servadm && $showadminmail) {  
         $contactblock .= $$lt{'servadm'}.':<br />'.  <script type="text/javascript" language="JavaScript">
                          '<tt>'.$servadm.'</tt><br />';  // <![CDATA[
     }  function send()
     if ($showhelpdesk) {  {
         $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';  this.document.server.elements.uname.value
         my $thisurl = &escape('/adm/login');  =this.document.client.elements.uname.value;
         $$helpdeskscript = <<"ENDSCRIPT";  
 <script type="text/javascript">  this.document.server.elements.udom.value
 // <![CDATA[  =this.document.client.elements.udom.value;
 function helpdesk() {  
     var codedom = document.client.udom.value;  uextkey=this.document.client.elements.uextkey.value;
     if (codedom == '') {  lextkey=this.document.client.elements.lextkey.value;
         codedom = "$authdomain";  initkeys();
     }  
     var querystr = "origurl=$thisurl&codedom="+codedom;  if(this.document.server.action.substr(0,5) === 'http:'){
     document.location.href = "/adm/helpdesk?"+querystr;      this.document.server.elements.upass0.value
     return;          =getCrypted(this.document.client.elements.upass$now.value);
 }  } else {
 // ]]>      this.document.server.elements.upass0.value
 </script>          =this.document.client.elements.upass$now.value;
 ENDSCRIPT  }
     }  
     return $contactblock;  this.document.client.elements.uname.value='';
 }  this.document.client.elements.upass$now.value='';
   
 sub forgotpwdisplay {  this.document.server.submit();
     my (%lt) = @_;  return false;
     my $prompt_for_resetpw = 1;   }
     if ($prompt_for_resetpw) {  
         return '<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a>';  function enableInput() {
     }      this.document.client.elements.upass$now.removeAttribute("readOnly");
     return;      this.document.client.elements.uname.removeAttribute("readOnly");
 }      this.document.client.elements.udom.removeAttribute("readOnly");
       return;
 sub loginhelpdisplay {  }
     my ($authdomain,%lt) = @_;  
     my $login_help = 1;  // ]]>
     if ($login_help) {  </script>
         my $dom = $authdomain;  
         if ($dom eq '') {  ENDSCRIPT
             $dom = &Apache::lonnet::default_login_domain();  
         }      my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
         my %helpconfig = &Apache::lonnet::get_dom('configuration',['helpsettings'],$dom);          $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip);
         my $loginhelp_url = $helpconfig{'helpsettings'}{'loginhelpurl'};      %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
         if ($loginhelp_url ne '') {      @hosts = &Apache::lonnet::current_machine_ids();
             return '<a href="'.$loginhelp_url.'">'.$lt{'help'}.'</a>';      $lonhost_in_use = $lonhost;
         } else {      if (@hosts > 1) {
             return '<a href="/adm/loginproblems.html">'.$lt{'help'}.'</a>';          foreach my $hostid (@hosts) {
         }              if (&Apache::lonnet::host_domain($hostid) eq $defdom) {
     }                  $lonhost_in_use = $hostid;
     return;                  last;
 }              }
           }
 sub coursecatalog_link {      }
     my ($linkname) = @_;      $saml_prefix = $defdom.'.login.saml_';
     return <<"END";      if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) {
       <a href="/adm/coursecatalog">$linkname</a>          $saml_landing = 1;
 END          $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use};
 }          $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use};
           $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use};
 sub newuser_link {          $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use};
     my ($linkname) = @_;          $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use};
     return '<a href="/adm/createaccount">'.$linkname.'</a>';          $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use};
 }      }
       if ($saml_landing) {
 1;         if ($samlssotext eq '') {
 __END__             $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.client.uname ) { document.client.uname.focus(); }
               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
   
       my %add_entries = (
          bgcolor      => "$mainbg",
          text         => "$font",
          link         => "$link",
          vlink        => "$vlink",
          alink        => "$alink",
                  onload       => 'javascript:enableInput();',);
   
       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'],
    'add_entries' => \%add_entries,
    'only_body'   => 1,}));
   
   # ----------------------------------------------------------------------- Texts
   
       my %lt=&Apache::lonlocal::texthash(
             'un'       => 'Username',
             'pw'       => 'Password',
             'dom'      => 'Domain',
             'perc'     => 'percent',
             'load'     => 'Server Load',
             'userload' => 'User Load',
             'catalog'  => 'Course/Community Catalog',
             'log'      => 'Log in',
             'help'     => 'Log-in Help',
             'serv'     => 'Server',
             'servadm'  => 'Server Administration',
             'helpdesk' => 'Contact Helpdesk',
             'forgotpw' => 'Forgot password?',
             'newuser'  => 'New User?',
             'change'   => 'Change?',
          );
   # -------------------------------------------------- Change password field name
   
       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
       {
       my $jsh=Apache::File->new($include."/londes.js");
       $r->print(<$jsh>);
       }
   # ---------------------------------------------------------- Serve rest of page
   
       $r->print(
       '<div class="LC_Box"'
      .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
   );
   
       $r->print(<<ENDSERVERFORM);
   <form name="server" action="/adm/authenticate" method="post" target="_top">
      <input type="hidden" name="logtoken" value="$logtoken" />
      <input type="hidden" name="serverid" value="$lonhost" />
      <input type="hidden" name="uname" value="" />
      <input type="hidden" name="upass0" value="" />
      <input type="hidden" name="udom" value="" />
      <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
      <input type="hidden" name="localres" value="$env{'form.localres'}" />
     </form>
   ENDSERVERFORM
       my $coursecatalog;
       if (($showcoursecat eq '') || ($showcoursecat)) {
           $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
       }
       my $newuserlink;
       if ($shownewuserlink) {
           $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
       }
       my $logintitle =
           '<h2 class="LC_hcell"'
          .' style="background:'.$loginbox_header_bgcol.';'
          .' color:'.$loginbox_header_textcol.'">'
          .$lt{'log'}
          .'</h2>';
   
       my $noscript_warning='<noscript><span class="LC_warning"><b>'
                           .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
                           .'</b></span></noscript>';
       my $helpdeskscript;
       my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
                                          $authdomain,\$helpdeskscript,
                                          $showhelpdesk,\@possdoms);
   
       my $mobileargs;
       if ($clientmobile) {
           $mobileargs = 'autocapitalize="off" autocorrect="off"';
       }
       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 />
     <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 />
     <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />
     <b><label for="udom">$lt{'dom'}</label>:</b><br />
     <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" $mobileargs /><br />
     <input type="submit" value="$lt{'log'}" />
   </form>
   LFORM
   
       if ($showbanner) {
           my $alttext = &Apache::loncommon::designparm('login.alttext_img',$domain);
           if ($alttext eq '') {
               $alttext = 'The Learning Online Network with CAPA';
           }
           $r->print(<<HEADER);
   <!-- The LON-CAPA Header -->
   <div style="background:$pgbg;margin:0;width:100%;">
     <img src="$img" border="0" alt="$alttext" class="LC_maxwidth" id="lcloginbanner" />
   </div>
   HEADER
       }
   
       my $stdauthformstyle = 'inline-block';
       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 ($env{'form.ltoken'} ne '') {
                   $querystring .= (($querystring eq '')?'':'&amp;') . 'ltoken='.
                                     &HTML::Entities::encode(&uri_escape($env{'form.ltoken'}));
               } elsif ($env{'form.linkkey'}) {
                   $querystring .= (($querystring eq '')?'':'&amp;') . 'linkkey='.
                                     &HTML::Entities::encode(&uri_escape($env{'form.linkkey'}));
               }
               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
       } else {
           if ($env{'form.ltoken'}) {
               &Apache::lonnet::tmpdel($env{'form.ltoken'});
               delete($env{'form.ltoken'});
           }
       }
       my $in_frame_js;
       if ($linkprot_for_login) {
           my ($linkprotector,$linkproturi) = split(/:/,$linkprot_for_login,2);
           if (($linkprotector =~ /^\d+(c|d)$/) && ($linkproturi =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$})) {
               my $set_target;
               if (($env{'form.retry'}) || ($env{'form.sso'})) {
                   if ($linkproturi eq $env{'form.firsturl'}) {
                       $set_target = "    document.server.target = '_self';";
                   }
               } else {
                   $set_target = <<ENDTARG;
       var linkproturi = '$linkproturi';
       var path = document.location.pathname.replace( new RegExp('^/adm/launch'),'');
       if (linkproturi == path) {
           document.server.target = '_self';
       }
   ENDTARG
               }
               $in_frame_js = <<ENDJS;
   <script type="text/javascript">
   // <![CDATA[
   if ((window.self !== window.top) && (document.server.target != '_self')) {
       $set_target
   }
   // ]]>
   </script>
   ENDJS
           }
       }
   
       $r->print(<<ENDLOGIN);
   <div style="display:$stdauthformstyle;" id="LC_standard_login">
   <div class="LC_Box" style="background:$loginbox_bg;">
     $logintitle
     $loginform
     $noscript_warning
   </div>
    
   <div class="LC_Box" style="padding-top: 10px;">
     $loginhelp
     $forgotpw
     $contactblock
     $newuserlink
     $coursecatalog
   </div>
   </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
   </div>
   <hr style="clear:both;" />
   ENDTOP
       my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
       $domainrow = <<"END";
         <tr>
          <td  align="left" valign="top">
           <small><b>$lt{'dom'}:&nbsp;</b></small>
          </td>
          <td  align="left" valign="top">
           <small><tt>&nbsp;$domain</tt></small>
          </td>
         </tr>
   END
       $serverrow = <<"END";
         <tr>
          <td  align="left" valign="top">
           <small><b>$lt{'serv'}:&nbsp;</b></small>
          </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$lonhost ($role)</tt></small>
          </td>
         </tr>
   END
       if ($loadlim) {
           $loadrow = <<"END";
         <tr>
          <td align="left" valign="top">
           <small><b>$lt{'load'}:&nbsp;</b></small>
          </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>
          </td>
         </tr>
   END
       }
       if ($uloadlim) {
           $userloadrow = <<"END";
         <tr>
          <td align="left" valign="top">
           <small><b>$lt{'userload'}:&nbsp;</b></small>
          </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>
          </td>
         </tr>
   END
       }
       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>
   
   $in_frame_js
   <script type="text/javascript">
   // <![CDATA[
   // the if prevents the script error if the browser can not handle this
   if ( document.client.uname ) { document.client.uname.focus(); }
   // ]]>
   </script>
   $helpdeskscript
   
   ENDDOCUMENT
       my %endargs = ( 'noredirectlink' => 1, );
       $r->print(&Apache::loncommon::end_page(\%endargs));
       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;
       }
       if (($env{'form.ltoken'}) || ($env{'form.linkkey'} ne '')) {
           my %link_info;
           if ($env{'form.ltoken'}) {
               $link_info{'ltoken'} = $env{'form.ltoken'};
           } elsif ($env{'form.linkkey'} ne '') {
               $link_info{'linkkey'} = $env{'form.linkkey'};
           }
           my $token = &Apache::lonnet::tmpput(\%link_info,$desthost,'link');
           unless (($token eq 'con_lost') || ($token eq 'refused') ||
                   ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
               $url .= (($url=~/\?/)?'&amp;':'?') . 'ttoken='.$token;
           }
       }
       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 {
       my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk,
           $possdoms) = @_;
       my $contactblock;
       my $origmail;
       if (ref($possdoms) eq 'ARRAY') {
           if (grep(/^\Q$authdomain\E$/,@{$possdoms})) {
               $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) {
           $contactblock .= $$lt{'servadm'}.':<br />'.
                            '<tt>'.$servadm.'</tt><br />';
       }
       if ($showhelpdesk) {
           $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
           my $thisurl = &escape('/adm/login');
           $$helpdeskscript = <<"ENDSCRIPT";
   <script type="text/javascript">
   // <![CDATA[
   function helpdesk() {
       var possdom = document.client.udom.value;
       var codedom = possdom.replace( new RegExp("[^A-Za-z0-9.\\-]","g"),'');
       if (codedom == '') {
           codedom = "$authdomain";
       }
       var querystr = "origurl=$thisurl&codedom="+codedom;
       document.location.href = "/adm/helpdesk?"+querystr;
       return;
   }
   // ]]>
   </script>
   ENDSCRIPT
       }
       return $contactblock;
   }
   
   sub forgotpwdisplay {
       my (%lt) = @_;
       my $prompt_for_resetpw = 1;
       if ($prompt_for_resetpw) {
           return '<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a>';
       }
       return;
   }
   
   sub coursecatalog_link {
       my ($linkname) = @_;
       return <<"END";
         <a href="/adm/coursecatalog">$linkname</a>
   END
   }
   
   sub newuser_link {
       my ($linkname) = @_;
       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;
   __END__
Removed from v.1.140  
changed lines
  Added in v.1.198

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.