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

Diff for /loncom/auth/lonlogin.pm between versions 1.92 and 1.158.2.13.2.3

version 1.92, 2007/04/07 19:15:03 version 1.158.2.13.2.3, 2022/02/24 16:43:39
Line 30  package Apache::lonlogin; Line 30  package Apache::lonlogin;
   
 use strict;  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use CGI::Cookie();  
 use Apache::File ();  use Apache::File ();
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
Line 38  use Apache::lonauth(); Line 37  use Apache::lonauth();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Apache::migrateuser();  use Apache::migrateuser();
 use lib '/home/httpd/lib/perl/';  use lib '/home/httpd/lib/perl/';
 use LONCAPA;  use LONCAPA qw(:DEFAULT :match);
   use URI::Escape;
   use HTML::Entities();
   use CGI::Cookie();
     
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
Line 47  sub handler { Line 49  sub handler {
  (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
       $ENV{'REDIRECT_QUERY_STRING'}),        $ENV{'REDIRECT_QUERY_STRING'}),
  ['interface','username','domain','firsturl','localpath','localres',   ['interface','username','domain','firsturl','localpath','localres',
   'token']);    'token','role','symb','iptoken','btoken','ltoken','ttoken','linkkey',
             'saml','sso','retry']);
   
 # -- check if they are a migrating user  # -- check if they are a migrating user
     if (defined($env{'form.token'})) {      if (defined($env{'form.token'})) {
  return &Apache::migrateuser::handler($r);   return &Apache::migrateuser::handler($r);
     }      }
   
       my $lonhost = $r->dir_config('lonHostID');
       if ($env{'form.ttoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.ttoken'});
           &Apache::lonnet::tmpdel($env{'form.ttoken'});
           if ($info{'origurl'}) {
               $env{'form.firsturl'} = $info{'origurl'};
           }
           if ($info{'ltoken'}) {
               $env{'form.ltoken'} = $info{'ltoken'};
           } elsif ($info{'linkprot'}) {
               $env{'form.linkprot'} = $info{'linkprot'};
           } elsif ($info{'linkkey'} ne '') {
               $env{'form.linkkey'} = $info{'linkkey'};
           }
       } elsif (($env{'form.sso'}) || ($env{'form.retry'})) {
           my $infotoken;
           if ($env{'form.sso'}) {
               $infotoken = $env{'form.sso'};
           } else {
               $infotoken = $env{'form.retry'};
           }
           my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
           unless (($data=~/^error/) || ($data eq 'con_lost') ||
                   ($data eq 'no_such_host')) {
               my %info = &decode_token($data);
               foreach my $item (keys(%info)) {
                   $env{'form.'.$item} = $info{$item};
               }
               &Apache::lonnet::tmpdel($infotoken);
           }
       } else {
           if (!defined($env{'form.firsturl'})) {
               &Apache::lonacc::get_posted_cgi($r,['firsturl']);
           }
           if (!defined($env{'form.firsturl'})) {
               if ($ENV{'REDIRECT_URL'} =~ m{^/+tiny/+$LONCAPA::match_domain/+\w+$}) {
                   $env{'form.firsturl'} = $ENV{'REDIRECT_URL'};
               }
           }
           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']);
           }
           if ($env{'form.firsturl'} eq '/adm/logout') {
               delete($env{'form.firsturl'});
           }
       }
   
   # For "public user" - remove any exising "public" cookie, as user really wants to log-in
       my ($handle,$lonidsdir,$expirepub,$userdom);
       $lonidsdir=$r->dir_config('lonIDsDir');
       unless ($r->header_only) {
           $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
           if ($handle ne '') {
               if ($handle=~/^publicuser\_/) {
                   unlink($r->dir_config('lonIDsDir')."/$handle.id");
                   undef($handle);
                   undef($userdom);
                   $expirepub = 1;
               }
           }
       }
   
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
     &Apache::lonlocal::get_language_handle($r);      &Apache::lonlocal::get_language_handle($r);
     &Apache::loncommon::content_type($r,'text/html');      &Apache::loncommon::content_type($r,'text/html');
       if ($expirepub) {
           my $c = new CGI::Cookie(-name    => 'lonPubID',
                                   -value   => '',
                                   -expires => '-10y',);
           $r->header_out('Set-cookie' => $c);
       } elsif (($handle eq '') && ($userdom ne '')) {
           my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
           foreach my $name (keys(%cookies)) {
               next unless ($name =~ /^lon(|S|Link|Pub)ID$/);
               my $c = new CGI::Cookie(-name    => $name,
                                       -value   => '',
                                       -expires => '-10y',);
               $r->headers_out->add('Set-cookie' => $c);
           }
       }
     $r->send_http_header;      $r->send_http_header;
     return OK if $r->header_only;      return OK if $r->header_only;
   
   
 # Are we re-routing?  # Are we re-routing?
     if (-e '/home/httpd/html/lon-status/reroute.txt') {      my $londocroot = $r->dir_config('lonDocRoot'); 
       if (-e "$londocroot/lon-status/reroute.txt") {
  &Apache::lonauth::reroute($r);   &Apache::lonauth::reroute($r);
  return OK;   return OK;
     }      }
   
   # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
   
       my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
       if ($found_server) {
           my $hostname = &Apache::lonnet::hostname($found_server);
           if ($hostname ne '') {
               my $protocol = $Apache::lonnet::protocol{$found_server};
               $protocol = 'http' if ($protocol ne 'https');
               my $dest = '/adm/roles';
               if ($env{'form.firsturl'} ne '') {
                   $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
               }
               my %info = (
                            balcookie => $lonhost.':'.$balancer_cookie,
                          );
               if ($env{'form.role'}) {
                   $info{'role'} = $env{'form.role'};
               }
               if ($env{'form.symb'}) {
                   $info{'symb'} = $env{'form.symb'};
               }
               my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
               unless (($balancer_token eq 'con_lost') || ($balancer_token eq 'refused') ||
                       ($balancer_token eq 'unknown_cmd') || ($balancer_token eq 'no_such_host')) {
                   $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'btoken='.$balancer_token;
               }
               if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
                   my %link_info;
                   if ($env{'form.ltoken'}) {
                       $link_info{'ltoken'} = $env{'form.ltoken'};
                   } elsif ($env{'form.linkprot'}) {
                       $link_info{'linkprot'} = $env{'form.linkprot'};
                   } elsif ($env{'form.linkkey'} ne '') {
                       $link_info{'linkkey'} = $env{'form.linkkey'};
                   }
                   if (keys(%link_info)) {
                       $link_info{'origurl'} = $env{'form.firsturl'};
                       my $token = &Apache::lonnet::tmpput(\%link_info,$found_server,'link');
                       unless (($token eq 'con_lost') || ($token eq 'refused') ||
                               ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
                           $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'ttoken='.$token;
                       }
                   }
               }
               unless ($found_server eq $lonhost) {
                   my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server);
                   $hostname = $alias if ($alias ne '');
               }
               my $url = $protocol.'://'.$hostname.$dest;
               my $start_page =
                   &Apache::loncommon::start_page('Switching Server ...',undef,
                                                  {'redirect'       => [0,$url],});
               my $end_page   = &Apache::loncommon::end_page();
               $r->print($start_page.$end_page);
               return OK;
           }
       }
   
   #
   # Check if a LON-CAPA load balancer sent user here because user's browser sent
   # it a balancer cookie for an active session on this server.
   #
   
       my $balcookie;
       if ($env{'form.btoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
           $balcookie = $info{'balcookie'};
           &Apache::lonnet::tmpdel($env{'form.btoken'});
           delete($env{'form.btoken'});
       }
   
   #
   # If browser sent an old cookie for which the session file had been removed
   # check if configuration for user's domain has a portal URL set.  If so
   # switch user's log-in to the portal.
   #
   
       if (($handle eq '') && ($userdom ne '')) {
           my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom);
           if ($domdefaults{'portal_def'} =~ /^https?\:/) {
               my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                             {'redirect' => [0,$domdefaults{'portal_def'}],});
               my $end_page   = &Apache::loncommon::end_page();
               $r->print($start_page.$end_page);
               return OK;
           }
       }
   
 # -------------------------------- Prevent users from attempting to login twice  # -------------------------------- Prevent users from attempting to login twice
     my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));      if ($handle ne '') {
     my $lonid=$cookies{'lonID'};          &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
     my $cookie;   my $start_page = 
     if ($lonid) {      &Apache::loncommon::start_page('Already logged in');
  my $handle=&LONCAPA::clean_handle($lonid->value);   my $end_page = 
         my $lonidsdir=$r->dir_config('lonIDsDir');      &Apache::loncommon::end_page();
  if (-e "$lonidsdir/$handle.id") {          my $dest = '/adm/roles';
 # Is there an existing token file?          if ($env{'form.firsturl'} ne '') {
     if ($handle=~/^publicuser\_/) {              $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
 # For "public user" - remove it, we apparently really want to login          }
  unlink("$lonidsdir/$handle.id");          if (($env{'form.ltoken'}) || ($env{'form.linkprot'})) {
     } elsif ($handle ne '') {              my $linkprot;
 # Indeed, a valid token is found              if ($env{'form.ltoken'}) {
  my $start_page =                   my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
     &Apache::loncommon::start_page('Already logged in');                  $linkprot = $info{'linkprot'};
  my $end_page =                   my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
     &Apache::loncommon::end_page();              } else {
  $r->print(<<ENDFAILED);                  $linkprot = $env{'form.linkprot'};
 $start_page              }
 <h1>You are already logged in</h1>              if ($linkprot) {
 <p>Please either <a href="/adm/roles">continue the current session</a> or                  my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
 <a href="/adm/logout">logout</a>.</p>                  if ($env{'user.linkprotector'}) {
 <p>                      my @protectors = split(/,/,$env{'user.linkprotector'});
 <a href="/adm/loginproblems.html">Problems?</a></p>                      unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
 $end_page                          push(@protectors,$linkprotector);
 ENDFAILED                          @protectors = sort { $a <=> $b } @protectors;
                 return OK;                          &Apache::lonnet::appenv({'user.linkprotector' => join(',',@protectors)});
      }                        }
  }                  } else {
                       &Apache::lonnet::appenv({'user.linkprotector' => $linkprotector });
                   }
                   if ($env{'user.linkproturi'}) {
                       my @proturis = split(/,/,$env{'user.linkproturi'});
                       unless (grep(/^\Q$deeplink\E$/,@proturis)) {
                           push(@proturis,$deeplink);
                           @proturis = sort @proturis;
                           &Apache::lonnet::appenv({'user.linkproturi' => join(',',@proturis)});
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.linkproturi' => $deeplink});
                   }
               }
           } elsif ($env{'form.linkkey'} ne '') {
               if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
                   my $linkkey = $env{'form.linkkey'};
                   if ($env{'user.deeplinkkey'}) {
                       my @linkkeys = split(/,/,$env{'user.deeplinkkey'});
                       unless (grep(/^\Q$linkkey\E$/,@linkkeys)) {
                           push(@linkkeys,$linkkey);
                           &Apache::lonnet::appenv({'user.deeplinkkey' => join(',',sort(@linkkeys))});
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.deeplinkkey' => $linkkey});
                   }
                   my $deeplink = $env{'form.firsturl'};
                   if ($env{'user.keyedlinkuri'}) {
                       my @keyeduris = split(/,/,$env{'user.keyedlinkuri'});
                       unless (grep(/^\Q$deeplink\E$/,@keyeduris)) {
                           push(@keyeduris,$deeplink);
                           &Apache::lonnet::appenv({'user.keyedlinkuri' => join(',',sort(@keyeduris))});
                       }
                   } else {
                       &Apache::lonnet::appenv({'user.keyedlinkuri' => $deeplink});
                   }
               }
           }
    $r->print(
                 $start_page
                .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
                .'<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>'
                .$end_page
                );
           return OK;
     }      }
   
 # ---------------------------------------------------- No valid token, continue  # ---------------------------------------------------- No valid token, continue
   
  # ---------------------------- Not possible to really login to domain "public"  # ---------------------------- Not possible to really login to domain "public"
     if ($env{'form.domain'} eq 'public') {      if ($env{'form.domain'} eq 'public') {
  $env{'form.domain'}='';   $env{'form.domain'}='';
  $env{'form.username'}='';   $env{'form.username'}='';
     }      }
   
   # ------ Is this page requested because /adm/migrateuser detected an IP change?
       my %sessiondata;
       if ($env{'form.iptoken'}) {
           %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'});
           unless ($sessiondata{'sessionserver'}) {
               my $delete = &Apache::lonnet::tmpdel($env{'form.iptoken'});
               delete($env{'form.iptoken'});
           }
       }
 # ----------------------------------------------------------- Process Interface  # ----------------------------------------------------------- Process Interface
     $env{'form.interface'}=~s/\W//g;      $env{'form.interface'}=~s/\W//g;
   
     my $textbrowsers=$r->dir_config('lonTextBrowsers');      (undef,undef,undef,undef,undef,undef,my $clientmobile) =
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};          &Apache::loncommon::decode_user_agent($r);
       
     foreach (split(/\:/,$textbrowsers)) {      my $iconpath= 
  if ($httpbrowser=~/$_/i) {   &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
     $env{'form.interface'}='textual';  
       my $domain = &Apache::lonnet::default_login_domain();
       my $defdom = $domain;
       if ($lonhost ne '') {
           unless ($sessiondata{'sessionserver'}) {
               my $redirect = &check_loginvia($domain,$lonhost,$lonidsdir,$balcookie);
               if ($redirect) {
                   $r->print($redirect);
                   return OK;
               }
         }          }
     }      }
   
     my $fullgraph=($env{'form.interface'} ne 'textual');      if (($sessiondata{'domain'}) &&
     my $port_to_use=$r->dir_config('lonhttpdPort');          (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
     if (!defined($port_to_use)) {          $domain=$sessiondata{'domain'};
  $port_to_use='8080';      } elsif (($env{'form.domain'}) && 
     }  
     my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':'.$port_to_use.  
                   $r->dir_config('lonIconsURL');  
     my $domain = &Apache::lonnet::default_login_domain();  
     if (($env{'form.domain'}) &&   
  (&Apache::lonnet::domain($env{'form.domain'},'description'))) {   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
  $domain=$env{'form.domain'};   $domain=$env{'form.domain'};
     }      }
   
     my $role    = $r->dir_config('lonRole');      my $role    = $r->dir_config('lonRole');
     my $loadlim = $r->dir_config('lonLoadLim');      my $loadlim = $r->dir_config('lonLoadLim');
       my $uloadlim= $r->dir_config('lonUserLoadLim');
     my $servadm = $r->dir_config('lonAdmEMail');      my $servadm = $r->dir_config('lonAdmEMail');
     my $lonhost = $r->dir_config('lonHostID');  
     my $tabdir  = $r->dir_config('lonTabDir');      my $tabdir  = $r->dir_config('lonTabDir');
     my $include = $r->dir_config('lonIncludes');      my $include = $r->dir_config('lonIncludes');
     my $expire  = $r->dir_config('lonExpire');      my $expire  = $r->dir_config('lonExpire');
Line 142  ENDFAILED Line 371  ENDFAILED
     my $host_name = &Apache::lonnet::hostname($lonhost);      my $host_name = &Apache::lonnet::hostname($lonhost);
   
 # --------------------------------------------- Default values for login fields  # --------------------------------------------- Default values for login fields
       
     my $authusername=($env{'form.username'}?$env{'form.username'}:'');      my ($authusername,$authdomain);
     my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);      if ($sessiondata{'username'}) {
           $authusername=$sessiondata{'username'};
       } else {
           $env{'form.username'} = &Apache::loncommon::cleanup_html($env{'form.username'});
           $authusername=($env{'form.username'}?$env{'form.username'}:'');
       }
       if ($sessiondata{'domain'}) {
           $authdomain=$sessiondata{'domain'};
       } else {
           $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'});
           $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
       }
   
 # ---------------------------------------------------------- Determine own load  # ---------------------------------------------------------- Determine own load
     my $loadavg;      my $loadavg;
