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

Diff for /loncom/auth/lonlogin.pm between versions 1.14 and 1.158.2.15

version 1.14, 2002/03/13 19:32:55 version 1.158.2.15, 2022/02/24 16:00:23
Line 25 Line 25
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 5/21/99,5/22,5/25,5/26,5/31,6/2,6/10,7/12,7/14,  
 # 1/14/00,5/29,5/30,6/1,6/29,7/1,11/9,  
 # 1/17/01 Gerd Kortemeyer  
 #  
 # 2/7/02,2/8,2/12,2/14,2/15,2/19 Josh Brunskole  
   
 package Apache::lonlogin;  package Apache::lonlogin;
   
 use strict;  use strict;
 use Apache::Constants qw(:common);  use Apache::Constants qw(:common);
 use Apache::File ();  use Apache::File ();
 use Apache::lonnet();  use Apache::lonnet;
 use Apache::loncommon();  use Apache::loncommon();
   use Apache::lonauth();
   use Apache::lonlocal;
   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;
     $r->content_type('text/html');  
       &Apache::loncommon::get_unprocessed_cgi
    (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
         $ENV{'REDIRECT_QUERY_STRING'}),
    ['interface','username','domain','firsturl','localpath','localres',
     'token','role','symb','iptoken','btoken','saml','sso','retry']);
   
   # -- check if they are a migrating user
       if (defined($env{'form.token'})) {
    return &Apache::migrateuser::handler($r);
       }
   
       my $lonhost = $r->dir_config('lonHostID');
       if (($env{'form.sso'}) || ($env{'form.retry'})) {
           my $infotoken;
           if ($env{'form.sso'}) {
               $infotoken = $env{'form.sso'};
           } else {
               $infotoken = $env{'form.retry'};
           }
           my $data = &Apache::lonnet::reply('tmpget:'.$infotoken,$lonhost);
           unless (($data=~/^error/) || ($data eq 'con_lost') ||
                   ($data eq 'no_such_host')) {
               my %info = &decode_token($data);
               foreach my $item (keys(%info)) {
                   $env{'form.'.$item} = $info{$item};
               }
               &Apache::lonnet::tmpdel($infotoken);
           }
       } else {
           if (!defined($env{'form.firsturl'})) {
               &Apache::lonacc::get_posted_cgi($r,['firsturl']);
           }
           if ($env{'form.firsturl'} eq '/adm/logout') {
               delete($env{'form.firsturl'});
           }
       }
   
   # For "public user" - remove any exising "public" cookie, as user really wants to log-in
       my ($handle,$lonidsdir,$expirepub,$userdom);
       $lonidsdir=$r->dir_config('lonIDsDir');
       unless ($r->header_only) {
           $handle = &Apache::lonnet::check_for_valid_session($r,'lonID',undef,\$userdom);
           if ($handle ne '') {
               if ($handle=~/^publicuser\_/) {
                   unlink($r->dir_config('lonIDsDir')."/$handle.id");
                   undef($handle);
                   undef($userdom);
                   $expirepub = 1;
               }
           }
       }
   
     &Apache::loncommon::no_cache($r);      &Apache::loncommon::no_cache($r);
       &Apache::lonlocal::get_language_handle($r);
       &Apache::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;
   
     my $iconpath= $r->dir_config('lonIconsURL');  
     my $domain  = $r->dir_config('lonDefDomain');  # Are we re-routing?
       my $londocroot = $r->dir_config('lonDocRoot'); 
       if (-e "$londocroot/lon-status/reroute.txt") {
    &Apache::lonauth::reroute($r);
    return OK;
       }
   
   # Check if browser sent a LON-CAPA load balancer cookie (and this is a balancer)
   
       my ($found_server,$balancer_cookie) = &Apache::lonnet::check_for_balancer_cookie($r,1);
       if ($found_server) {
           my $hostname = &Apache::lonnet::hostname($found_server);
           if ($hostname ne '') {
               my $protocol = $Apache::lonnet::protocol{$found_server};
               $protocol = 'http' if ($protocol ne 'https');
               my $dest = '/adm/roles';
               if ($env{'form.firsturl'} ne '') {
                   $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
               }
               my %info = (
                            balcookie => $lonhost.':'.$balancer_cookie,
                          );
               if ($env{'form.role'}) {
                   $info{'role'} = $env{'form.role'};
               }
               if ($env{'form.symb'}) {
                   $info{'symb'} = $env{'form.symb'};
               }
               my $balancer_token = &Apache::lonnet::tmpput(\%info,$found_server);
               unless (($balancer_token eq 'con_lost') || ($balancer_token eq 'refused') ||
                       ($balancer_token eq 'unknown_cmd') || ($balancer_token eq 'no_such_host')) {
                   $dest .=  (($dest=~/\?/)?'&amp;':'?') . 'btoken='.$balancer_token;
               }
               unless ($found_server eq $lonhost) {
                   my $alias = &Apache::lonnet::use_proxy_alias($r,$found_server);
                   $hostname = $alias if ($alias ne '');
               }
               my $url = $protocol.'://'.$hostname.$dest;
               my $start_page =
                   &Apache::loncommon::start_page('Switching Server ...',undef,
                                                  {'redirect'       => [0,$url],});
               my $end_page   = &Apache::loncommon::end_page();
               $r->print($start_page.$end_page);
               return OK;
           }
       }
   
   #
   # Check if a LON-CAPA load balancer sent user here because user's browser sent
   # it a balancer cookie for an active session on this server.
   #
   
       my $balcookie;
       if ($env{'form.btoken'}) {
           my %info = &Apache::lonnet::tmpget($env{'form.btoken'});
           $balcookie = $info{'balcookie'};
           &Apache::lonnet::tmpdel($env{'form.btoken'});
           delete($env{'form.btoken'});
       }
   
   #
   # If browser sent an old cookie for which the session file had been removed
   # check if configuration for user's domain has a portal URL set.  If so
   # switch user's log-in to the portal.
   #
   
       if (($handle eq '') && ($userdom ne '')) {
           my %domdefaults = &Apache::lonnet::get_domain_defaults($userdom);
           if ($domdefaults{'portal_def'} =~ /^https?\:/) {
               my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                             {'redirect' => [0,$domdefaults{'portal_def'}],});
               my $end_page   = &Apache::loncommon::end_page();
               $r->print($start_page.$end_page);
               return OK;
           }
       }
   
   # -------------------------------- Prevent users from attempting to login twice
       if ($handle ne '') {
           &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
    my $start_page = 
       &Apache::loncommon::start_page('Already logged in');
    my $end_page = 
       &Apache::loncommon::end_page();
           my $dest = '/adm/roles';
           if ($env{'form.firsturl'} ne '') {
               $dest = &HTML::Entities::encode($env{'form.firsturl'},'\'"<>&');
           }
    $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
   
   # ---------------------------- Not possible to really login to domain "public"
       if ($env{'form.domain'} eq 'public') {
    $env{'form.domain'}='';
    $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
       $env{'form.interface'}=~s/\W//g;
   
       (undef,undef,undef,undef,undef,undef,my $clientmobile) =
           &Apache::loncommon::decode_user_agent($r);
   
       my $iconpath= 
    &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
   
       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;
               }
           }
       }
   
       if (($sessiondata{'domain'}) &&
           (&Apache::lonnet::domain($sessiondata{'domain'},'description'))) {
           $domain=$sessiondata{'domain'};
       } elsif (($env{'form.domain'}) && 
    (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
    $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 $version = $r->dir_config('lonVersion');
       my $host_name = &Apache::lonnet::hostname($lonhost);
   
   # --------------------------------------------- Default values for login fields
       
       my ($authusername,$authdomain);
       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
     my $loadavg;      my $loadavg;
    {      {
        my $loadfile=Apache::File->new('/proc/loadavg');   my $loadfile=Apache::File->new('/proc/loadavg');
        $loadavg=<$loadfile>;   $loadavg=<$loadfile>;
    }      }
     $loadavg =~ s/\s.*//g;      $loadavg =~ s/\s.*//g;
     my $loadpercent=100*$loadavg/$loadlim;  
   
     my $otherserver='http://'.$ENV{'SERVER_NAME'};      my ($loadpercent,$userloadpercent);
     my $firsturl=$ENV{'request.firsturl'};      if ($loadlim) {
 # ---------------------------------------- Are we access server and overloaded?          $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
     if (($role eq 'access') && ($loadpercent>100.0)) {  
         $otherserver=Apache::lonnet::spareserver();  
     }      }
       if ($uloadlim) {
           $userloadpercent=&Apache::lonnet::userload();
       }
   
       my $firsturl=
       ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
   
   # ----------------------------------------------------------- Get announcements
       my $announcements=&Apache::lonnet::getannounce();
 # -------------------------------------------------------- Set login parameters  # -------------------------------------------------------- Set login parameters
   
     my @hexstr=('0','1','2','3','4','5','6','7',      my @hexstr=('0','1','2','3','4','5','6','7',
Line 86  sub handler { Line 325  sub handler {
     }      }
   
     my $lextkey=hex($lkey);      my $lextkey=hex($lkey);
       if ($lextkey>2147483647) { $lextkey-=4294967296; }
   
     my $uextkey=hex($ukey);      my $uextkey=hex($ukey);
       if ($uextkey>2147483647) { $uextkey-=4294967296; }
   
   # -------------------------------------------------------- Store away log token
       my $tokenextras;
       my @names = ('role','symb','iptoken');
       foreach my $name (@names) {
           if ($env{'form.'.$name} ne '') {
               $tokenextras .= '&'.$name.'='.&escape($env{'form.'.$name});
           }
       }
     my $logtoken=Apache::lonnet::reply(      my $logtoken=Apache::lonnet::reply(
        'tmpput:'.$ukey.$lkey.'&'.$firsturl,         'tmpput:'.$ukey.$lkey.'&'.&escape($firsturl).$tokenextras,
        $lonhost);         $lonhost);
   
 # --------------------------------------------------- Print login screen header  # -- If we cannot talk to ourselves, or hostID does not map to a hostname
     $r->print(<<ENDHEADER);  #    we are in serious trouble
 <html>  
 <head>      if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
 <title>The LearningOnline Network with CAPA Login</title>          if ($logtoken eq 'no_such_host') {
 </head>              &Apache::lonnet::logthis('No valid logtoken for log-in page -- unable to determine hostname for hostID: '.$lonhost.'. Check entry in hosts.tab');
 ENDHEADER          }
 # ---------------------------------------------------- Serve out DES JavaScript          my $spares='';
     {          my (@sparehosts,%spareservers);
  my $jsh=Apache::File->new($include."/londes.js");          my $sparesref = &Apache::lonnet::this_host_spares($defdom);
         $r->print(<$jsh>);          if (ref($sparesref) eq 'HASH') {
               foreach my $key (keys(%{$sparesref})) {
                   if (ref($sparesref->{$key}) eq 'ARRAY') {
                       my @sorted = sort { &Apache::lonnet::hostname($a) cmp
                                           &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);
       my $hostname = &Apache::lonnet::hostname($hostid);
       next if (($hostname eq '') || ($spareservers{$hostname}));
               $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.'">'.
                   $hostname.'</a>'.
                   ' '.&mt('(preferred)').'</span>'.$/;
           }
           if ($spares) {
               $spares.= '<br />';
           }
           my %all_hostnames = &Apache::lonnet::all_hostnames();
           foreach my $hostid (sort
       {
    &Apache::lonnet::hostname($a) cmp
       &Apache::lonnet::hostname($b);
       }
       keys(%all_hostnames)) {
               next if ($hostid eq $lonhost);
               my $hostname = &Apache::lonnet::hostname($hostid);
               next if (($hostname eq '') || ($spareservers{$hostname}));
               $spareservers{$hostname} = 1;
               my $protocol = $Apache::lonnet::protocol{$hostid};
               $protocol = 'http' if ($protocol ne 'https');
               $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('</body>'
                    .'</html>'
           );
           return OK;
     }      }
 # ---------------------------------------------------------- Serve rest of page  
     $r->print(<<ENDDOCUMENT);  
   
 <body bgcolor="#006600" text="#000000" link="#999999" vlink="#999999"  # ----------------------------------------------- Apparently we are in business
  onLoad="init();" topmargin=0 leftmargin=0 marginwidth=0 marginheight=0>      $servadm=~s/\,/\<br \/\>/g;
   
  <script language="JavaScript">  # ----------------------------------------------------------- Front page design
     function send()      my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
     {      my $font=&Apache::loncommon::designparm('login.font',$domain);
  this.document.server.elements.uname.value      my $link=&Apache::loncommon::designparm('login.link',$domain);
        =this.document.client.elements.uname.value;      my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
       my $alink=&Apache::loncommon::designparm('login.alink',$domain);
       my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
       my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
       my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
       my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
       my $logo=&Apache::loncommon::designparm('login.logo',$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);
   
   <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();
   
   this.document.server.elements.upass0.value
       =getCrypted(this.document.client.elements.upass$now.value);
   
   this.document.client.elements.uname.value='';
   this.document.client.elements.upass$now.value='';
   
   this.document.server.submit();
   return false;
   }
   
   function enableInput() {
       this.document.client.elements.upass$now.removeAttribute("readOnly");
       this.document.client.elements.uname.removeAttribute("readOnly");
       this.document.client.elements.udom.removeAttribute("readOnly");
       return;
   }
   
   // ]]>
   </script>
   
   ENDSCRIPT
   
       my ($lonhost_in_use,@hosts,%defaultdomconf,$saml_prefix,$saml_landing,
           $samlssotext,$samlnonsso,$samlssoimg,$samlssoalt,$samlssourl,$samltooltip);
       %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
       @hosts = &Apache::lonnet::current_machine_ids();
       $lonhost_in_use = $lonhost;
       if (@hosts > 1) {
           foreach my $hostid (@hosts) {
               if (&Apache::lonnet::host_domain($hostid) eq $defdom) {
                   $lonhost_in_use = $hostid;
                   last;
               }
           }
       }
       $saml_prefix = $defdom.'.login.saml_';
       if ($defaultdomconf{$saml_prefix.$lonhost_in_use}) {
           $saml_landing = 1;
           $samlssotext = $defaultdomconf{$saml_prefix.'text_'.$lonhost_in_use};
           $samlnonsso = $defaultdomconf{$saml_prefix.'notsso_'.$lonhost_in_use};
           $samlssoimg = $defaultdomconf{$saml_prefix.'img_'.$lonhost_in_use};
           $samlssoalt = $defaultdomconf{$saml_prefix.'alt_'.$lonhost_in_use};
           $samlssourl = $defaultdomconf{$saml_prefix.'url_'.$lonhost_in_use};
           $samltooltip = $defaultdomconf{$saml_prefix.'title_'.$lonhost_in_use};
       }
       if ($saml_landing) {
          if ($samlssotext eq '') {
              $samlssotext = 'SSO Login';
          }
          if ($samlnonsso eq '') {
              $samlnonsso = 'Non-SSO Login';
          }
          $js .= <<"ENDSAMLJS";
   
   <script type="text/javascript">
   // <![CDATA[
   function toggleLClogin() {
       if (document.getElementById('LC_standard_login')) {
           if (document.getElementById('LC_standard_login').style.display == 'none') {
               document.getElementById('LC_standard_login').style.display = 'inline-block';
               if (document.getElementById('LC_login_text')) {
                   document.getElementById('LC_login_text').innerHTML = '$samlnonsso';
               }
               if ( document.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.udom.value  // ]]>
        =this.document.client.elements.udom.value;  </script>
   
         uextkey=this.document.client.elements.uextkey.value;  ENDSAMLJS
         lextkey=this.document.client.elements.lextkey.value;      }
         initkeys();  
   
         this.document.server.elements.upass.value  # --------------------------------------------------- Print login screen header
     =crypted(this.document.client.elements.upass.value);  
   
         this.document.server.submit();      my %add_entries = (
          bgcolor      => "$mainbg",
          text         => "$font",
          link         => "$link",
          vlink        => "$vlink",
          alink        => "$alink",
                  onload       => 'javascript:enableInput();',);
   
       my ($headextra,$headextra_exempt);
       $headextra = $defaultdomconf{$defdom.'.login.headtag_'.$lonhost_in_use};
       $headextra_exempt = $defaultdomconf{$domain.'.login.headtag_exempt_'.$lonhost_in_use};
       if ($headextra) {
           my $omitextra;
           if ($headextra_exempt ne '') {
               my @exempt = split(',',$headextra_exempt);
               my $ip = &Apache::lonnet::get_requestor_ip();
               if (grep(/^\Q$ip\E$/,@exempt)) {
                   $omitextra = 1;
               }
           }
           unless ($omitextra) {
               my $confname = $defdom.'-domainconfig';
               if ($headextra =~ m{^\Q/res/$defdom/$confname/login/headtag/$lonhost_in_use/\E}) {
                   my $extra = &Apache::lonnet::getfile(&Apache::lonnet::filelocation("",$headextra));
                   unless ($extra eq '-1') {
                       $js .= "\n".$extra."\n";
                   }
               }
           }
     }      }
  </script>  
   
  <!-- The Main Table -->      $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
  <table width="100%" cellpadding=0 cellspacing=0 border=0>         { 'redirect'       => [$expire,'/adm/roles'], 
    'add_entries' => \%add_entries,
    'only_body'   => 1,}));
   
   # ----------------------------------------------------------------------- Texts
   
       my %lt=&Apache::lonlocal::texthash(
             'un'       => 'Username',
             'pw'       => 'Password',
             'dom'      => 'Domain',
             'perc'     => 'percent',
             'load'     => 'Server Load',
             'userload' => 'User Load',
             'catalog'  => 'Course/Community Catalog',
             'log'      => 'Log in',
             'help'     => 'Log-in Help',
             'serv'     => 'Server',
             'servadm'  => 'Server Administration',
             'helpdesk' => 'Contact Helpdesk',
             'forgotpw' => 'Forgot password?',
             'newuser'  => 'New User?',
             'change'   => 'Change?',
          );
   # -------------------------------------------------- Change password field name
   
       my $forgotpw = &forgotpwdisplay(%lt);
       $forgotpw .= '<br />' if $forgotpw;
       my $loginhelp = &Apache::lonauth::loginhelpdisplay($authdomain);
       if ($loginhelp) {
           $loginhelp = '<a href="'.$loginhelp.'">'.$lt{'help'}.'</a><br />';
       }
   
   <form name="server" action="$otherserver/adm/authenticate" method="post" target="_top">  # ---------------------------------------------------- Serve out DES JavaScript
    <input type=hidden name=logtoken value="$logtoken">      {
    <input type=hidden name=serverid value="$lonhost">      my $jsh=Apache::File->new($include."/londes.js");
    <input type=hidden name=uname value="">      $r->print(<$jsh>);
    <input type=hidden name=upass value="">      }
    <input type=hidden name=udom value="">  # ---------------------------------------------------------- Serve rest of page
   
       $r->print(
       '<div class="LC_Box"'
      .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
   );
   
       $r->print(<<ENDSERVERFORM);
   <form name="server" action="/adm/authenticate" method="post" target="_top">
      <input type="hidden" name="logtoken" value="$logtoken" />
      <input type="hidden" name="serverid" value="$lonhost" />
      <input type="hidden" name="uname" value="" />
      <input type="hidden" name="upass0" value="" />
      <input type="hidden" name="udom" value="" />
      <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
      <input type="hidden" name="localres" value="$env{'form.localres'}" />
   </form>    </form>
   ENDSERVERFORM
       my $coursecatalog;
       if (($showcoursecat eq '') || ($showcoursecat)) {
           $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
       }
       my $newuserlink;
       if ($shownewuserlink) {
           $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
       }
       my $logintitle =
           '<h2 class="LC_hcell"'
          .' style="background:'.$loginbox_header_bgcol.';'
          .' color:'.$loginbox_header_textcol.'">'
          .$lt{'log'}
          .'</h2>';
   
       my $noscript_warning='<noscript><span class="LC_warning"><b>'
                           .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
                           .'</b></span></noscript>';
       my $helpdeskscript;
       my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
                                          $authdomain,\$helpdeskscript,
                                          $showhelpdesk,\@possdoms);
   
       my $mobileargs;
       if ($clientmobile) {
           $mobileargs = 'autocapitalize="off" autocorrect="off"'; 
       }
       my $loginform=(<<LFORM);
   <form name="client" action="" onsubmit="return(send())" id="lclogin">
     <input type="hidden" name="lextkey" value="$lextkey" />
     <input type="hidden" name="uextkey" value="$uextkey" />
     <b><label for="uname">$lt{'un'}</label>:</b><br />
     <input type="text" name="uname" id="uname" size="15" value="$authusername" readonly="readonly" $mobileargs /><br />
     <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
     <input type="password" name="upass$now" id="upass$now" size="15" readonly="readonly" /><br />
     <b><label for="udom">$lt{'dom'}</label>:</b><br />
     <input type="text" name="udom" id="udom" size="15" value="$authdomain" readonly="readonly" $mobileargs /><br />
     <input type="submit" value="$lt{'log'}" />
   </form>
   LFORM
   
       if ($showbanner) {
           my $alttext = &Apache::loncommon::designparm('login.alttext_img',$domain);
           if ($alttext eq '') {
               $alttext = 'The Learning Online Network with CAPA';
           }
           $r->print(<<HEADER);
   <!-- The LON-CAPA Header -->
   <div style="background:$pgbg;margin:0;width:100%;">
     <img src="$img" border="0" alt="$alttext" class="LC_maxwidth" id="lcloginbanner" />
   </div>
   HEADER
       }
   
   <!-- The LON-CAPA Header -->      my $stdauthformstyle = 'inline-block';
   <tr>      my $ssoauthstyle = 'none';
       my $logintype;
       $r->print('<div style="float:left;margin-top:0;">');
       if ($saml_landing) {
           $ssoauthstyle = 'inline-block';
           $stdauthformstyle = 'none';
           $logintype = $samlssotext;
           my $ssologin = '/adm/sso';
           if ($samlssourl  ne '') {
               $ssologin = $samlssourl;
           }
           if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
               my $querystring;
               if ($env{'form.firsturl'} ne '') {
                   $querystring = 'origurl=';
                   if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
                       $querystring .= &uri_escape_utf8($env{'form.firsturl'});
                   } else {
                       $querystring .= &uri_escape($env{'form.firsturl'});
                   }
                   $querystring = &HTML::Entities::encode($querystring,"'");
               }
               if ($querystring ne '') {
                   $ssologin .= (($ssologin=~/\?/)?'&amp;':'?') . $querystring;
               }
           } elsif ($logtoken ne '') {
               $ssologin .= (($ssologin=~/\?/)?'&amp;':'?') . 'logtoken='.$logtoken;
           }
           my $ssohref;
           if ($samlssoimg ne '') {
               $ssohref = '<a href="'.$ssologin.'" title="'.$samltooltip.'">'.
                          '<img src="'.$samlssoimg.'" alt="'.$samlssoalt.'" id="lcssobutton" /></a>';
           } else {
               $ssohref = '<a href="'.$ssologin.'">'.$samlssotext.'</a>';
           }
           if (($env{'form.saml'} eq 'no') ||
               (($env{'form.username'} ne '') && ($env{'form.domain'} ne ''))) {
               $ssoauthstyle = 'none';
               $stdauthformstyle = 'inline-block';
               $logintype = $samlnonsso;
           }
           $r->print(<<ENDSAML);
   <p>
   Log-in type:
   <span style="font-weight:bold" id="LC_login_text">$logintype</span><br />
   <span><a href="javascript:toggleLClogin();" style="color:#000000">$lt{'change'}</a></span>
   </p>
   <div style="display:$ssoauthstyle" id="LC_SSO_login">
   <div class="LC_Box" style="padding-top: 10px;">
   $ssohref
   $noscript_warning
   </div>
   <div class="LC_Box" style="padding-top: 10px;">
   $loginhelp
   $contactblock
   $coursecatalog
   </div>
   </div>
   ENDSAML
       }
   
    <!-- Row 1 Columns 2-4 -->      $r->print(<<ENDLOGIN);
    <td width="100%" height=75 colspan=4 align="left" valign="top" bgcolor="#006600"><img src="$iconpath/header.gif" border=0 /></td>  <div style="display:$stdauthformstyle;" id="LC_standard_login">
   </tr>  <div class="LC_Box" style="background:$loginbox_bg;">
     $logintitle
   <!-- The gray bar that starts the two table frames -->    $loginform
   <tr>    $noscript_warning
   </div>
    <!-- Row 2 Column 1 -->    
    <td width=182 height=27 bgcolor="#cccccc">&nbsp;</td>  <div class="LC_Box" style="padding-top: 10px;">
     $loginhelp
    <!-- Row 2 Column 2 -->    $forgotpw
    <td width=27 height=27 align="left" background="$iconpath/filltop.gif"><img src="$iconpath/upperleft.gif" border=0 /></td>    $contactblock
     $newuserlink
    <!-- Row 2 Column 3 -->    $coursecatalog
    <td height=27 background="$iconpath/filltop.gif"><img src="$iconpath/filltop.gif" /></td>  </div>
   </div>
    <!-- Row 2 Column 4 -->  
    <td width=27 height=27 align="right" background="$iconpath/filltop.gif"><img src="$iconpath/upperright.gif" border=0 /></td>  ENDLOGIN
   </tr>      $r->print('</div><div>'."\n");
   <tr>      if ($showmainlogo) {
              my $alttext = &Apache::loncommon::designparm('login.alttext_logo',$domain);
    <!-- A cell that will hold the 'access' and 'about' buttons -->          $r->print(' <img src="'.$logo.'" alt="'.$alttext.'" class="LC_maxwidth" id="lcloginmainlogo" />'."\n");
    <!-- Row 3 Column 1 -->      }
    <td valign="top" height=60 align="center" bgcolor="#cccccc">  $r->print(<<ENDTOP);
     <a href="/adm/accessibility.html"><img src="$iconpath/accessbutton.gif" border=0 /></a>  $announcements
     <br />  </div>
     <a href="/adm/about.html"><img src="$iconpath/aboutlon.gif" border=0 /></a>  <hr style="clear:both;" />
    </td>  ENDTOP
       my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
    <!-- The shaded space between the two main columns -->      $domainrow = <<"END";
    <!-- Row 3 Column 2 -->  
    <td width=27 height=60 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" /></td>  
   
    <!-- The right main column holding the large LON-CAPA logo-->  
    <!-- Rows 3-4 Column 3 -->  
    <td align="center" valign="top" width="100%" height="100%" rowspan=2 bgcolor="#ffffff">  
     <center>  
      <img src="$iconpath/loncapalogo.gif" />  
     </center>  
    </td>  
   
    <!-- Row 3 Column 4 -->  
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" /></td>  
   </tr>  
   <tr>  
   
    <!-- The entry form -->  
    <!-- Row 4 Column 1 -->  
    <td align="center" valign="middle" bgcolor="#cccccc">  
     <form name="client">  
      <input type="hidden" name="lextkey" value="$lextkey">  
      <input type="hidden" name="uextkey" value="$uextkey">  
   
      <!-- Start the sub-table for text and input alignment -->  
      <table border=0 cellspacing=0 cellpadding=0>  
       <tr><td bgcolor="#cccccc" colspan=2><img src="$iconpath/userauthentication.gif" /></td></tr>  
       <tr>  
        <td bgcolor="#ffffff"><br /><font size=-1><b>&nbsp;&nbsp;&nbsp;User Name:</b></font></td>  
        <td bgcolor="#ffffff"><br /><input type="text" name="uname" size="10" /></td>  
       </tr>  
       <tr>  
        <td bgcolor="#ffffff"><font size=-1><b>&nbsp;&nbsp;&nbsp;Password:</b></font></td>  
        <td bgcolor="#ffffff"><input type="password" name="upass" size="10" /></td>  
       </tr>  
       <tr>        <tr>
        <td bgcolor="#ffffff"><font size=-1><b>&nbsp;&nbsp;&nbsp;Domain:</b></font></td>         <td  align="left" valign="top">
        <td bgcolor="#ffffff"><input type="text" name="udom" size="10" value=$domain /></td>          <small><b>$lt{'dom'}:&nbsp;</b></small>
          </td>
          <td  align="left" valign="top">
           <small><tt>&nbsp;$domain</tt></small>
          </td>
       </tr>        </tr>
   END
       $serverrow = <<"END";
       <tr>        <tr>
        <td bgcolor="#ffffff" valign="bottom" align="center" colspan=2>         <td  align="left" valign="top">
         <br />          <small><b>$lt{'serv'}:&nbsp;</b></small>
         <input type="button" value="Log In" onClick="send();" />         </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$lonhost ($role)</tt></small>
        </td>         </td>
       </tr>        </tr>
      </table>  END
      <!-- End sub-table -->      if ($loadlim) {
           $loadrow = <<"END";
     </form>  
    </td>  
   
    <!-- Row 4 Column 2 -->  
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" /></td>  
   
    <!-- Row 4 Column 4 -->  
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" /></td>  
   </tr>  
   <tr>  
   
    <!-- Row 5 Column 1 -->  
    <td bgcolor="#cccccc" valign="middle" align="left">  
      <br />  
      <table border=0 cellspacing=0 cellpadding=0>  
       <tr>        <tr>
        <td bgcolor="#cccccc" align="left" valign="top">         <td align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;Domain:&nbsp;</b></small>          <small><b>$lt{'load'}:&nbsp;</b></small>
        </td>         </td>
        <td bgcolor="#cccccc" align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$domain</tt></small>          <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       }
       if ($uloadlim) {
           $userloadrow = <<"END";
       <tr>        <tr>
        <td bgcolor="#cccccc" align="left" valign="top">         <td align="left" valign="top">
         <small><b>&nbsp;&nbsp;&nbsp;Server:&nbsp;</b></small>          <small><b>$lt{'userload'}:&nbsp;</b></small>
        </td>         </td>
        <td bgcolor="#cccccc" align="left" valign="top">         <td align="left" valign="top">
         <small><tt>&nbsp;$lonhost ($role)</tt></small>          <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>
        </td>         </td>
       </tr>        </tr>
   END
       }
       if (($version ne '') && ($version ne '<!-- VERSION -->')) {
           $versionrow = <<"END";
       <tr>        <tr>
        <td bgcolor="#cccccc" align="left" valign="top">         <td colspan="2" align="left">
         <small><b>&nbsp;&nbsp;&nbsp;Load:&nbsp;</b></small>          <small>$version</small>
        </td>  
        <td bgcolor="#cccccc" align="left" valign="top">  
         <small><tt>&nbsp;$loadpercent percent</tt></small>  
        </td>         </td>
       </tr>        </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>
     <small>      <div style="float: right;">
      <b>&nbsp;&nbsp;&nbsp;System Administration:</b><br />      $domainlogo
      <tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$sysadm</tt><br />      </div>
      <b>&nbsp;&nbsp;&nbsp;Server Administration:</b><br />      <br style="clear:both;" />
      <tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$servadm</tt>   </div>
     </small>  
    </td>  <script type="text/javascript">
   // <![CDATA[
    <!-- Row 5 Column 2 -->  // the if prevents the script error if the browser can not handle this
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" /></td>  if ( document.client.uname ) { document.client.uname.focus(); }
   // ]]>
    <!-- Row 5 Column 3 -->  </script>
    <td width="100%" valign="bottom" bgcolor="#ffffff"><img src="$iconpath/litetext.gif" /><img src="$iconpath/lite.gif" /></td>  $helpdeskscript
   
    <!-- Row 5 Column 4 -->  
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" /></td>  
   </tr>  
   <tr>  
   
    <!-- Row 6 Column 1 -->  
    <td bgcolor="#cccccc">&nbsp;</td>  
   
    <!-- Row 6 Column 2 -->  
    <td align="left" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerleft.gif" /></td>  
   
    <!-- Row 6 Column 3 -->  
    <td background="$iconpath/fillbottom.gif"><img src="$iconpath/fillbottom.gif" /></td>  
   
    <!-- Row 6 Column 4 -->  
    <td align="right" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerright.gif" /></td>  
   </tr>  
  </table>  
 </body>  
 </html>  
   
 ENDDOCUMENT  ENDDOCUMENT
       my %endargs = ( 'noredirectlink' => 1, );
       $r->print(&Apache::loncommon::end_page(\%endargs));
     return OK;      return OK;
 }   }
   
   sub check_loginvia {
       my ($domain,$lonhost,$lonidsdir,$balcookie) = @_;
       if ($domain eq '' || $lonhost eq '' || $lonidsdir eq '') {
           return;
       }
       my %domconfhash = &Apache::loncommon::get_domainconf($domain);
       my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
       my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
       my $output;
       if ($loginvia ne '') {
           my $noredirect;
           my $ip = &Apache::lonnet::get_requestor_ip();
           if ($ip eq '127.0.0.1') {
               $noredirect = 1;
           } else {
               if ($loginvia_exempt ne '') {
                   my @exempt = split(',',$loginvia_exempt);
                   if (grep(/^\Q$ip\E$/,@exempt)) {
                       $noredirect = 1;
                   }
               }
           }
           unless ($noredirect) {
               my ($newhost,$path);
               if ($loginvia =~ /:/) {
                   ($newhost,$path) = split(':',$loginvia);
               } else {
                   $newhost = $loginvia;
               }
               if ($newhost ne $lonhost) {
                   if (&Apache::lonnet::hostname($newhost) ne '') {
                       if ($balcookie) {
                           my ($balancer,$cookie) = split(/:/,$balcookie);
                           if ($cookie =~ /^($match_domain)_($match_username)_([a-f0-9]+)$/) {
                               my ($udom,$uname,$cookieid) = ($1,$2,$3);
                               unless (&Apache::lonnet::delbalcookie($cookie,$balancer) eq 'ok') {
                                   if ((-d $lonidsdir) && (opendir(my $dh,$lonidsdir))) {
                                       while (my $filename=readdir($dh)) {
                                           if ($filename=~/^(\Q$uname\E_\d+_\Q$udom\E_$match_lonid)\.id$/) {
                                               my $handle = $1;
                                               my %hash =
                                                   &Apache::lonnet::get_sessionfile_vars($handle,$lonidsdir,
                                                                                        ['request.balancercookie',
                                                                                         'user.linkedenv']);
                                               if ($hash{'request.balancercookie'} eq "$balancer:$cookieid") {
                                                   if (unlink("$lonidsdir/$filename")) {
                                                       if (($hash{'user.linkedenv'} =~ /^[a-f0-9]+_linked$/) &&
                                                           (-l "$lonidsdir/$hash{'user.linkedenv'}.id") &&
                                                           (readlink("$lonidsdir/$hash{'user.linkedenv'}.id") eq "$lonidsdir/$filename")) {
                                                           unlink("$lonidsdir/$hash{'user.linkedenv'}.id");
                                                       }
                                                   }
                                               }
                                               last;
                                           }
                                       }
                                       closedir($dh);
                                   }
                               }
                           }
                       }
                       $output = &redirect_page($newhost,$path);
                   }
               }
           }
       }
       return $output;
   }
   
   sub redirect_page {
       my ($desthost,$path) = @_;
       my $hostname = &Apache::lonnet::hostname($desthost);
       my $protocol = $Apache::lonnet::protocol{$desthost};
       $protocol = 'http' if ($protocol ne 'https');
       unless ($path =~ m{^/}) {
           $path = '/'.$path;
       }
       my $url = $protocol.'://'.$hostname.$path;
       if ($env{'form.firsturl'} ne '') {
           my $querystring;
           if ($env{'form.firsturl'} =~ /[^\x00-\xFF]/) {
               $querystring = &uri_escape_utf8($env{'form.firsturl'});
           } else {
               $querystring = &uri_escape($env{'form.firsturl'});
           }
           $querystring = &HTML::Entities::encode($querystring,"'");
           $url .='?firsturl='.$querystring;
       }
       my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
                                                       {'redirect' => [0,$url],});
       my $end_page   = &Apache::loncommon::end_page();
       return $start_page.$end_page;
   }
   
   sub contactdisplay {
       my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript,$showhelpdesk,
           $possdoms) = @_;
       my $contactblock;
       my $origmail;
       if (ref($possdoms) eq 'ARRAY') {
           if (grep(/^\Q$authdomain\E$/,@{$possdoms})) { 
               $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
           }
       }
       my $requestmail = 
           &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
                                                    $authdomain,$origmail);
       unless ($showhelpdesk eq '0') {
           if ($requestmail =~ m/[^\@]+\@[^\@]+/) {
               $showhelpdesk = 1;
           } else {
               $showhelpdesk = 0;
           }
       }
       if ($servadm && $showadminmail) {
           $contactblock .= $$lt{'servadm'}.':<br />'.
                            '<tt>'.$servadm.'</tt><br />';
       }
       if ($showhelpdesk) {
           $contactblock .= '<a href="javascript:helpdesk()">'.$lt->{'helpdesk'}.'</a><br />';
           my $thisurl = &escape('/adm/login');
           $$helpdeskscript = <<"ENDSCRIPT";
   <script type="text/javascript">
   // <![CDATA[
   function helpdesk() {
       var possdom = document.client.udom.value;
       var codedom = possdom.replace( new RegExp("[^A-Za-z0-9.\\-]","g"),'');
       if (codedom == '') {
           codedom = "$authdomain";
       }
       var querystr = "origurl=$thisurl&codedom="+codedom;
       document.location.href = "/adm/helpdesk?"+querystr;
       return;
   }
   // ]]>
   </script>
   ENDSCRIPT
       }
       return $contactblock;
   }
   
   sub forgotpwdisplay {
       my (%lt) = @_;
       my $prompt_for_resetpw = 1; 
       if ($prompt_for_resetpw) {
           return '<a href="/adm/resetpw">'.$lt{'forgotpw'}.'</a>';
       }
       return;
   }
   
   sub coursecatalog_link {
       my ($linkname) = @_;
       return <<"END";
         <a href="/adm/coursecatalog">$linkname</a>
   END
   }
   
   sub newuser_link {
       my ($linkname) = @_;
       return '<a href="/adm/createaccount">'.$linkname.'</a>';
   }
   
   sub decode_token {
       my ($info) = @_;
       my ($firsturl,@rest)=split(/\&/,$info);
       my %form;
       if ($firsturl ne '') {
           $form{'firsturl'} = &unescape($firsturl);
       }
       foreach my $item (@rest) {
           my ($key,$value) = split(/=/,$item);
           $form{$key} = &unescape($value);
       }
       return %form;
   }
   
 1;  1;
 __END__  __END__
Removed from v.1.14  
changed lines
  Added in v.1.158.2.15

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.