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

Diff for /loncom/auth/lonlogin.pm between versions 1.71 and 1.158.2.13.2.6

version 1.71, 2005/12/28 16:46:47 version 1.158.2.13.2.6, 2022/07/08 15:43:51
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();
 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 LONCAPA qw(:DEFAULT :match);
   use URI::Escape;
   use HTML::Entities();
   use CGI::Cookie();
    
 sub handler {  sub handler {
     my $r = shift;      my $r = shift;
   
     &Apache::loncommon::get_unprocessed_cgi      &Apache::loncommon::get_unprocessed_cgi
  ($ENV{'QUERY_STRING'}.'&'.$env{'request.querystring'},   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
         $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'};
               foreach my $item ('linkprotuser','linkprotexit') {
                   if ($info{$item} ne '') {
                       $env{'form.'.$item} = $info{$item};
                   }
               }
           } 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'};
                       foreach my $item ('linkprotuser','linkprotexit') {
                           if ($env{'form.'.$item} ne '') {
                               $link_info{$item} = $env{'form.'.$item};
                           }
                       }
                   } 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=$lonid->value;   my $end_page = 
         $handle=~s/\W//g;      &Apache::loncommon::end_page();
         my $lonidsdir=$r->dir_config('lonIDsDir');          my $dest = '/adm/roles';
  if (-e "$lonidsdir/$handle.id") {          if ($env{'form.firsturl'} ne '') {
 # Is there an existing token file?              $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
     if ($handle=~/^publicuser\_/) {          }
 # For "public user" - remove it, we apparently really want to login          if (($env{'form.ltoken'}) || ($env{'form.linkprot'})) {
  unlink("$lonidsdir/$handle.id");              my ($linkprot,$linkprotuser,$linkprotexit);
     } elsif ($handle ne '') {              if ($env{'form.ltoken'}) {
 # Indeed, a valid token is found                  my %info = &Apache::lonnet::tmpget($env{'form.ltoken'});
  my $bodytag=&Apache::loncommon::bodytag('Already logged in');                  $linkprot = $info{'linkprot'};
  $r->print(<<ENDFAILED);                  if ($info{'linkprotuser'} ne '') {
 <html>                      $linkprotuser = $info{'linkprotuser'};
 <head>                  }
 <title>Already logged in</title>                  if ($info{'linkprotexit'} ne '') {
 </head>                      $linkprotexit = $info{'linkprotexit'};
 $bodytag                  }
 <h1>You are already logged in</h1>              } else {
 <p>Please either <a href="/adm/roles">continue the current session</a> or                  $linkprot = $env{'form.linkprot'};
 <a href="/adm/logout">logout</a>.</p>                  $linkprotuser = $env{'form.linkprotuser'};
 <p>                  $linkprotexit = $env{'form.linkprotexit'};
 <a href="/adm/loginproblems.html">Problems?</a></p>              }
 </body>              if ($linkprot) {
 </html>                  my ($linkprotector,$deeplink) = split(/:/,$linkprot,2);
 ENDFAILED                  if (($deeplink =~ m{^/tiny/$match_domain/\w+$}) &&
                 return OK;                      ($linkprotuser ne '') && ($linkprotuser ne $env{'user.name'}.':'.$env{'user.domain'})) {
      }                        my $ip = &Apache::lonnet::get_requestor_ip();
  }                      my %linkprotinfo = (
                                             origurl => $deeplink,
                                             linkprot => $linkprot,
                                             linkprotuser => $linkprotuser,
                                             linkprotexit => $linkprotexit,
                                          );
                       if ($env{'form.ltoken'}) {
                           my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
                       }
                       &Apache::migrateuser::logout($r,$ip,$handle,undef,undef,\%linkprotinfo);
                       return OK;
                   }
                   if ($env{'user.linkprotector'}) {
                       my @protectors = split(/,/,$env{'user.linkprotector'});
                       unless (grep(/^\Q$linkprotector\E$/,@protectors)) {
                           push(@protectors,$linkprotector);
                           @protectors = sort { $a <=> $b } @protectors;
                           &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});
                   }
               }
           }
           if ($env{'form.ltoken'}) {
               my $delete = &Apache::lonnet::tmpdel($env{'form.ltoken'});
           }
    $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'}) && 
     }   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
     my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':'.$port_to_use.  
                   $r->dir_config('lonIconsURL');  
     my $domain  = $r->dir_config('lonDefDomain');  
     my $testdomain=(split(/\./,$ENV{'HTTP_HOST'}))[0];  
     foreach my $posdom (&Apache::lonnet::current_machine_domains()) {  
  if ($posdom eq $testdomain) { $domain=$testdomain; }  
     }  
     if (($env{'form.domain'}) &&   
  ($Apache::lonnet::domaindescription{$env{'form.domain'}})) {  
  $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 $sysadm  = $r->dir_config('lonSysEMail');  
     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');
     my $version = $r->dir_config('lonVersion');      my $version = $r->dir_config('lonVersion');
       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 157  ENDFAILED Line 428  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='http://'.$ENV{'SERVER_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 194  ENDFAILED Line 463  ENDFAILED
     if ($uextkey>2147483647) { $uextkey-=4294967296; }      if ($uextkey>2147483647) { $uextkey-=4294967296; }
   
 # -------------------------------------------------------- Store away log token  # -------------------------------------------------------- Store away log token
       my ($tokenextras,$tokentype,$linkprot_for_login);
       my @names = ('role','symb','iptoken','ltoken','linkprotuser','linkprotexit','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'}) {
                       $linkprot_for_login = $info{'linkprot'};
                       $tokenextras .= '&linkprot='.&escape($info{'linkprot'});
                       foreach my $item ('linkprotuser','linkprotexit') {
                           if ($info{$item}) {
                               $tokenextras .= '&'.$item.'='.&escape($info{$item});
                           }
                       }
                       $tokentype = 'link';
                       last;
                   }
               } else {
                   $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
                   if (($name eq 'linkkey') || ($name eq 'linkprot')) {
                       if ((($env{'form.retry'}) || ($env{'form.sso'})) &&
                           (!$env{'form.ltoken'}) && ($name eq 'linkprot')) {
                           $linkprot_for_login = $env{'form.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);
             next if ($last eq $Apache::lonnet::hostname{$hostid});      my $hostname = &Apache::lonnet::hostname($hostid);
             $spares.='<br /><font size="+1"><a href="http://'.      next if (($hostname eq '') || ($spareservers{$hostname}));
                 $Apache::lonnet::hostname{$hostid}.              $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.
                 '/adm/login?domain='.$authdomain.'">'.                  '/adm/login?domain='.$authdomain.'">'.
                 $Apache::lonnet::hostname{$hostid}.'</a>'.                  $hostname.'</a>'.
                 ' (preferred)</font>'.$/;                  ' '.&mt('(preferred)').'</span>'.$/;
     $last=$Apache::lonnet::hostname{$hostid};  
         }          }
         $spares.= '<br />';          if ($spares) {
               $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(%Apache::lonnet::hostname)) {      keys(%all_hostnames)) {
             next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});              next if ($hostid eq $lonhost);
             next if ($last eq $Apache::lonnet::hostname{$hostid});              my $hostname = &Apache::lonnet::hostname($hostid);
             $spares.='<br /><a href="http://'.              next if (($hostname eq '') || ($spareservers{$hostname}));
                 $Apache::lonnet::hostname{$hostid}.              $spareservers{$hostname} = 1;
                 '/adm/login?domain='.$authdomain.'">'.              my $protocol = $Apache::lonnet::protocol{$hostid};
                 $Apache::lonnet::hostname{$hostid}.'</a>';              $protocol = 'http' if ($protocol ne 'https');
     $last=$Apache::lonnet::hostname{$hostid};              $spares.='<br /><a href="'.$protocol.'://'.
                $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  
 <p>If the problem persists, please contact <tt>$servadm</tt>.</p>  
 </body>  
 </html>  
 ENDTROUBLE  
         return OK;          return OK;
     }      }
   
 # ----------------------------------------------- Apparently we are in business  # ----------------------------------------------- Apparently we are in business
   
     my $domainlogo=&Apache::loncommon::domainlogo($domain);  
     $servadm=~s/\,/\<br \/\>/g;      $servadm=~s/\,/\<br \/\>/g;
     $sysadm=~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 $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 =
           &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);
   
 # ----------------------------------------------------------------------- Texts  <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();
   
 my %lt=&Apache::lonlocal::texthash(  this.document.server.elements.upass0.value
   'un'  => 'Username',      =getCrypted(this.document.client.elements.upass$now.value);
   'pw'  => 'Password',  
   'dom' => 'Domain',  
   'perc' => 'percent',  
   'load' => 'Load',  
                   'userload' => 'User Load',  
                   'about'  => 'aboutlon.gif',  
                   'access' => 'accessbutton.gif',  
   'auth' => 'userauthentication.gif',  
   'log' => 'Log in',  
   'help' => 'Help',  
   'serv' => 'Server',  
                   'servadm' => 'Server Administration',  
                   'sysadm' => 'System Administration',  
                   'helpdesk' => 'Contact Helpdesk');  
 # -------------------------------------------------- Change password field name  
     my $now=time;  
 # ---------------------------------------------------------- Serve rest of page  
     $r->print(<<ENDSCRIPT);  
   
 <body bgcolor="$pgbg" text="$font" link="$link" vlink="$vlink" alink="$alink"  this.document.client.elements.uname.value='';
   topmargin=0 leftmargin=0 marginwidth=0 marginheight=0>  this.document.client.elements.upass$now.value='';
   
  <script language="JavaScript">  this.document.server.submit();
     function send()  return false;
     {  }
  this.document.server.elements.uname.value  
        =this.document.client.elements.uname.value;  
   
         this.document.server.elements.udom.value  function enableInput() {
        =this.document.client.elements.udom.value;      this.document.client.elements.upass$now.removeAttribute("readOnly");
       this.document.client.elements.uname.removeAttribute("readOnly");
       this.document.client.elements.udom.removeAttribute("readOnly");
       return;
   }
   
         this.document.server.elements.imagesuppress.value  // ]]>
        =this.document.client.elements.imagesuppress.checked;  </script>
   
         this.document.server.elements.embedsuppress.value  ENDSCRIPT
        =this.document.client.elements.embedsuppress.checked;  
   
         this.document.server.elements.appletsuppress.value      my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
        =this.document.client.elements.appletsuppress.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.fontenhance.value  <script type="text/javascript">
        =this.document.client.elements.fontenhance.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.blackwhite.value  // ]]>
        =this.document.client.elements.blackwhite.checked;  </script>
   
         this.document.server.elements.remember.value  ENDSAMLJS
        =this.document.client.elements.remember.checked;      }
   
         uextkey=this.document.client.elements.uextkey.value;  # --------------------------------------------------- Print login screen header
         lextkey=this.document.client.elements.lextkey.value;  
         initkeys();  
   
         this.document.server.elements.upass0.value      my %add_entries = (
     =crypted(this.document.client.elements.upass$now.value.substr(0,15));         bgcolor      => "$mainbg",
  this.document.server.elements.upass1.value         text         => "$font",
     =crypted(this.document.client.elements.upass$now.value.substr(15,15));         link         => "$link",
  this.document.server.elements.upass2.value         vlink        => "$vlink",
     =crypted(this.document.client.elements.upass$now.value.substr(30,15));         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.client.elements.uname.value='';      $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
         this.document.client.elements.upass$now.value='';         { 'redirect'       => [$expire,'/adm/roles'], 
    'add_entries' => \%add_entries,
    'only_body'   => 1,}));
   
         this.document.server.submit();  # ----------------------------------------------------------------------- Texts
  return false;  
       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 />';
     }      }
  </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
     if ($fullgraph) { $r->print(<<ENDTOP);      my $coursecatalog;
   <!-- The LON-CAPA Header -->      if (($showcoursecat eq '') || ($showcoursecat)) {
   <tr>          $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
       }
    <!-- Row 1 Columns 2-4 -->      my $newuserlink;
    <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>      if ($shownewuserlink) {
   </tr>          $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
       }
   <!-- The gray bar that starts the two table frames -->      my $logintitle =
   <tr>          '<h2 class="LC_hcell"'
          .' style="background:'.$loginbox_header_bgcol.';'
    <!-- Row 2 Column 1 -->         .' color:'.$loginbox_header_textcol.'">'
    <td width=182 height=27 bgcolor="$sidebg">&nbsp;</td>         .$lt{'log'}
          .'</h2>';
    <!-- Row 2 Column 2 -->  
    <td width=27 height=27 align="left" background="$iconpath/filltop.gif"><img src="$iconpath/upperleft.gif" border=0 alt="" /></td>      my $noscript_warning='<noscript><span class="LC_warning"><b>'
                           .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
    <!-- Row 2 Column 3 -->                          .'</b></span></noscript>';
    <td height=27 background="$iconpath/filltop.gif"><img src="$iconpath/filltop.gif" alt="" /></td>      my $helpdeskscript;
       my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
    <!-- Row 2 Column 4 -->                                         $authdomain,\$helpdeskscript,
    <td width=27 height=27 align="right" background="$iconpath/filltop.gif"><img src="$iconpath/upperright.gif" border=0 alt="" /></td>                                         $showhelpdesk,\@possdoms);
   </tr>  
   <tr>      my $mobileargs;
          if ($clientmobile) {
    <!-- A cell that will hold the 'access' and 'about' buttons -->          $mobileargs = 'autocapitalize="off" autocorrect="off"'; 
    <!-- Row 3 Column 1 -->      }
    <td valign="top" height=60 align="center" bgcolor="$sidebg">      my $loginform=(<<LFORM);
     <a href="/adm/login?interface=textual"><img src="$iconpath/$lt{'access'}" border=0 alt="Accessibility Options" /></a>  <form name="client" action="" onsubmit="return(send())" id="lclogin">
     <br />    <input type="hidden" name="lextkey" value="$lextkey" />
     <a href="/adm/about.html"><img src="$iconpath/$lt{'about'}" border=0 alt="About LON-CAPA" /></a>    <input type="hidden" name="uextkey" value="$uextkey" />
    </td>    <b><label for="uname">$lt{'un'}</label>:</b><br />
     <input type="text" name="uname" id="uname" size="15" value="$authusername" readonly="readonly" $mobileargs /><br />
    <!-- The shaded space between the two main columns -->    <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
    <!-- Row 3 Column 2 -->    <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />
    <td width=27 height=60 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>    <b><label for="udom">$lt{'dom'}</label>:</b><br />
     <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" $mobileargs /><br />
    <!-- The right main column holding the large LON-CAPA logo-->    <input type="submit" value="$lt{'log'}" />
    <!-- Rows 3-4 Column 3 -->  </form>
    <td align="center" valign="top" width="100%" height="100%" bgcolor="$mainbg">  LFORM
     <center>  
      <img src="$logo" alt="" />      if ($showbanner) {
     </center>          my $alttext = &Apache::loncommon::designparm('login.alttext_img',$domain);
    </td>          if ($alttext eq '') {
               $alttext = 'The Learning Online Network with CAPA';
    <!-- Row 3 Column 4 -->          }
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>          $r->print(<<HEADER);
   </tr>  <!-- The LON-CAPA Header -->
   <tr>  <div style="background:$pgbg;margin:0;width:100%;">
     <img src="$img" border="0" alt="$alttext" class="LC_maxwidth" id="lcloginbanner" />
    <!-- The entry form -->  </div>
    <!-- Row 4 Column 1 -->  HEADER
    <td align="center" valign="middle" bgcolor="$sidebg">      }
 ENDTOP  
 } else {      my $stdauthformstyle = 'inline-block';
     $r->print('<h1>The Learning<i>Online</i> Network with CAPA</h1><h2>Text-based Interface Login</h2>'.$announcements);      my $ssoauthstyle = 'none';
 }      my $logintype;
     $r->print('<form name="client" onsubmit="return(send())">');      $r->print('<div style="float:left;margin-top:0;">');
     unless ($fullgraph) {      if ($saml_landing) {
         $r->print(<<ENDACCESSOPTIONS);          $ssoauthstyle = 'inline-block';
 <h3>Select Accessibility Options</h3>          $stdauthformstyle = 'none';
 <label><input type="checkbox" name="imagesuppress" /> Suppress rendering of images</label><br />          $logintype = $samlssotext;
 <label><input type="checkbox" name="appletsuppress" /> Suppress Java applets</label><br />          my $ssologin = '/adm/sso';
 <label><input type="checkbox" name="embedsuppress" /> Suppress rendering of embedded multimedia</label><br />          if ($samlssourl  ne '') {
 <label><input type="checkbox" name="fontenhance" /> Increase font size</label><br />              $ssologin = $samlssourl;
 <label><input type="checkbox" name="blackwhite" /> Switch to black and white mode</label><br />          }
 <p>If you have accessibility needs that are not addressed by this interface,           if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
 please              my $querystring;
 contact the system administrator at <tt>$sysadm</tt>.</p><br />              if ($env{'form.firsturl'} ne '') {
 <input type="checkbox" name="remember" /> Remember these settings for next login<hr />                  $querystring = 'origurl=';
 ENDACCESSOPTIONS                  if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
 } else {                      $querystring .= &uri_escape_utf8($env{'form.firsturl'});
     $r->print(<<ENDNOOPT);                  } else {
 <input type="hidden" name="imagesuppress"  value="" />                      $querystring .= &uri_escape($env{'form.firsturl'});
 <input type="hidden" name="embedsuppress"  value="" />                  }
 <input type="hidden" name="appletsuppress"  value="" />                  $querystring = &HTML::Entities::encode($querystring,"'");
 <input type="hidden" name="fontenhance"  value="" />              }
 <input type="hidden" name="blackwhite"  value="" />              if ($env{'form.ltoken'} ne '') {
 <input type="hidden" name="remember"  value="" />                  $querystring .= (($querystring eq '')?'':'&amp;') . 'ltoken='.
 ENDNOOPT                                    &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);      $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;&nbsp;&nbsp;<a href="/adm/loginproblems.html">$lt{'help'}</a></td>  
        <td bgcolor="$mainbg" valign="bottom" align="center">  
         <br />  
         <input type="submit" value="$lt{'log'}" />  
        </td>  
       </tr>  
      </table>  
      <!-- End sub-table -->  
     </form>  
 ENDLOGIN  ENDLOGIN
     if ($fullgraph) {      $r->print('</div><div>'."\n");
         my $helpdeskscript;      if ($showmainlogo) {
         my $contactblock = &contactdisplay(\%lt,$sysadm,$servadm,$version,$authdomain,\$helpdeskscript);          my $alttext = &Apache::loncommon::designparm('login.alttext_logo',$domain);
  $r->print(<<ENDDOCUMENT);          $r->print(' <img src="'.$logo.'" alt="'.$alttext.'" class="LC_maxwidth" id="lcloginmainlogo" />'."\n");
    </td>      }
   $r->print(<<ENDTOP);
    <!-- Row 4 Column 2 -->  $announcements
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>  </div>
   <hr style="clear:both;" />
    <!-- Row 4 Column 3 -->  ENDTOP
 <td bgcolor="$mainbg">$announcements</td>      my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
       $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>  
   
   $in_frame_js
 <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;
       my $args = {};
       if ($env{'form.firsturl'} =~ m{^/tiny/$match_domain/\w+$}) {
           $url = $protocol.'://'.$hostname.$env{'form.firsturl'};
           if (($env{'form.ltoken'}) || ($env{'form.linkprot'} ne '') ||
               ($env{'form.linkkey'} ne '')) {
               my %link_info;
               if ($env{'form.ltoken'}) {
                   %link_info = &Apache::lonnet::tmpget($env{'form.ltoken'});
                   &Apache::lonnet::tmpdel($env{'form.ltoken'});
                   $args->{'only_body'} = 1;
               } elsif ($env{'form.linkprot'}) {
                   $link_info{'linkprot'} = $env{'form.linkprot'};
                   foreach my $item ('linkprotuser','linkprotexit') {
                       if ($env{'form.'.$item}) {
                           $link_info{$item} = $env{'form.'.$item};
                       }
                   }
                   $args->{'only_body'} = 1;
               } 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 .= '?ltoken='.$token;
               }
           }
       } else {
           my $querystring;
           if ($env{'form.firsturl'} ne '') {
               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,"'");
               $querystring = '?firsturl='.$querystring;
           }
           if ($env{'form.ltoken'}) {
               my %link_info = &Apache::lonnet::tmpget($env{'form.ltoken'});
               &Apache::lonnet::tmpdel($env{'form.ltoken'});
               my $token = &Apache::lonnet::tmpput(\%link_info,$desthost,'link');
               unless (($token eq 'con_lost') || ($token eq 'refused') || ($token =~ /^error:/) ||
                       ($token eq 'unknown_cmd') || ($token eq 'no_such_host')) {
                   unless (($path eq '/adm/roles') || ($path eq '/adm/login')) {
                       $url = $protocol.'://'.$hostname.'/adm/roles';
                   }
                   $querystring .= (($querystring =~/^\?/)?'&amp;':'?') . 'ttoken='.$token;
               }
           }
           $url .= $querystring;
       }
       $args->{'redirect'} = [0,$url];
       my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,$args);
       my $end_page   = &Apache::loncommon::end_page();
       return $start_page.$end_page;
   }
   
 sub contactdisplay {  sub contactdisplay {
     my ($lt,$sysadm,$servadm,$version,$authdomain,$helpdeskscript) = @_;      my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk,
           $possdoms) = @_;
     my $contactblock;      my $contactblock;
     my $showsysadm = 1;      my $origmail;
     my $showservadm = 1;      if (ref($possdoms) eq 'ARRAY') {
     my $showhelpdesk = 0;          if (grep(/^\Q$authdomain\E$/,@{$possdoms})) { 
     my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};              $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
     if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {          }
         $showhelpdesk = 1;      }
     }      my $requestmail = 
     if ($showsysadm) {          &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;'.$$lt{'sysadm'}.':</b><br />'.                                                   $authdomain,$origmail);
                          '<tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.$sysadm.'</tt><br />';      unless ($showhelpdesk eq '0') {
     }          if ($requestmail =~ m/[^\@]+\@[^\@]+/) {
     if ($showservadm) {              $showhelpdesk = 1;
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;'.$$lt{'servadm'}.':</b><br />'.          } else {
                          '<tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;'.$servadm.'</tt><br />&nbsp;<br />';              $showhelpdesk = 0;
           }
       }
       if ($servadm && $showadminmail) {
           $contactblock .= $$lt{'servadm'}.':<br />'.
                            '<tt>'.$servadm.'</tt><br />';
     }      }
     if ($showhelpdesk) {      if ($showhelpdesk) {
         $contactblock .= '<b>&nbsp;&nbsp;&nbsp;<a href="javascript:helpdesk()">'.$$lt{'helpdesk'}.'</a></b><br />';          $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
         my $thisurl = &Apache::lonnet::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 622  function helpdesk() { Line 1258  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;
 }  }
    
   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;  1;
 __END__  __END__
Removed from v.1.71  
changed lines
  Added in v.1.158.2.13.2.6

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.