Line 153  ENDFAILED Line 393  ENDFAILED
  $loadavg=<$loadfile>;   $loadavg=<$loadfile>;
     }      }
     $loadavg =~ s/\s.*//g;      $loadavg =~ s/\s.*//g;
     my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);  
     my $userloadpercent=&Apache::lonnet::userload();  
   
 # ------------------------------------------------------- Do the load balancing      my ($loadpercent,$userloadpercent);
     my $otherserver= &Apache::lonnet::absolute_url($host_name);      if ($loadlim) {
           $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
       }
       if ($uloadlim) {
           $userloadpercent=&Apache::lonnet::userload();
       }
   
     my $firsturl=      my $firsturl=
     ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});      ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
 # ---------------------------------------- Are we access server and overloaded?  
     if (($role eq 'access') &&  
  (($userloadpercent>100.0)||($loadpercent>100.0))) {  
         my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent);  
  if ($unloaded) { $otherserver=$unloaded; }  
     }  
   
 # ----------------------------------------------------------- Get announcements  # ----------------------------------------------------------- Get announcements
     my $announcements=&Apache::lonnet::getannounce();      my $announcements=&Apache::lonnet::getannounce();
Line 190  ENDFAILED Line 428  ENDFAILED
     if ($uextkey>2147483647) { $uextkey-=4294967296; }      if ($uextkey>2147483647) { $uextkey-=4294967296; }
   
 # -------------------------------------------------------- Store away log token  # -------------------------------------------------------- Store away log token
       my ($tokenextras,$tokentype);
       my @names = ('role','symb','iptoken','ltoken','linkprot','linkkey');
       foreach my $name (@names) {
           if ($env{'form.'.$name} ne '') {
               if ($name eq 'ltoken') {
                   my %info = &Apache::lonnet::tmpget($env{'form.'.$name});
                   if ($info{'linkprot'}) {
                       $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
                       $tokentype = 'link';
                       last;
                   }
               } else {
                   $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
                   if (($name eq 'linkkey') || ($name eq 'linkprot')) {
                       $tokentype = 'link';
                   }
               }
           }
       }
       if ($tokentype) {
           $tokenextras .= ":$tokentype";
       }
     my $logtoken=Apache::lonnet::reply(      my $logtoken=Apache::lonnet::reply(
        'tmpput:'.$ukey.$lkey.'&'.$firsturl,         'tmpput:'.$ukey.$lkey.'&'.&escape($firsturl).$tokenextras,
        $lonhost);         $lonhost);
   
 # ------------------- If we cannot talk to ourselves, we are in serious trouble  # -- If we cannot talk to ourselves, or hostID does not map to a hostname
   #    we are in serious trouble
   
     if ($logtoken eq 'con_lost') {      if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
           if ($logtoken eq 'no_such_host') {
               &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
           }
           if ($env{'form.ltoken'}) {
               &Apache::lonnet::tmpdel($env{'form.ltoken'});
               delete($env{'form.ltoken'});
           }
         my $spares='';          my $spares='';
  my $last;          my (@sparehosts,%spareservers);
         foreach my $hostid (sort          my $sparesref = &Apache::lonnet::this_host_spares($defdom);
     {          if (ref($sparesref) eq 'HASH') {
  &Apache::lonnet::hostname($a) cmp              foreach my $key (keys(%{$sparesref})) {
     &Apache::lonnet::hostname($b);                  if (ref($sparesref->{$key}) eq 'ARRAY') {
     }                      my @sorted = sort { &Apache::lonnet::hostname($a) cmp
     keys(%Apache::lonnet::spareid)) {                                          &Apache::lonnet::hostname($b);
                                         } @{$sparesref->{$key}};
                       if (@sorted) {
                           if ($key eq 'primary') {
                               unshift(@sparehosts,@sorted);
                           } elsif ($key eq 'default') {
                               push(@sparehosts,@sorted);
                           }
                       }
                   }
               }
           }
           foreach my $hostid (@sparehosts) {
             next if ($hostid eq $lonhost);              next if ($hostid eq $lonhost);
     my $hostname = &Apache::lonnet::hostname($hostid);      my $hostname = &Apache::lonnet::hostname($hostid);
     next if ($last eq $hostname);      next if (($hostname eq '') || ($spareservers{$hostname}));
             $spares.='<br /><font size="+1"><a href="http://'.              $spareservers{$hostname} = 1;
               my $protocol = $Apache::lonnet::protocol{$hostid};
               $protocol = 'http' if ($protocol ne 'https');
               $spares.='<br /><span style="font-size: larger;"><a href="'.$protocol.'://'.
                 $hostname.                  $hostname.
                 '/adm/login?domain='.$authdomain.'">'.                  '/adm/login?domain='.$authdomain.'">'.
                 $hostname.'</a>'.                  $hostname.'</a>'.
                 ' (preferred)</font>'.$/;                  ' '.&mt('(preferred)').'</span>'.$/;
     $last=$hostname;  
         }          }
         $spares.= '<br />';          if ($spares) {
  my %all_hostnames = &Apache::lonnet::all_hostnames();              $spares.= '<br />';
           }
           my %all_hostnames = &Apache::lonnet::all_hostnames();
         foreach my $hostid (sort          foreach my $hostid (sort
     {      {
  &Apache::lonnet::hostname($a) cmp   &Apache::lonnet::hostname($a) cmp
     &Apache::lonnet::hostname($b);      &Apache::lonnet::hostname($b);
     }      }
     keys(%all_hostnames)) {      keys(%all_hostnames)) {
             next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});              next if ($hostid eq $lonhost);
     my $hostname = &Apache::lonnet::hostname($hostid);              my $hostname = &Apache::lonnet::hostname($hostid);
             next if ($last eq $hostname);              next if (($hostname eq '') || ($spareservers{$hostname}));
             $spares.='<br /><a href="http://'.              $spareservers{$hostname} = 1;
                 $hostname.              my $protocol = $Apache::lonnet::protocol{$hostid};
                 '/adm/login?domain='.$authdomain.'">'.              $protocol = 'http' if ($protocol ne 'https');
                 $hostname.'</a>';              $spares.='<br /><a href="'.$protocol.'://'.
     $last=$hostname;               $hostname.
                '/adm/login?domain='.$authdomain.'">'.
                $hostname.'</a>';
            }
            $r->print(
      '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">'
     .'<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">'
     .'<head><meta http-equiv="Content-Type" content="text/html; charset=utf-8" /><title>'
     .&mt('The LearningOnline Network with CAPA')
     .'</title></head>'
     .'<body bgcolor="#FFFFFF">'
     .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
     .'<img src="/adm/lonKaputt/lonlogo_broken.gif" alt="broken icon" align="right" />'
     .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
           if ($spares) {
               $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
                        .'</p>'
                        .$spares);
         }          }
  $r->print(<<ENDTROUBLE);          $r->print('</body>'
 <html>                   .'</html>'
 <head><title>The LearningOnline Network with CAPA</title></head>          );
 <body bgcolor="#FFFFFF">  
 <img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />  
 <h3>This LON-CAPA server is temporarily not available for login</h3>  
 <p>Please attempt to login to one of the following servers:</p>$spares  
 </body>  
 </html>  
 ENDTROUBLE  
         return OK;          return OK;
     }      }
   
 # ----------------------------------------------- Apparently we are in business  # ----------------------------------------------- Apparently we are in business
     $servadm=~s/\,/\<br \/\>/g;      $servadm=~s/\,/\<br \/\>/g;
   
 # --------------------------------------------------- Print login screen header  
     $r->print(<<ENDHEADER);  
 <html>  
 <head>  
 <meta HTTP-EQUIV="Refresh" CONTENT="$expire; url=/adm/roles" />  
 <title>The LearningOnline Network with CAPA Login</title>  
 </head>  
 ENDHEADER  
 # ---------------------------------------------------- Serve out DES JavaScript  
     {  
  my $jsh=Apache::File->new($include."/londes.js");  
         $r->print(<$jsh>);  
     }  
   
 # ----------------------------------------------------------- Front page design  # ----------------------------------------------------------- Front page design
     my $pgbg=      my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
       ($fullgraph?&Apache::loncommon::designparm('login.pgbg',$domain):'#FFFFFF');      my $font=&Apache::loncommon::designparm('login.font',$domain);
     my $font=      my $link=&Apache::loncommon::designparm('login.link',$domain);
       ($fullgraph?&Apache::loncommon::designparm('login.font',$domain):'#000000');      my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
     my $link=  
       ($fullgraph?&Apache::loncommon::designparm('login.link',$domain):'#0000FF');  
     my $vlink=  
       ($fullgraph?&Apache::loncommon::designparm('login.vlink',$domain):'#0000FF');  
     my $alink=&Apache::loncommon::designparm('login.alink',$domain);      my $alink=&Apache::loncommon::designparm('login.alink',$domain);
     my $mainbg=      my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
       ($fullgraph?&Apache::loncommon::designparm('login.mainbg',$domain):'#FFFFFF');      my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
     my $sidebg=      my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
       ($fullgraph?&Apache::loncommon::designparm('login.sidebg',$domain):'#FFFFFF');      my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
     my $logo=&Apache::loncommon::designparm('login.logo',$domain);      my $logo=&Apache::loncommon::designparm('login.logo',$domain);
     my $img=&Apache::loncommon::designparm('login.img',$domain);      my $img=&Apache::loncommon::designparm('login.img',$domain);
     my $domainlogo=&Apache::loncommon::domainlogo($domain);      my $domainlogo=&Apache::loncommon::domainlogo($domain);
     my $showadminmail=&Apache::loncommon::designparm('login.adminmail',                                                      $domain);      my $showbanner = 1;
       my $showmainlogo = 1;
       if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
           $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
       }
       if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
           $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
       }
       my $showadminmail;
       my @possdoms = &Apache::lonnet::current_machine_domains();
       if (grep(/^\Q$domain\E$/,@possdoms)) {
           $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
       }
     my $showcoursecat =      my $showcoursecat =
         &Apache::loncommon::designparm('login.coursecatalog',$domain);          &Apache::loncommon::designparm('login.coursecatalog',$domain);
       my $shownewuserlink = 
           &Apache::loncommon::designparm('login.newuser',$domain);
       my $showhelpdesk =
           &Apache::loncommon::designparm('login.helpdesk',$domain);
       my $now=time;
       my $js = (<<ENDSCRIPT);
   
   <script type="text/javascript" language="JavaScript">
   // <![CDATA[
   function send()
   {
   this.document.server.elements.uname.value
   =this.document.client.elements.uname.value;
   
   this.document.server.elements.udom.value
   =this.document.client.elements.udom.value;
   
   uextkey=this.document.client.elements.uextkey.value;
   lextkey=this.document.client.elements.lextkey.value;
   initkeys();
   
 # ----------------------------------------------------------------------- Texts  this.document.server.elements.upass0.value
       =getCrypted(this.document.client.elements.upass$now.value);
   
 my %lt=&Apache::lonlocal::texthash(  this.document.client.elements.uname.value='';
   'un'  => 'Username',  this.document.client.elements.upass$now.value='';
   'pw'  => 'Password',  
   'dom' => 'Domain',  
   'perc' => 'percent',  
   'load' => 'Load',  
                   'userload' => 'User Load',  
                   'about'  => 'About LON-CAPA',  
                   'access' => 'Accessibility Options',  
                   'catalog' => 'Course Catalog',  
   'auth' => 'userauthentication.gif',  
   'log' => 'Log in',  
   'help' => 'Log-in Help',  
   'serv' => 'Server',  
                   'servadm' => 'Server Administration',  
                   'helpdesk' => 'Contact Helpdesk',  
                   'forgotpw' => 'Forgot password?');  
 # -------------------------------------------------- Change password field name  
     my $now=time;  
     my $forgotpw = &forgotpwdisplay(%lt);  
     my $loginhelp = &loginhelpdisplay(%lt);  
 # ---------------------------------------------------------- Serve rest of page  
     $r->print(<<ENDSCRIPT);  
   
 <body bgcolor="$pgbg" text="$font" link="$link" vlink="$vlink" alink="$alink"  this.document.server.submit();
   topmargin=0 leftmargin=0 marginwidth=0 marginheight=0>  return false;
   }
   
  <script language="JavaScript">  function enableInput() {
     function send()      this.document.client.elements.upass$now.removeAttribute("readOnly");
     {      this.document.client.elements.uname.removeAttribute("readOnly");
  this.document.server.elements.uname.value      this.document.client.elements.udom.removeAttribute("readOnly");
        =this.document.client.elements.uname.value;      return;
   }
   
         this.document.server.elements.udom.value  // ]]>
        =this.document.client.elements.udom.value;  </script>
   
         this.document.server.elements.imagesuppress.value  ENDSCRIPT
        =this.document.client.elements.imagesuppress.checked;  
   
         this.document.server.elements.embedsuppress.value      my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
        =this.document.client.elements.embedsuppress.checked;          $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip);
       %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
       @hosts = &Apache::lonnet::current_machine_ids();
       $lonhost_in_use = $lonhost;
       if (@hosts > 1) {
           foreach my $hostid (@hosts) {
               if (&Apache::lonnet::host_domain($hostid) eq $defdom) {
                   $lonhost_in_use = $hostid;
                   last;
               }
           }
       }
       $saml_prefix = $defdom.'.login.saml_';
       if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) {
           $saml_landing = 1;
           $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use};
           $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use};
           $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use};
           $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use};
           $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use};
           $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use};
       }
       if ($saml_landing) {
          if ($samlssotext eq '') {
              $samlssotext = 'SSO Login';
          }
          if ($samlnonsso eq '') {
              $samlnonsso = 'Non-SSO Login';
          }
          $js .= <<"ENDSAMLJS";
   
         this.document.server.elements.appletsuppress.value  <script type="text/javascript">
        =this.document.client.elements.appletsuppress.checked;  // <![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;
   }
   
         this.document.server.elements.fontenhance.value  // ]]>
        =this.document.client.elements.fontenhance.checked;  </script>
   
         this.document.server.elements.blackwhite.value  ENDSAMLJS
        =this.document.client.elements.blackwhite.checked;      }
   
         this.document.server.elements.remember.value  # --------------------------------------------------- Print login screen header
        =this.document.client.elements.remember.checked;  
   
         uextkey=this.document.client.elements.uextkey.value;      my %add_entries = (
         lextkey=this.document.client.elements.lextkey.value;         bgcolor      => "$mainbg",
         initkeys();         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";
                   }
               }
           }
       }
   
         this.document.server.elements.upass0.value      $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
     =crypted(this.document.client.elements.upass$now.value.substr(0,15));         { 'redirect'       => [$expire,'/adm/roles'], 
  this.document.server.elements.upass1.value   'add_entries' => \%add_entries,
     =crypted(this.document.client.elements.upass$now.value.substr(15,15));   'only_body'   => 1,}));
  this.document.server.elements.upass2.value  
     =crypted(this.document.client.elements.upass$now.value.substr(30,15));  
   
         this.document.client.elements.uname.value='';  # ----------------------------------------------------------------------- Texts
         this.document.client.elements.upass$now.value='';  
       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
   
         this.document.server.submit();      my $forgotpw = &forgotpwdisplay(%lt);
  return false;      $forgotpw .= '<br />' if $forgotpw;
       my $loginhelp = &Apache::lonauth::loginhelpdisplay($authdomain);
       if ($loginhelp) {
           $loginhelp = '<a href="'.$loginhelp.'">'.$lt{'help'}.'</a><br />';
     }      }
  </script>  
 ENDSCRIPT  
   
     if ($fullgraph) {  # ---------------------------------------------------- Serve out DES JavaScript
  $r->print(      {
   '<table width="100%" cellpadding=0 cellspacing=0 border=0>');      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);      $r->print(<<ENDSERVERFORM);
   <form name="server" action="$otherserver/adm/authenticate" method="post" target="_top">  <form name="server" action="/adm/authenticate" method="post" target="_top">
    <input type="hidden" name="logtoken" value="$logtoken" />     <input type="hidden" name="logtoken" value="$logtoken" />
    <input type="hidden" name="serverid" value="$lonhost" />     <input type="hidden" name="serverid" value="$lonhost" />
    <input type="hidden" name="interface" value="$env{'form.interface'}" />  
    <input type="hidden" name="uname" value="" />     <input type="hidden" name="uname" value="" />
    <input type="hidden" name="upass0" value="" />     <input type="hidden" name="upass0" value="" />
    <input type="hidden" name="upass1" value="" />  
    <input type="hidden" name="upass2" value="" />  
    <input type="hidden" name="udom" value="" />     <input type="hidden" name="udom" value="" />
    <input type="hidden" name="imagesuppress"  value="" />  
    <input type="hidden" name="appletsuppress"  value="" />  
    <input type="hidden" name="embedsuppress"  value="" />  
    <input type="hidden" name="fontenhance"  value="" />  
    <input type="hidden" name="blackwhite"  value="" />  
    <input type="hidden" name="remember"  value="" />  
    <input type="hidden" name="localpath" value="$env{'form.localpath'}" />     <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
    <input type="hidden" name="localres" value="$env{'form.localres'}" />     <input type="hidden" name="localres" value="$env{'form.localres'}" />
   </form>    </form>
 ENDSERVERFORM  ENDSERVERFORM
     my $coursecatalog;      my $coursecatalog;
     if (($showcoursecat eq '') || ($showcoursecat)) {      if (($showcoursecat eq '') || ($showcoursecat)) {
         $coursecatalog = &coursecatalog_link($lt{'catalog'});          $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
     }      }
     if ($fullgraph) { $r->print(<<ENDTOP);      my $newuserlink;
   <!-- The LON-CAPA Header -->      if ($shownewuserlink) {
   <tr>          $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
       }
    <!-- Row 1 Columns 2-4 -->      my $logintitle =
    <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>          '<h2 class="LC_hcell"'
   </tr>         .' style="background:'.$loginbox_header_bgcol.';'
          .' color:'.$loginbox_header_textcol.'">'
   <!-- The gray bar that starts the two table frames -->         .$lt{'log'}
   <tr>         .'</h2>';
   
    <!-- Row 2 Column 1 -->      my $noscript_warning='<noscript><span class="LC_warning"><b>'
    <td width=182 height=27 bgcolor="$sidebg">&nbsp;</td>                          .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
                           .'</b></span></noscript>';
    <!-- Row 2 Column 2 -->      my $helpdeskscript;
    <td width=27 height=27 align="left" background="$iconpath/filltop.gif"><img src="$iconpath/upperleft.gif" border=0 alt="" /></td>      my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
                                          $authdomain,\$helpdeskscript,
    <!-- Row 2 Column 3 -->                                         $showhelpdesk,\@possdoms);
    <td height=27 background="$iconpath/filltop.gif"><img src="$iconpath/filltop.gif" alt="" /></td>  
       my $mobileargs;
    <!-- Row 2 Column 4 -->      if ($clientmobile) {
    <td width=27 height=27 align="right" background="$iconpath/filltop.gif"><img src="$iconpath/upperright.gif" border=0 alt="" /></td>          $mobileargs = 'autocapitalize="off" autocorrect="off"'; 
   </tr>      }
   <tr>      my $loginform=(<<LFORM);
      <form name="client" action="" onsubmit="return(send())" id="lclogin">
    <!-- A cell that will hold the 'access', 'about', and 'catalog' links -->    <input type="hidden" name="lextkey" value="$lextkey" />
    <!-- Row 3 Column 1 -->    <input type="hidden" name="uextkey" value="$uextkey" />
    <td valign="top" height="60" align="left" bgcolor="$sidebg">    <b><label for="uname">$lt{'un'}</label>:</b><br />
     <table cellpadding="0" cellspacing="2" border="0">    <input type="text" name="uname" id="uname" size="15" value="$authusername" readonly="readonly" $mobileargs /><br />
      <tr>    <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
       <td>&nbsp;</td>    <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />
       <td><a href="/adm/login?interface=textual"><b>$lt{'access'}</b></a></td>    <b><label for="udom">$lt{'dom'}</label>:</b><br />
      </tr>    <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" $mobileargs /><br />
      <tr>    <input type="submit" value="$lt{'log'}" />
       <td>&nbsp;</td>  </form>
       <td><a href="/adm/about.html"><b>$lt{'about'}</b></a></td>  LFORM
      </tr>$coursecatalog  
      <tr>      if ($showbanner) {
       <td colspan="2">&nbsp;</td>          my $alttext = &Apache::loncommon::designparm('login.alttext_img',$domain);
      </tr>          if ($alttext eq '') {
     </table>              $alttext = 'The Learning Online Network with CAPA';
    </td>          }
    <!-- The shaded space between the two main columns -->          $r->print(<<HEADER);
    <!-- Row 3 Column 2 -->  <!-- The LON-CAPA Header -->
    <td width=27 height=60 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>  <div style="background:$pgbg;margin:0;width:100%;">
     <img src="$img" border="0" alt="$alttext" class="LC_maxwidth" id="lcloginbanner" />
    <!-- The right main column holding the large LON-CAPA logo-->  </div>
    <!-- Rows 3-4 Column 3 -->  HEADER
    <td align="center" valign="top" width="100%" height="100%" bgcolor="$mainbg">      }
     <center>  
      <img src="$logo" alt="" />      my $stdauthformstyle = 'inline-block';
     </center>      my $ssoauthstyle = 'none';
    </td>      my $logintype;
       $r->print('<div style="float:left;margin-top:0;">');
    <!-- Row 3 Column 4 -->      if ($saml_landing) {
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>          $ssoauthstyle = 'inline-block';
   </tr>          $stdauthformstyle = 'none';
   <tr>          $logintype = $samlssotext;
           my $ssologin = '/adm/sso';
    <!-- The entry form -->          if ($samlssourl  ne '') {
    <!-- Row 4 Column 1 -->              $ssologin = $samlssourl;
    <td align="center" valign="middle" bgcolor="$sidebg">          }
 ENDTOP          if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
 } else {              my $querystring;
     $r->print('<h1>The Learning<i>Online</i> Network with CAPA</h1><h2>Text-based Interface Login</h2>'.$announcements);              if ($env{'form.firsturl'} ne '') {
 }                  $querystring = 'origurl=';
     $r->print('<form name="client" onsubmit="return(send())">');                  if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
     unless ($fullgraph) {                      $querystring .= &uri_escape_utf8($env{'form.firsturl'});
         $r->print(<<ENDACCESSOPTIONS);                  } else {
 <h3>Select Accessibility Options</h3>                      $querystring .= &uri_escape($env{'form.firsturl'});
 <label><input type="checkbox" name="imagesuppress" /> Suppress rendering of images</label><br />                  }
 <label><input type="checkbox" name="appletsuppress" /> Suppress Java applets</label><br />                  $querystring = &HTML::Entities::encode($querystring,"'");
 <label><input type="checkbox" name="embedsuppress" /> Suppress rendering of embedded multimedia</label><br />              }
 <label><input type="checkbox" name="fontenhance" /> Increase font size</label><br />              if ($env{'form.ltoken'} ne '') {
 <label><input type="checkbox" name="blackwhite" /> Switch to black and white mode</label><br />                  $querystring .= (($querystring eq '')?'':'&amp;') . 'ltoken='.
 <input type="checkbox" name="remember" /> Remember these settings for next login<hr />                                    &HTML::Entities::encode(&uri_escape($env{'form.ltoken'}));
 ENDACCESSOPTIONS              } elsif ($env{'form.linkkey'}) {
 } else {                  $querystring .= (($querystring eq '')?'':'&amp;') . 'linkkey='.
     $r->print(<<ENDNOOPT);                                    &HTML::Entities::encode(&uri_escape($env{'form.linkkey'}));
 <input type="hidden" name="imagesuppress"  value="" />              }
 <input type="hidden" name="embedsuppress"  value="" />              if ($querystring ne '') {
 <input type="hidden" name="appletsuppress"  value="" />                  $ssologin .= (($ssologin=~/\?/)?'&amp;':'?') . $querystring;
 <input type="hidden" name="fontenhance"  value="" />              }
 <input type="hidden" name="blackwhite"  value="" />          } elsif ($logtoken ne '') {
 <input type="hidden" name="remember"  value="" />              $ssologin .= (($ssologin=~/\?/)?'&amp;':'?') . 'logtoken='.$logtoken;
 ENDNOOPT          }
 }          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'});
           }
       }
   
     $r->print(<<ENDLOGIN);      $r->print(<<ENDLOGIN);
      <input type="hidden" name="lextkey" value="$lextkey">  <div style="display:$stdauthformstyle;" id="LC_standard_login">
      <input type="hidden" name="uextkey" value="$uextkey">  <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>
   
      <!-- Start the sub-table for text and input alignment -->  
      <table border=0 cellspacing=0 cellpadding=0>  
       <tr><td bgcolor="$sidebg" colspan=2><img src="$iconpath/$lt{'auth'}" alt="User Authentication" /></td></tr>  
       <tr>  
        <td bgcolor="$mainbg"><br /><font size=-1><b>&nbsp;&nbsp;&nbsp;$lt{'un'}:</b></font></td>  
        <td bgcolor="$mainbg"><br /><input type="text" name="uname" size="10" value="$authusername" /></td>  
       </tr>  
       <tr>  
        <td bgcolor="$mainbg"><font size=-1><b>&nbsp;&nbsp;&nbsp;$lt{'pw'}:</b></font></td>  
        <td bgcolor="$mainbg"><input type="password" name="upass$now" size="10" /></td>  
       </tr>  
       <tr>  
        <td bgcolor="$mainbg"><font size=-1><b>&nbsp;&nbsp;&nbsp;$lt{'dom'}:</b></font></td>  
        <td bgcolor="$mainbg"><input type="text" name="udom" size="10" value="$authdomain" /></td>  
       </tr>  
       <tr>  
        <td bgcolor="$mainbg">&nbsp;</td>  
        <td bgcolor="$mainbg" valign="bottom" align="center">  
         <br />  
         <input type="submit" value="$lt{'log'}" />  
        </td>  
       </tr>  
       <tr>  
        <td bgcolor="$mainbg" valign="bottom" align="left" colspan="2">  
         $loginhelp  
         $forgotpw  
        </td>  
       </tr>  
      </table>  
      <!-- End sub-table -->  
     </form>  
 ENDLOGIN  ENDLOGIN
     if ($fullgraph) {      $r->print('</div><div>'."\n");
         my $helpdeskscript;      if ($showmainlogo) {
         my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,          my $alttext = &Apache::loncommon::designparm('login.alttext_logo',$domain);
                                   $version,$authdomain,\$helpdeskscript);          $r->print(' <img src="'.$logo.'" alt="'.$alttext.'" class="LC_maxwidth" id="lcloginmainlogo" />'."\n");
  $r->print(<<ENDDOCUMENT);      }
    </td>  $r->print(<<ENDTOP);
   $announcements
    <!-- Row 4 Column 2 -->  </div>
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>  <hr style="clear:both;" />
   ENDTOP
    <!-- Row 4 Column 3 -->      my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
 <td bgcolor="$mainbg">$announcements</td>      $domainrow = <<"END";
   
    <!-- Row 4 Column 4 -->  
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>  
   </tr>  
   <tr>  
   
    <!-- Row 5 Column 1 -->  
    <td bgcolor="$sidebg" valign="middle" align="left">  
      <br />  
      <table border=0 cellspacing=0 cellpadding=0>  
       <tr>        <tr>
        <td bgcolor="$sidebg" align="left" valign="top">         <td  align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'dom'}:&nbsp;</b></small>          <small><b>$lt{'dom'}:&nbsp;</b></small>
        </td>         </td>
        <td bgcolor="$sidebg" align="left" valign="top">         <td  align="left" valign="top">
         <small><tt>&nbsp;$domain</tt></small>          <small><tt>&nbsp;$domain</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       $serverrow = <<"END";
       <tr>        <tr>
        <td bgcolor="$sidebg" align="left" valign="top">         <td  align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'serv'}:&nbsp;</b></small>          <small><b>$lt{'serv'}:&nbsp;</b></small>
        </td>         </td>
        <td bgcolor="$sidebg" align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$lonhost ($role)</tt></small>          <small><tt>&nbsp;$lonhost ($role)</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       if ($loadlim) {
           $loadrow = <<"END";
       <tr>        <tr>
        <td bgcolor="$sidebg" align="left" valign="top">         <td align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'load'}:&nbsp;</b></small>          <small><b>$lt{'load'}:&nbsp;</b></small>
        </td>         </td>
        <td bgcolor="$sidebg" align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>          <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       }
       if ($uloadlim) {
           $userloadrow = <<"END";
       <tr>        <tr>
        <td bgcolor="$sidebg" align="left" valign="top">         <td align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;$lt{'userload'}:&nbsp;</b></small>          <small><b>$lt{'userload'}:&nbsp;</b></small>
        </td>         </td>
        <td bgcolor="$sidebg" align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>          <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>
        </td>         </td>
       </tr>        </tr>
   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>       </table>
      <br />      </div>
     $contactblock      <div style="float: right;">
    </td>      $domainlogo
       </div>
    <!-- Row 5 Column 2 -->      <br style="clear:both;" />
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>   </div>
   
    <!-- Row 5 Column 3 -->  
    <td width="100%" valign="bottom" bgcolor="$mainbg">  
 $domainlogo  
 </td>  
   
    <!-- Row 5 Column 4 -->  
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>  
   </tr>  
   <tr>  
   
    <!-- Row 6 Column 1 -->  
    <td bgcolor="$sidebg">&nbsp;</td>  
   
    <!-- Row 6 Column 2 -->  
    <td align="left" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerleft.gif" alt="" /></td>  
   
    <!-- Row 6 Column 3 -->  
    <td background="$iconpath/fillbottom.gif"><img src="$iconpath/fillbottom.gif" alt="" /></td>  
   
    <!-- Row 6 Column 4 -->  
    <td align="right" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerright.gif" alt="" /></td>  
   </tr>  
  </table>  
   
 <script type="text/javascript">  <script type="text/javascript">
   // <![CDATA[
 // the if prevents the script error if the browser can not handle this  // the if prevents the script error if the browser can not handle this
 if ( document.client.uname ) { document.client.uname.focus(); }  if ( document.client.uname ) { document.client.uname.focus(); }
   // ]]>
 </script>  </script>
 $helpdeskscript  $helpdeskscript
   
 ENDDOCUMENT  ENDDOCUMENT
 }      my %endargs = ( 'noredirectlink' => 1, );
     $r->print('</body></html>');      $r->print(&Apache::loncommon::end_page(\%endargs));
     return OK;      return OK;
 }  }
   
   sub check_loginvia {
       my ($domain,$lonhost,$lonidsdir,$balcookie) = @_;
       if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') {
           return;
       }
       my %domconfhash = &Apache::loncommon::get_domainconf($domain);
       my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
       my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
       my $output;
       if ($loginvia ne '') {
           my $noredirect;
           my $ip = &Apache::lonnet::get_requestor_ip();
           if ($ip eq '127.0.0.1') {
               $noredirect = 1;
           } else {
               if ($loginvia_exempt ne '') {
                   my @exempt = split(',',$loginvia_exempt);
                   if (grep(/^\Q$ip\E$/,@exempt)) {
                       $noredirect = 1;
                   }
               }
           }
           unless ($noredirect) {
               my ($newhost,$path);
               if ($loginvia =~ /:/) {
                   ($newhost,$path) = split(':',$loginvia);
               } else {
                   $newhost = $loginvia;
               }
               if ($newhost ne $lonhost) {
                   if (&Apache::lonnet::hostname($newhost) ne '') {
                       if ($balcookie) {
                           my ($balancer,$cookie) = split(/:/,$balcookie);
                           if ($cookie =~ /^($match_domain)_($match_username)_([a-f0-9]+)$/) {
                               my ($udom,$uname,$cookieid) = ($1,$2,$3);
                               unless (&Apache::lonnet::delbalcookie($cookie,$balancer) eq 'ok') {
                                   if ((-d $lonidsdir) && (opendir(my $dh,$lonidsdir))) {
                                       while (my $filename=readdir($dh)) {
                                           if ($filename=~/^(\Q$uname\E_\d+_\Q$udom\E_$match_lonid)\.id$/) {
                                               my $handle = $1;
                                               my %hash =
                                                   &Apache::lonnet::get_sessionfile_vars($handle,$lonidsdir,
                                                                                        ['request.balancercookie',
                                                                                         'user.linkedenv']);
                                               if ($hash{'request.balancercookie'} eq "$balancer:$cookieid") {
                                                   if (unlink("$lonidsdir/$filename")) {
                                                       if (($hash{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
                                                           (-l "$lonidsdir/$hash{'user.linkedenv'}.id") &&
                                                           (readlink("$lonidsdir/$hash{'user.linkedenv'}.id") eq "$lonidsdir/$filename")) {
                                                           unlink("$lonidsdir/$hash{'user.linkedenv'}.id");
                                                       }
                                                   }
                                               }
                                               last;
                                           }
                                       }
                                       closedir($dh);
                                   }
                               }
                           }
                       }
                       $output = &redirect_page($newhost,$path);
                   }
               }
           }
       }
       return $output;
   }
   
   sub redirect_page {
       my ($desthost,$path) = @_;
       my $hostname = &Apache::lonnet::hostname($desthost);
       my $protocol = $Apache::lonnet::protocol{$desthost};
       $protocol = 'http' if ($protocol ne 'https');
       unless ($path =~ m{^/}) {
           $path = '/'.$path;
       }
       my $url = $protocol.'://'.$hostname.$path;
       if ($env{'form.firsturl'} ne '') {
           my $querystring;
           if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
               $querystring = &uri_escape_utf8($env{'form.firsturl'});
           } else {
               $querystring = &uri_escape($env{'form.firsturl'});
           }
           $querystring = &HTML::Entities::encode($querystring,"'");
           $url .='?firsturl='.$querystring;
       }
       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 {  sub contactdisplay {
     my ($lt,$servadm,$showadminmail,$version,$authdomain,$helpdeskscript) = @_;      my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk,
           $possdoms) = @_;
     my $contactblock;      my $contactblock;
     my $showhelpdesk = 0;      my $origmail;
     my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};      if (ref($possdoms) eq 'ARRAY') {
     if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {          if (grep(/^\Q$authdomain\E$/,@{$possdoms})) { 
         $showhelpdesk = 1;              $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
           }
       }
       my $requestmail = 
           &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
                                                    $authdomain,$origmail);
       unless ($showhelpdesk eq '0') {
           if ($requestmail =~ m/[^\@]+\@[^\@]+/) {
               $showhelpdesk = 1;
           } else {
               $showhelpdesk = 0;
           }
     }      }
     if ($servadm && $showadminmail) {      if ($servadm && $showadminmail) {
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;'.$$lt{'servadm'}.':</b><br />'.          $contactblock .= $$lt{'servadm'}.':<br />'.
                          '<tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.$servadm.'</tt><br />&nbsp;<br />';                           '<tt>'.$servadm.'</tt><br />';
     }      }
     if ($showhelpdesk) {      if ($showhelpdesk) {
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;<a href="javascript:helpdesk()"><font size="+1">'.$lt->{'helpdesk'}.'</font></a></b><br />';          $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
         my $thisurl = &escape('/adm/login');          my $thisurl = &escape('/adm/login');
         $$helpdeskscript = <<"ENDSCRIPT";          $$helpdeskscript = <<"ENDSCRIPT";
 <script type="text/javascript">  <script type="text/javascript">
   // <![CDATA[
 function helpdesk() {  function helpdesk() {
     var codedom = document.client.udom.value;      var possdom = document.client.udom.value;
       var codedom = possdom.replace( new RegExp("[^A-Za-z0-9.\\-]","g"),'');
     if (codedom == '') {      if (codedom == '') {
         codedom = "$authdomain";          codedom = "$authdomain";
     }      }
Line 636  function helpdesk() { Line 1154  function helpdesk() {
     document.location.href = "/adm/helpdesk?"+querystr;      document.location.href = "/adm/helpdesk?"+querystr;
     return;      return;
 }  }
   // ]]>
 </script>  </script>
 ENDSCRIPT  ENDSCRIPT
     }      }
     $contactblock .= <<"ENDBLOCK";  
      &nbsp;&nbsp;&nbsp;$version  
 ENDBLOCK  
     return $contactblock;      return $contactblock;
 }  }
   
