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

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

version 1.101, 2008/02/24 23:18:37 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']);   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
         $ENV{'REDIRECT_QUERY_STRING'}),
 # -- check if they are a migrating user   ['interface','username','domain','firsturl','localpath','localres',
     if (defined($env{'form.token'})) {    'token','role','symb','iptoken','btoken','ltoken','ttoken','linkkey',
  return &Apache::migrateuser::handler($r);            'saml','sso','retry']);
     }  
   # -- check if they are a migrating user
     &Apache::loncommon::no_cache($r);      if (defined($env{'form.token'})) {
     &Apache::lonlocal::get_language_handle($r);          return &Apache::migrateuser::handler($r);
     &Apache::loncommon::content_type($r,'text/html');      }
     $r->send_http_header;  
     return OK if $r->header_only;      my $lonhost = $r->dir_config('lonHostID');
       if ($env{'form.ttoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.ttoken'});
 # Are we re-routing?          &Apache::lonnet::tmpdel($env{'form.ttoken'});
     if (-e '/home/httpd/html/lon-status/reroute.txt') {          if ($info{'origurl'}) {
  &Apache::lonauth::reroute($r);              $env{'form.firsturl'} = $info{'origurl'};
  return OK;          }
     }          if ($info{'ltoken'}) {
               $env{'form.ltoken'} = $info{'ltoken'};
           } elsif ($info{'linkprot'}) {
 # -------------------------------- Prevent users from attempting to login twice              $env{'form.linkprot'} = $info{'linkprot'};
     my $handle = &Apache::lonnet::check_for_valid_session($r);          } elsif ($info{'linkkey'} ne '') {
     if ($handle=~/^publicuser\_/) {              $env{'form.linkkey'} = $info{'linkkey'};
 # For "public user" - remove it, we apparently really want to login          }
  unlink($r->dir_config('lonIDsDir')."/$handle.id");      } elsif (($env{'form.sso'}) || ($env{'form.retry'})) {
     } elsif ($handle ne '') {          my $infotoken;
 # Indeed, a valid token is found          if ($env{'form.sso'}) {
  my $start_page =               $infotoken = $env{'form.sso'};
     &Apache::loncommon::start_page('Already logged in');          } else {
  my $end_page =               $infotoken = $env{'form.retry'};
     &Apache::loncommon::end_page();          }
  $r->print(          my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
                   $start_page          unless (($data=~/^error/) || ($data eq 'con_lost') ||
                  .'<h1>'.&mt('You are already logged in').'</h1>'                  ($data eq 'no_such_host')) {
                  .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]logout[_4].',              my %info = &decode_token($data);
                   '<a href="/adm/roles">','</a>','<a href="/adm/logout">','</a>').'</p>'              foreach my $item (keys(%info)) {
                  .'<p><a href="/adm/loginproblems.html">'.&mt('Login problems?').'</a></p>'                  $env{'form.'.$item} = $info{$item};
                  .$end_page              }
                  );              &Apache::lonnet::tmpdel($infotoken);
         return OK;          }
     }      } else {
           if (!defined($env{'form.firsturl'})) {
 # ---------------------------------------------------- No valid token, continue              &Apache::lonacc::get_posted_cgi($r,['firsturl']);
           }
  # ---------------------------- Not possible to really login to domain "public"          if (!defined($env{'form.firsturl'})) {
     if ($env{'form.domain'} eq 'public') {              if ($ENV{'REDIRECT_URL'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) {
  $env{'form.domain'}='';                  $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
  $env{'form.username'}='';              }
     }          }
 # ----------------------------------------------------------- Process Interface          if (($env{'form.firsturl'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) &&
     $env{'form.interface'}=~s/\W//g;              (!$env{'form.ltoken'}) && (!$env{'form.linkprot'}) && (!$env{'form.linkkey'})) {
               &Apache::lonacc::get_posted_cgi($r,['linkkey']);
     my $textbrowsers=$r->dir_config('lonTextBrowsers');          }
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};          if ($env{'form.firsturl'} eq '/adm/logout') {
                   delete($env{'form.firsturl'});
     foreach (split(/\:/,$textbrowsers)) {          }
  if ($httpbrowser=~/$_/i) {      }
     $env{'form.interface'}='textual';  
         }  # 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');
     my $fullgraph=($env{'form.interface'} ne 'textual');      unless ($r->header_only) {
           $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
     my $iconpath=           if ($handle ne '') {
  &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));              if ($handle=~/^publicuser\_/) {
                   unlink($r->dir_config('lonIDsDir')."/$handle.id");
     my $domain = &Apache::lonnet::default_login_domain();                  undef($handle);
     if (($env{'form.domain'}) &&                   undef($userdom);
  (&Apache::lonnet::domain($env{'form.domain'},'description'))) {                  $expirepub = 1;
  $domain=$env{'form.domain'};              }
     }          }
     my $role    = $r->dir_config('lonRole');      }
     my $loadlim = $r->dir_config('lonLoadLim');  
     my $servadm = $r->dir_config('lonAdmEMail');      &Apache::loncommon::no_cache($r);
     my $lonhost = $r->dir_config('lonHostID');      &Apache::lonlocal::get_language_handle($r);
     my $tabdir  = $r->dir_config('lonTabDir');      &Apache::loncommon::content_type($r,'text/html');
     my $include = $r->dir_config('lonIncludes');      if ($expirepub) {
     my $expire  = $r->dir_config('lonExpire');          my $c = new CGI::Cookie(-name    => 'lonPubID',
     my $version = $r->dir_config('lonVersion');                                  -value   => '',
     my $host_name = &Apache::lonnet::hostname($lonhost);                                  -expires => '-10y',);
           $r->header_out('Set-cookie' => $c);
 # --------------------------------------------- Default values for login fields      } elsif (($handle eq '') && ($userdom ne '')) {
           my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
     my $authusername=($env{'form.username'}?$env{'form.username'}:'');          foreach my $name (keys(%cookies)) {
     my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);              next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
               my $c = new CGI::Cookie(-name    => $name,
 # ---------------------------------------------------------- Determine own load                                      -value   => '',
     my $loadavg;                                      -expires => '-10y',);
     {              $r->headers_out->add('Set-cookie' => $c);
  my $loadfile=Apache::File->new('/proc/loadavg');          }
  $loadavg=<$loadfile>;      }
     }      $r->send_http_header;
     $loadavg =~ s/\s.*//g;      return OK if $r->header_only;
     my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);  
     my $userloadpercent=&Apache::lonnet::userload();  
   # Are we re-routing?
 # ------------------------------------------------------- Do the load balancing      my $londocroot = $r->dir_config('lonDocRoot');
     my $otherserver= &Apache::lonnet::absolute_url($host_name);      if (-e "$londocroot/lon-status/reroute.txt") {
     my $firsturl=   &Apache::lonauth::reroute($r);
     ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});   return OK;
 # ---------------------------------------------------------- Are we overloaded?      }
     if ((($userloadpercent>100.0)||($loadpercent>100.0))) {  
         my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent);  # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
  if ($unloaded) { $otherserver=$unloaded; }  
     }      my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
       if ($found_server) {
 # ----------------------------------------------------------- Get announcements          my $hostname = &Apache::lonnet::hostname($found_server);
     my $announcements=&Apache::lonnet::getannounce();          if ($hostname ne '') {
 # -------------------------------------------------------- Set login parameters              my $protocol = $Apache::lonnet::protocol{$found_server};
               $protocol = 'http' if ($protocol ne 'https');
     my @hexstr=('0','1','2','3','4','5','6','7',              my $dest = '/adm/roles';
                 '8','9','a','b','c','d','e','f');              if ($env{'form.firsturl'} ne '') {
     my $lkey='';                  $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
     for (0..7) {              }
         $lkey.=$hexstr[rand(15)];              my %info = (
     }                           balcookie => $lonhost.':'.$balancer_cookie,
                          );
     my $ukey='';              if ($env{'form.role'}) {
     for (0..7) {                  $info{'role'} = $env{'form.role'};
         $ukey.=$hexstr[rand(15)];              }
     }              if ($env{'form.symb'}) {
                   $info{'symb'} = $env{'form.symb'};
     my $lextkey=hex($lkey);              }
     if ($lextkey>2147483647) { $lextkey-=4294967296; }              my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
               unless (($balancer_token eq 'con_lost') || ($balancer_token eq 'refused') ||
     my $uextkey=hex($ukey);                      ($balancer_token eq 'unknown_cmd') || ($balancer_token eq 'no_such_host')) {
     if ($uextkey>2147483647) { $uextkey-=4294967296; }                  $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'btoken='.$balancer_token;
               }
 # -------------------------------------------------------- Store away log token              if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
     my $logtoken=Apache::lonnet::reply(                  my %link_info;
        'tmpput:'.$ukey.$lkey.'&'.$firsturl,                  if ($env{'form.ltoken'}) {
        $lonhost);                      $link_info{'ltoken'} = $env{'form.ltoken'};
                   } elsif ($env{'form.linkprot'}) {
 # ------------------- If we cannot talk to ourselves, we are in serious trouble                      $link_info{'linkprot'} = $env{'form.linkprot'};
                   } elsif ($env{'form.linkkey'} ne '') {
     if ($logtoken eq 'con_lost') {                      $link_info{'linkkey'} = $env{'form.linkkey'};
         my $spares='';                  }
  my $last;                  if (keys(%link_info)) {
         foreach my $hostid (sort                      $link_info{'origurl'} = $env{'form.firsturl'};
     {                      my $token = &Apache::lonnet::tmpput(\%link_info,$found_server,'link');
  &Apache::lonnet::hostname($a) cmp                      unless (($token eq 'con_lost') || ($token eq 'refused') ||
     &Apache::lonnet::hostname($b);                              ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
     }                          $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'ttoken='.$token;
     keys(%Apache::lonnet::spareid)) {                      }
             next if ($hostid eq $lonhost);                  }
     my $hostname = &Apache::lonnet::hostname($hostid);              }
     next if ($last eq $hostname);              unless ($found_server eq $lonhost) {
             $spares.='<br /><font size="+1"><a href="http://'.                  my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server);
                 $hostname.                  $hostname = $alias if ($alias ne '');
                 '/adm/login?domain='.$authdomain.'">'.              }
                 $hostname.'</a>'.              my $url = $protocol.'://'.$hostname.$dest;
                 ' (preferred)</font>'.$/;              my $start_page =
     $last=$hostname;                  &Apache::loncommon::start_page('Switching Server ...',undef,
         }                                                 {'redirect'       => [0,$url],});
         $spares.= '<br />';              my $end_page   = &Apache::loncommon::end_page();
  my %all_hostnames = &Apache::lonnet::all_hostnames();              $r->print($start_page.$end_page);
         foreach my $hostid (sort              return OK;
     {          }
  &Apache::lonnet::hostname($a) cmp      }
     &Apache::lonnet::hostname($b);  
     }  #
     keys(%all_hostnames)) {  # Check if a LON-CAPA load balancer sent user here because user's browser sent
             next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});  # it a balancer cookie for an active session on this server.
     my $hostname = &Apache::lonnet::hostname($hostid);  #
             next if ($last eq $hostname);  
             $spares.='<br /><a href="http://'.      my $balcookie;
                 $hostname.      if ($env{'form.btoken'}) {
                 '/adm/login?domain='.$authdomain.'">'.          my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
                 $hostname.'</a>';          $balcookie = $info{'balcookie'};
     $last=$hostname;          &Apache::lonnet::tmpdel($env{'form.btoken'});
         }          delete($env{'form.btoken'});
  $r->print(<<ENDTROUBLE);      }
 <html>  
 <head><title>The LearningOnline Network with CAPA</title></head>  #
 <body bgcolor="#FFFFFF">  # If browser sent an old cookie for which the session file had been removed
 <img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />  # check if configuration for user's domain has a portal URL set.  If so
 <h3>This LON-CAPA server is temporarily not available for login</h3>  # switch user's log-in to the portal.
 <p>Please attempt to login to one of the following servers:</p>$spares  #
 </body>  
 </html>      if (($handle eq '') && ($userdom ne '')) {
 ENDTROUBLE          my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom);
         return OK;          if ($domdefaults{'portal_def'} =~ /^https?\:/) {
     }              my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                             {'redirect' => [0,$domdefaults{'portal_def'}],});
 # ----------------------------------------------- Apparently we are in business              my $end_page   = &Apache::loncommon::end_page();
     $servadm=~s/\,/\<br \/\>/g;              $r->print($start_page.$end_page);
               return OK;
 # ----------------------------------------------------------- Front page design          }
     my $pgbg=      }
       ($fullgraph?&Apache::loncommon::designparm('login.pgbg',$domain):'#FFFFFF');  
     my $font=  # -------------------------------- Prevent users from attempting to login twice
       ($fullgraph?&Apache::loncommon::designparm('login.font',$domain):'#000000');      if ($handle ne '') {
     my $link=          &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
       ($fullgraph?&Apache::loncommon::designparm('login.link',$domain):'#0000FF');   my $start_page =
     my $vlink=      &Apache::loncommon::start_page('Already logged in');
       ($fullgraph?&Apache::loncommon::designparm('login.vlink',$domain):'#0000FF');   my $end_page =
     my $alink=&Apache::loncommon::designparm('login.alink',$domain);      &Apache::loncommon::end_page();
     my $mainbg=          my $dest = '/adm/roles';
       ($fullgraph?&Apache::loncommon::designparm('login.mainbg',$domain):'#FFFFFF');          if ($env{'form.firsturl'} ne '') {
     my $sidebg=              $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
       ($fullgraph?&Apache::loncommon::designparm('login.sidebg',$domain):'#FFFFFF');          }
     my $textcol =           if (($env{'form.ltoken'}) || ($env{'form.linkprot'})) {
       ($fullgraph?&Apache::loncommon::designparm('login.textcol',$domain):'#000000');              my $linkprot;
     my $bgcol =              if ($env{'form.ltoken'}) {
       ($fullgraph?&Apache::loncommon::designparm('login.bgcol',$domain):'#FFFFFF');                  my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
     my $logo=&Apache::loncommon::designparm('login.logo',$domain);                  $linkprot = $info{'linkprot'};
     my $img=&Apache::loncommon::designparm('login.img',$domain);                  my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
     my $domainlogo=&Apache::loncommon::domainlogo($domain);              } else {
     my $login=&Apache::loncommon::designparm('login.login',$domain);                  $linkprot = $env{'form.linkprot'};
     if ($login eq '') {              }
         $login = $iconpath.'/'.&mt('userauthentication.gif');              if ($linkprot) {
     }                  my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
     my $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);                  if ($env{'user.linkprotector'}) {
     my $showcoursecat =                      my @protectors = split(/,/,$env{'user.linkprotector'});
         &Apache::loncommon::designparm('login.coursecatalog',$domain);                      unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
     my $loginheader =&Apache::loncommon::designparm('login.loginheader',$domain);                          push(@protectors,$linkprotector);
     my $shownewuserlink =                           @protectors = sort { $a <=> $b } @protectors;
         &Apache::loncommon::designparm('login.newuser',$domain);                          &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
     my $now=time;                      }
     my $js = (<<ENDSCRIPT);                  } else {
                       &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
  <script language="JavaScript">                  }
     function send()                  if ($env{'user.linkproturi'}) {
     {                      my @proturis = split(/,/,$env{'user.linkproturi'});
         this.document.server.elements.uname.value                      unless (grep(/^\Q$deeplink\E$/,@proturis)) {
        =this.document.client.elements.uname.value;                          push(@proturis,$deeplink);
                           @proturis = sort @proturis;
         this.document.server.elements.udom.value                          &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
        =this.document.client.elements.udom.value;                      }
                   } else {
         this.document.server.elements.imagesuppress.value                      &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
        =this.document.client.elements.imagesuppress.checked;                  }
               }
         this.document.server.elements.embedsuppress.value          } elsif ($env{'form.linkkey'} ne '') {
        =this.document.client.elements.embedsuppress.checked;              if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
                   my $linkkey = $env{'form.linkkey'};
         this.document.server.elements.appletsuppress.value                  if ($env{'user.deeplinkkey'}) {
        =this.document.client.elements.appletsuppress.checked;                      my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
                       unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
         this.document.server.elements.fontenhance.value                          push(@linkkeys,$linkkey);
        =this.document.client.elements.fontenhance.checked;                          &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
                       }
         this.document.server.elements.blackwhite.value                  } else {
        =this.document.client.elements.blackwhite.checked;                      &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
                   }
         this.document.server.elements.remember.value                  my $deeplink = $env{'form.firsturl'};
        =this.document.client.elements.remember.checked;                  if ($env{'user.keyedlinkuri'}) {
                       my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
         uextkey=this.document.client.elements.uextkey.value;                      unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
         lextkey=this.document.client.elements.lextkey.value;                          push(@keyeduris,$deeplink);
         initkeys();                          &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
                       }
         this.document.server.elements.upass0.value                  } else {
             =crypted(this.document.client.elements.upass$now.value.substr(0,15));                      &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
         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));   $r->print(
                     $start_page
         this.document.client.elements.uname.value='';                   .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
         this.document.client.elements.upass$now.value='';                   .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
                     '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'
         this.document.server.submit();                   .$end_page
         return false;                   );
     }          return OK;
  </script>      }
   
 ENDSCRIPT  # ---------------------------------------------------- No valid token, continue
   
 # --------------------------------------------------- Print login screen header  # ---------------------------- Not possible to really login to domain "public"
       if ($env{'form.domain'} eq 'public') {
     my %add_entries = (topmargin    => "0",   $env{'form.domain'}='';
                        leftmargin   => "0",   $env{'form.username'}='';
                        marginheight => "0",      }
                        marginwidth  => "0",  
                        bgcolor      => "$pgbg",  # ------ Is this page requested because /adm/migrateuser detected an IP change?
                        text         => "$font",      my %sessiondata;
                        link         => "$link",      if ($env{'form.iptoken'}) {
                        vlink        => "$vlink",          %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'});
                        alink        => "$alink",);          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' => 'Load',      my $domain = &Apache::lonnet::default_login_domain();
                   'userload' => 'User Load',      my $defdom = $domain;
                   'about'  => 'About LON-CAPA',      if ($lonhost ne '') {
                   'access' => 'Accessibility Options',          unless ($sessiondata{'sessionserver'}) {
                   'catalog' => 'Course Catalog',              my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie);
   'log' => 'Log in',              if ($redirect) {
   'help' => 'Log-in Help',                  $r->print($redirect);
   'serv' => 'Server',                  return OK;
                   'servadm' => 'Server Administration',              }
                   'helpdesk' => 'Contact Helpdesk',          }
                   'forgotpw' => 'Forgot password?',      }
                   'newuser'  => 'New User?',  
                   'options_headline' => 'Select Accessibility Options',      if (($sessiondata{'domain'}) &&
                   'sprs_img' => 'Suppress rendering of images',          (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
                   'sprs_applet' => 'Suppress Java applets',          $domain=$sessiondata{'domain'};
                   'sprs_embed' => 'Suppress rendering of embedded multimedia',      } elsif (($env{'form.domain'}) &&
                   'sprs_font' => 'Increase font size',   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
                   'sprs_blackwhite' => 'Switch to black and white mode',   $domain=$env{'form.domain'};
                   'remember' => 'Remember these settings for next login');      }
 # -------------------------------------------------- Change password field name  
     my $forgotpw = &forgotpwdisplay(%lt);      my $role    = $r->dir_config('lonRole');
     my $loginhelp = &loginhelpdisplay(%lt);      my $loadlim = $r->dir_config('lonLoadLim');
       my $uloadlim= $r->dir_config('lonUserLoadLim');
 # ---------------------------------------------------- Serve out DES JavaScript      my $servadm = $r->dir_config('lonAdmEMail');
     {      my $tabdir  = $r->dir_config('lonTabDir');
         my $jsh=Apache::File->new($include."/londes.js");      my $include = $r->dir_config('lonIncludes');
         $r->print(<$jsh>);      my $expire  = $r->dir_config('lonExpire');
     }      my $version = $r->dir_config('lonVersion');
 # ---------------------------------------------------------- Serve rest of page      my $host_name = &Apache::lonnet::hostname($lonhost);
   
     if ($fullgraph) {  # --------------------------------------------- Default values for login fields
  $r->print(     
   '<table width="100%" cellpadding=0 cellspacing=0 border=0>');      my ($authusername,$authdomain);
     }      if ($sessiondata{'username'}) {
           $authusername=$sessiondata{'username'};
     $r->print(<<ENDSERVERFORM);      } else {
   <form name="server" action="$otherserver/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="interface" value="$env{'form.interface'}" />      if ($sessiondata{'domain'}) {
    <input type="hidden" name="uname" value="" />          $authdomain=$sessiondata{'domain'};
    <input type="hidden" name="upass0" value="" />      } else {
    <input type="hidden" name="upass1" value="" />          $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'});
    <input type="hidden" name="upass2" value="" />          $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
    <input type="hidden" name="udom" value="" />      }
    <input type="hidden" name="imagesuppress"  value="" />  
    <input type="hidden" name="appletsuppress"  value="" />  # ---------------------------------------------------------- Determine own load
    <input type="hidden" name="embedsuppress"  value="" />      my $loadavg;
    <input type="hidden" name="fontenhance"  value="" />      {
    <input type="hidden" name="blackwhite"  value="" />   my $loadfile=Apache::File->new('/proc/loadavg');
    <input type="hidden" name="remember"  value="" />   $loadavg=<$loadfile>;
    <input type="hidden" name="localpath" value="$env{'form.localpath'}" />      }
    <input type="hidden" name="localres" value="$env{'form.localres'}" />      $loadavg =~ s/\s.*//g;
   </form>  
 ENDSERVERFORM      my ($loadpercent,$userloadpercent);
     my $coursecatalog;      if ($loadlim) {
     if (($showcoursecat eq '') || ($showcoursecat)) {          $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
         $coursecatalog = &coursecatalog_link($lt{'catalog'});      }
     }      if ($uloadlim) {
     my $newuserlink;          $userloadpercent=&Apache::lonnet::userload();
     if ($shownewuserlink) {      }
         $newuserlink = &newuser_link($lt{'newuser'});  
     }      my $firsturl=
     if ($fullgraph) { $r->print(<<ENDTOP);      ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
   <!-- The LON-CAPA Header -->  
   <tr>  # ----------------------------------------------------------- Get announcements
       my $announcements=&Apache::lonnet::getannounce();
    <!-- Row 1 Columns 2-4 -->  # -------------------------------------------------------- Set login parameters
    <td width="100%" height=75 colspan=4 align="left" valign="top" bgcolor="$pgbg"><img src="$img" border=0 alt="The Learning Online Network with CAPA" /></td>  
   </tr>      my @hexstr=('0','1','2','3','4','5','6','7',
                   '8','9','a','b','c','d','e','f');
   <!-- The gray bar that starts the two table frames -->      my $lkey='';
   <tr>      for (0..7) {
           $lkey.=$hexstr[rand(15)];
    <!-- Row 2 Column 1 -->      }
    <td width=182 height=27 bgcolor="$sidebg">&nbsp;</td>  
       my $ukey='';
    <!-- Row 2 Column 2 -->      for (0..7) {
    <td width=27 height=27 align="left" background="$iconpath/filltop.gif"><img src="$iconpath/upperleft.gif" border=0 alt="" /></td>          $ukey.=$hexstr[rand(15)];
       }
    <!-- Row 2 Column 3 -->  
    <td height=27 background="$iconpath/filltop.gif"><img src="$iconpath/filltop.gif" alt="" /></td>      my $lextkey=hex($lkey);
       if ($lextkey>2147483647) { $lextkey-=4294967296; }
    <!-- Row 2 Column 4 -->  
    <td width=27 height=27 align="right" background="$iconpath/filltop.gif"><img src="$iconpath/upperright.gif" border=0 alt="" /></td>      my $uextkey=hex($ukey);
   </tr>      if ($uextkey>2147483647) { $uextkey-=4294967296; }
   <tr>  
      # -------------------------------------------------------- Store away log token
    <!-- A cell that will hold the 'access', 'about', and 'catalog' links -->      my ($tokenextras,$tokentype,$linkprot_for_login);
    <!-- Row 3 Column 1 -->      my @names = ('role','symb','iptoken','ltoken','linkprot','linkkey');
    <td valign="top" height="60" align="left" bgcolor="$sidebg">      foreach my $name (@names) {
     <table cellpadding="0" cellspacing="2" border="0">          if ($env{'form.'.$name} ne '') {
      <tr>              if ($name eq 'ltoken') {
       <td>&nbsp;</td>                  my %info = &Apache::lonnet::tmpget($env{'form.'.$name});
       <td><a href="/adm/login?interface=textual"><b>$lt{'access'}</b></a></td>                  if ($info{'linkprot'}) {
      </tr>                      $linkprot_for_login = $info{'linkprot'};
      <tr>                      $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
       <td>&nbsp;</td>                      $tokentype = 'link';
       <td><a href="/adm/about.html"><b>$lt{'about'}</b></a></td>                      last;
      </tr>$coursecatalog                  }
      <tr>              } else {
       <td colspan="2">&nbsp;</td>                  $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
      </tr>                  if (($name eq 'linkkey') || ($name eq 'linkprot')) {
     </table>                      if ((($env{'form.retry'}) || ($env{'form.sso'})) &&
    </td>                          (!$env{'form.ltoken'}) && ($name eq 'linkprot')) {
    <!-- The shaded space between the two main columns -->                          $linkprot_for_login = $env{'form.linkprot'};
    <!-- Row 3 Column 2 -->                      }
    <td width=27 height=60 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>                      $tokentype = 'link';
                   }
    <!-- The right main column holding the large LON-CAPA logo-->              }
    <!-- Rows 3-4 Column 3 -->          }
    <td align="center" valign="top" width="100%" height="100%" bgcolor="$mainbg">      }
     <center>      if ($tokentype) {
      <img src="$logo" alt="" />          $tokenextras .= ":$tokentype";
     </center>      }
    </td>      my $logtoken=Apache::lonnet::reply(
          'tmpput:'.$ukey.$lkey.'&'.&escape($firsturl).$tokenextras,
    <!-- Row 3 Column 4 -->         $lonhost);
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>  
   </tr>  # -- If we cannot talk to ourselves, or hostID does not map to a hostname
   <tr>  #    we are in serious trouble
   
    <!-- The entry form -->      if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
    <!-- Row 4 Column 1 -->          if ($logtoken eq 'no_such_host') {
    <td align="center" valign="middle" bgcolor="$sidebg">              &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
 ENDTOP          }
 } else {          if ($env{'form.ltoken'}) {
     $r->print('<h1>The Learning<i>Online</i> Network with CAPA</h1>'              &Apache::lonnet::tmpdel($env{'form.ltoken'});
              .'<h2>'.&mt('Text-based Interface Login').'</h2>'              delete($env{'form.ltoken'});
              .$announcements);          }
 }          my $spares='';
     $r->print('<form name="client" onsubmit="return(send())">');          my (@sparehosts,%spareservers);
     unless ($fullgraph) {          my $sparesref = &Apache::lonnet::this_host_spares($defdom);
         $r->print(<<ENDACCESSOPTIONS);          if (ref($sparesref) eq 'HASH') {
 <h3>$lt{'options_headline'}</h3>              foreach my $key (keys(%{$sparesref})) {
 <label><input type="checkbox" name="imagesuppress" /> $lt{'sprs_img'}</label><br />                  if (ref($sparesref->{$key}) eq 'ARRAY') {
 <label><input type="checkbox" name="appletsuppress" /> $lt{'sprs_applet'}</label><br />                      my @sorted = sort { &Apache::lonnet::hostname($a) cmp
 <label><input type="checkbox" name="embedsuppress" /> $lt{'sprs_embed'}</label><br />                                          &Apache::lonnet::hostname($b);
 <label><input type="checkbox" name="fontenhance" /> $lt{'sprs_font'}</label><br />                                        } @{$sparesref->{$key}};
 <label><input type="checkbox" name="blackwhite" /> $lt{'sprs_blackwhite'}</label><br />                      if (@sorted) {
 <br />                          if ($key eq 'primary') {
 <input type="checkbox" name="remember" /> $lt{'remember'}<hr />                              unshift(@sparehosts,@sorted);
 ENDACCESSOPTIONS                          } elsif ($key eq 'default') {
 } else {                              push(@sparehosts,@sorted);
     $r->print(<<ENDNOOPT);                          }
 <input type="hidden" name="imagesuppress"  value="" />                      }
 <input type="hidden" name="embedsuppress"  value="" />                  }
 <input type="hidden" name="appletsuppress"  value="" />              }
 <input type="hidden" name="fontenhance"  value="" />          }
 <input type="hidden" name="blackwhite"  value="" />          foreach my $hostid (@sparehosts) {
 <input type="hidden" name="remember"  value="" />              next if ($hostid eq $lonhost);
 ENDNOOPT      my $hostname = &Apache::lonnet::hostname($hostid);
 }      next if (($hostname eq '') || ($spareservers{$hostname}));
     my $logintitle;              $spareservers{$hostname} = 1;
     if ($loginheader eq 'text') {              my $protocol = $Apache::lonnet::protocol{$hostid};
         $logintitle = '<td bgcolor="'.$bgcol.'" colspan="2">&nbsp;&nbsp;&nbsp;<b><font size="+1" color="'.$textcol.'">'.$lt{'log'}.'</font></b></td>';              $protocol = 'http' if ($protocol ne 'https');
     } else {              $spares.='<br /><span style="font-size: larger;"><a href="'.$protocol.'://'.
         $logintitle = '<td bgcolor="'.$sidebg.'" colspan="2"><img src="'.$login.'" alt="'.                  $hostname.
                       &mt('User Authentication').'" /></td>';                  '/adm/login?domain='.$authdomain.'">'.
     }                  $hostname.'</a>'.
     $r->print(<<ENDLOGIN);                  ' '.&mt('(preferred)').'</span>'.$/;
      <input type="hidden" name="lextkey" value="$lextkey">          }
      <input type="hidden" name="uextkey" value="$uextkey">          if ($spares) {
               $spares.= '<br />';
      <!-- Start the sub-table for text and input alignment -->          }
      <table border=0 cellspacing=0 cellpadding=0>          my %all_hostnames = &Apache::lonnet::all_hostnames();
       <tr>$logintitle</tr>          foreach my $hostid (sort
       <tr>      {
        <td bgcolor="$mainbg"><br /><font size=-1><b>&nbsp;&nbsp;&nbsp;<label for="uname">$lt{'un'}</label>:</b></font></td>   &Apache::lonnet::hostname($a) cmp
        <td bgcolor="$mainbg"><br /><input type="text" name="uname" size="10" value="$authusername" /></td>      &Apache::lonnet::hostname($b);
       </tr>      }
       <tr>      keys(%all_hostnames)) {
        <td bgcolor="$mainbg"><font size=-1><b>&nbsp;&nbsp;&nbsp;<label for="upass$now">$lt{'pw'}</label>:</b></font></td>              next if ($hostid eq $lonhost);
        <td bgcolor="$mainbg"><input type="password" name="upass$now" size="10" /></td>              my $hostname = &Apache::lonnet::hostname($hostid);
       </tr>              next if (($hostname eq '') || ($spareservers{$hostname}));
       <tr>              $spareservers{$hostname} = 1;
        <td bgcolor="$mainbg"><font size=-1><b>&nbsp;&nbsp;&nbsp;<label for="udom">$lt{'dom'}</label>:</b></font></td>              my $protocol = $Apache::lonnet::protocol{$hostid};
        <td bgcolor="$mainbg"><input type="text" name="udom" size="10" value="$authdomain" /></td>              $protocol = 'http' if ($protocol ne 'https');
       </tr>              $spares.='<br /><a href="'.$protocol.'://'.
       <tr>               $hostname.
        <td bgcolor="$mainbg">&nbsp;</td>               '/adm/login?domain='.$authdomain.'">'.
        <td bgcolor="$mainbg" valign="bottom" align="center">               $hostname.'</a>';
         <br />           }
         <input type="submit" value="$lt{'log'}" />           $r->print(
        </td>     '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
       </tr>    .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'
       <tr>    .'<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" /><title>'
        <td bgcolor="$mainbg" valign="bottom" align="left" colspan="2">    .&mt('The LearningOnline Network with CAPA')
         $loginhelp    .'</title></head>'
         $forgotpw    .'<body bgcolor="#FFFFFF">'
         $newuserlink    .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
         <br />    .'<img src="/adm/lonKaputt/lonlogo_broken.gif" alt="broken icon" align="right" />'
        </td>    .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
       </tr>          if ($spares) {
      </table>              $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
      <!-- End sub-table -->                       .'</p>'
     </form>                       .$spares);
 ENDLOGIN          }
     if ($fullgraph) {          $r->print('</body>'
         my $helpdeskscript;                   .'</html>'
         my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,          );
                                   $version,$authdomain,\$helpdeskscript);          return OK;
  $r->print(<<ENDDOCUMENT);      }
    </td>  
   # ----------------------------------------------- Apparently we are in business
    <!-- Row 4 Column 2 -->      $servadm=~s/\,/\<br \/\>/g;
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>  
   # ----------------------------------------------------------- Front page design
    <!-- Row 4 Column 3 -->      my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
 <td bgcolor="$mainbg">$announcements</td>      my $font=&Apache::loncommon::designparm('login.font',$domain);
       my $link=&Apache::loncommon::designparm('login.link',$domain);
    <!-- Row 4 Column 4 -->      my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>      my $alink=&Apache::loncommon::designparm('login.alink',$domain);
   </tr>      my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
   <tr>      my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
       my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
    <!-- Row 5 Column 1 -->      my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
    <td bgcolor="$sidebg" valign="middle" align="left">      my $logo=&Apache::loncommon::designparm('login.logo',$domain);
      <br />      my $img=&Apache::loncommon::designparm('login.img',$domain);
      <table border=0 cellspacing=0 cellpadding=0>      my $domainlogo=&Apache::loncommon::domainlogo($domain);
       <tr>      my $showbanner = 1;
        <td bgcolor="$sidebg" align="left" valign="top">      my $showmainlogo = 1;
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'dom'}:&nbsp;</b></small>      if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
        </td>          $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
        <td bgcolor="$sidebg" align="left" valign="top">      }
         <small><tt>&nbsp;$domain</tt></small>      if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
        </td>          $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
       </tr>      }
       <tr>      my $showadminmail;
        <td bgcolor="$sidebg" align="left" valign="top">      my @possdoms = &Apache::lonnet::current_machine_domains();
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'serv'}:&nbsp;</b></small>      if (grep(/^\Q$domain\E$/,@possdoms)) {
        </td>          $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
        <td bgcolor="$sidebg" align="left" valign="top">      }
         <small><tt>&nbsp;$lonhost ($role)</tt></small>      my $showcoursecat =
        </td>          &Apache::loncommon::designparm('login.coursecatalog',$domain);
       </tr>      my $shownewuserlink =
       <tr>          &Apache::loncommon::designparm('login.newuser',$domain);
        <td bgcolor="$sidebg" align="left" valign="top">      my $showhelpdesk =
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'load'}:&nbsp;</b></small>          &Apache::loncommon::designparm('login.helpdesk',$domain);
        </td>      my $now=time;
        <td bgcolor="$sidebg" align="left" valign="top">      my $js = (<<ENDSCRIPT);
         <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>  
        </td>  <script type="text/javascript" language="JavaScript">
       </tr>  // <![CDATA[
       <tr>  function send()
        <td bgcolor="$sidebg" align="left" valign="top">  {
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'userload'}:&nbsp;</b></small>  this.document.server.elements.uname.value
        </td>  =this.document.client.elements.uname.value;
        <td bgcolor="$sidebg" align="left" valign="top">  
         <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>  this.document.server.elements.udom.value
        </td>  =this.document.client.elements.udom.value;
       </tr>  
      </table>  uextkey=this.document.client.elements.uextkey.value;
      <br />  lextkey=this.document.client.elements.lextkey.value;
     $contactblock  initkeys();
    </td>  
   if(this.document.server.action.substr(0,5) === 'http:'){
    <!-- Row 5 Column 2 -->      this.document.server.elements.upass0.value
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>          =getCrypted(this.document.client.elements.upass$now.value);
   } else {
    <!-- Row 5 Column 3 -->      this.document.server.elements.upass0.value
    <td width="100%" valign="bottom" bgcolor="$mainbg">          =this.document.client.elements.upass$now.value;
 $domainlogo  }
 </td>  
   this.document.client.elements.uname.value='';
    <!-- Row 5 Column 4 -->  this.document.client.elements.upass$now.value='';
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>  
   </tr>  this.document.server.submit();
   <tr>  return false;
   }
    <!-- Row 6 Column 1 -->  
    <td bgcolor="$sidebg">&nbsp;</td>  function enableInput() {
       this.document.client.elements.upass$now.removeAttribute("readOnly");
    <!-- Row 6 Column 2 -->      this.document.client.elements.uname.removeAttribute("readOnly");
    <td align="left" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerleft.gif" alt="" /></td>      this.document.client.elements.udom.removeAttribute("readOnly");
       return;
    <!-- Row 6 Column 3 -->  }
    <td background="$iconpath/fillbottom.gif"><img src="$iconpath/fillbottom.gif" alt="" /></td>  
   // ]]>
    <!-- Row 6 Column 4 -->  </script>
    <td align="right" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerright.gif" alt="" /></td>  
   </tr>  ENDSCRIPT
  </table>  
       my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
 <script type="text/javascript">          $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip);
 // the if prevents the script error if the browser can not handle this      %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
 if ( document.client.uname ) { document.client.uname.focus(); }      @hosts = &Apache::lonnet::current_machine_ids();
 </script>      $lonhost_in_use = $lonhost;
 $helpdeskscript      if (@hosts > 1) {
           foreach my $hostid (@hosts) {
 ENDDOCUMENT              if (&Apache::lonnet::host_domain($hostid) eq $defdom) {
 }                  $lonhost_in_use = $hostid;
     my %endargs = ( 'noredirectlink' => 1, );                  last;
     $r->print(&Apache::loncommon::end_page(\%endargs));              }
     return OK;          }
 }      }
       $saml_prefix = $defdom.'.login.saml_';
 sub contactdisplay {      if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) {
     my ($lt,$servadm,$showadminmail,$version,$authdomain,$helpdeskscript) = @_;          $saml_landing = 1;
     my $contactblock;          $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use};
     my $showhelpdesk = 0;          $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use};
     my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};          $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use};
     if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {          $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use};
         $showhelpdesk = 1;          $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use};
     }          $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use};
     if ($servadm && $showadminmail) {      }
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;'.$$lt{'servadm'}.':</b><br />'.      if ($saml_landing) {
                          '<tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.$servadm.'</tt><br />&nbsp;<br />';         if ($samlssotext eq '') {
     }             $samlssotext = 'SSO Login';
     if ($showhelpdesk) {         }
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;<a href="javascript:helpdesk()"><font size="+1">'.$lt->{'helpdesk'}.'</font></a></b><br />';         if ($samlnonsso eq '') {
         my $thisurl = &escape('/adm/login');             $samlnonsso = 'Non-SSO Login';
         $$helpdeskscript = <<"ENDSCRIPT";         }
 <script type="text/javascript">         $js .= <<"ENDSAMLJS";
 function helpdesk() {  
     var codedom = document.client.udom.value;  <script type="text/javascript">
     if (codedom == '') {  // <![CDATA[
         codedom = "$authdomain";  function toggleLClogin() {
     }      if (document.getElementById('LC_standard_login')) {
     var querystr = "origurl=$thisurl&codedom="+codedom;          if (document.getElementById('LC_standard_login').style.display == 'none') {
     document.location.href = "/adm/helpdesk?"+querystr;              document.getElementById('LC_standard_login').style.display = 'inline-block';
     return;              if (document.getElementById('LC_login_text')) {
 }                  document.getElementById('LC_login_text').innerHTML = '$samlnonsso';
 </script>              }
 ENDSCRIPT              if ( document.client.uname ) { document.client.uname.focus(); }
     }              if (document.getElementById('LC_SSO_login')) {
     $contactblock .= <<"ENDBLOCK";                  document.getElementById('LC_SSO_login').style.display = 'none';
      &nbsp;&nbsp;&nbsp;$version              }
 ENDBLOCK          } else {
     return $contactblock;              document.getElementById('LC_standard_login').style.display = 'none';
 }              if (document.getElementById('LC_login_text')) {
                   document.getElementById('LC_login_text').innerHTML = '$samlssotext';
 sub forgotpwdisplay {              }
     my (%lt) = @_;              if (document.getElementById('LC_SSO_login')) {
     my $prompt_for_resetpw = 1;                   document.getElementById('LC_SSO_login').style.display = 'inline-block';
     if ($prompt_for_resetpw) {              }
         return '<br />&nbsp;&nbsp;&nbsp;<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a></b><br />';          }
     }      }
     return;      return;
 }  }
   
 sub loginhelpdisplay {  // ]]>
     my (%lt) = @_;  </script>
     my $login_help = 1;  
     if ($login_help) {  ENDSAMLJS
         return '&nbsp;&nbsp;&nbsp;<a href="/adm/loginproblems.html">'.$lt{'help'}.'</a></b>';      }
     }  
     return;  # --------------------------------------------------- Print login screen header
 }  
       my %add_entries = (
 sub coursecatalog_link {         bgcolor      => "$mainbg",
     my ($linkname) = @_;         text         => "$font",
     return <<"END";         link         => "$link",
      <tr>         vlink        => "$vlink",
       <td>&nbsp;</td>         alink        => "$alink",
       <td><a href="/adm/coursecatalog"><b>$linkname</b></a></td>                 onload       => 'javascript:enableInput();',);
      </tr>  
 END      my ($headextra,$headextra_exempt);
 }      $headextra = $defaultdomconf{$defdom.'.login.headtag_'.$lonhost_in_use};
       $headextra_exempt = $defaultdomconf{$domain.'.login.headtag_exempt_'.$lonhost_in_use};
 sub newuser_link {      if ($headextra) {
     my ($linkname) = @_;          my $omitextra;
     return '&nbsp;&nbsp;&nbsp;<a href="/adm/createaccount"><b>'.$linkname.'</b></a><br />';          if ($headextra_exempt ne '') {
 }              my @exempt = split(',',$headextra_exempt);
               my $ip = &Apache::lonnet::get_requestor_ip();
 1;              if (grep(/^\Q$ip\E$/,@exempt)) {
 __END__                  $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.101  
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.