Line 649  sub forgotpwdisplay { Line 1165  sub forgotpwdisplay {
     my (%lt) = @_;      my (%lt) = @_;
     my $prompt_for_resetpw = 1;       my $prompt_for_resetpw = 1; 
     if ($prompt_for_resetpw) {      if ($prompt_for_resetpw) {
         return '<br />&nbsp;&nbsp;&nbsp;<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a></b><br /><br />';          return '<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a>';
     }  
     return;  
 }  
   
 sub loginhelpdisplay {  
     my (%lt) = @_;  
     my $login_help = 1;  
     if ($login_help) {  
         return '&nbsp;&nbsp;&nbsp;<a href="/adm/loginproblems.html">'.$lt{'help'}.'</a></b>';  
     }      }
     return;      return;
 }  }
Line 666  sub loginhelpdisplay { Line 1173  sub loginhelpdisplay {
 sub coursecatalog_link {  sub coursecatalog_link {
     my ($linkname) = @_;      my ($linkname) = @_;
     return <<"END";      return <<"END";
      <tr>        <a href="/adm/coursecatalog">$linkname</a>
       <td>&nbsp;</td>  
       <td><a href="/adm/coursecatalog"><b>$linkname</b></a></td>  
      </tr>  
 END  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;  1;
 __END__  __END__
Removed from v.1.92  
changed lines
  Added in v.1.158.2.13.2.3

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.