Diff for /loncom/auth/lonlogin.pm between versions 1.35 and 1.161

version 1.35, 2003/02/19 14:05:28 version 1.161, 2015/03/03 22:06:55
Line 1 Line 1
 # The LearningOnline Network  # The LearningOnline Network
 # Login Screen  # Login Screen
 #  #
 # $Id$  # $Id$
 #  #
 # Copyright Michigan State University Board of Trustees  # Copyright Michigan State University Board of Trustees
 #  #
 # This file is part of the LearningOnline Network with CAPA (LON-CAPA).  # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
 #  #
 # LON-CAPA is free software; you can redistribute it and/or modify  # LON-CAPA is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by  # it under the terms of the GNU General Public License as published by
 # the Free Software Foundation; either version 2 of the License, or  # the Free Software Foundation; either version 2 of the License, or
 # (at your option) any later version.  # (at your option) any later version.
 #  #
 # LON-CAPA is distributed in the hope that it will be useful,  # LON-CAPA is distributed in the hope that it will be useful,
 # but WITHOUT ANY WARRANTY; without even the implied warranty of  # but WITHOUT ANY WARRANTY; without even the implied warranty of
 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 # GNU General Public License for more details.  # GNU General Public License for more details.
 #  #
 # You should have received a copy of the GNU General Public License  # You should have received a copy of the GNU General Public License
 # along with LON-CAPA; if not, write to the Free Software  # along with LON-CAPA; if not, write to the Free Software
 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA  # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #  #
 # /home/httpd/html/adm/gpl.txt  # /home/httpd/html/adm/gpl.txt
 #  #
 # http://www.lon-capa.org/  # http://www.lon-capa.org/
 #  #
 # 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,  package Apache::lonlogin;
 # 1/17/01 Gerd Kortemeyer  
 #  use strict;
 # 2/7/02,2/8,2/12,2/14,2/15,2/19 Josh Brunskole  use Apache::Constants qw(:common);
 #   use Apache::File ();
 # 7/10/02 Jeremy Bowers  use Apache::lonnet;
   use Apache::loncommon();
 package Apache::lonlogin;  use Apache::lonauth();
   use Apache::lonlocal;
 use strict;  use Apache::migrateuser();
 use Apache::Constants qw(:common);  use lib '/home/httpd/lib/perl/';
 use Apache::File ();  use LONCAPA;
 use Apache::lonnet();   
 use Apache::loncommon();  sub handler {
       my $r = shift;
 sub handler {  
     my $r = shift;      &Apache::loncommon::get_unprocessed_cgi
     $r->content_type('text/html');   (join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
     &Apache::loncommon::no_cache($r);        $ENV{'REDIRECT_QUERY_STRING'}),
     $r->send_http_header;   ['interface','username','domain','firsturl','localpath','localres',
     return OK if $r->header_only;    'token','role','symb','iptoken']);
       if (!defined($env{'form.firsturl'})) {
           &Apache::lonacc::get_posted_cgi($r,['firsturl']);
     &Apache::loncommon::get_unprocessed_cgi      }
      ($ENV{'QUERY_STRING'},['interface','username','domain','firsturl']);  
   # -- check if they are a migrating user
 # ----------------------------------------------------------- Process Interface      if (defined($env{'form.token'})) {
     $ENV{'form.interface'}=~s/\W//g;   return &Apache::migrateuser::handler($r);
       }
     my $textbrowsers=$r->dir_config('lonTextBrowsers');  
     my $httpbrowser=$ENV{"HTTP_USER_AGENT"};      &Apache::loncommon::no_cache($r);
           &Apache::lonlocal::get_language_handle($r);
     foreach (split(/\:/,$textbrowsers)) {      &Apache::loncommon::content_type($r,'text/html');
  if ($httpbrowser=~/$_/i) {      $r->send_http_header;
     $ENV{'form.interface'}='textual';      return OK if $r->header_only;
         }  
     }  
   # Are we re-routing?
     my $fullgraph=($ENV{'form.interface'} ne 'textual');      my $londocroot = $r->dir_config('lonDocRoot');
       if (-e "$londocroot/lon-status/reroute.txt") {
     my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':8080'.   &Apache::lonauth::reroute($r);
                   $r->dir_config('lonIconsURL');   return OK;
     my $domain  = $r->dir_config('lonDefDomain');      }
     my $role    = $r->dir_config('lonRole');  
     my $loadlim = $r->dir_config('lonLoadLim');      $env{'form.firsturl'} =~ s/(`)/'/g;
     my $servadm = $r->dir_config('lonAdmEMail');  
     my $sysadm  = $r->dir_config('lonSysEMail');  # -------------------------------- Prevent users from attempting to login twice
     my $lonhost = $r->dir_config('lonHostID');      my $handle = &Apache::lonnet::check_for_valid_session($r);
     my $tabdir  = $r->dir_config('lonTabDir');      if ($handle ne '') {
     my $include = $r->dir_config('lonIncludes');          my $lonidsdir=$r->dir_config('lonIDsDir');
           if ($handle=~/^publicuser\_/) {
 # --------------------------------------------- Default values for login fields  # For "public user" - remove it, we apparently really want to login
       unlink($r->dir_config('lonIDsDir')."/$handle.id");
     my $authusername=($ENV{'form.username'}?$ENV{'form.username'}:'');          } else {
     my $authdomain=($ENV{'form.domain'}?$ENV{'form.domain'}:$domain);  # Indeed, a valid token is found
               &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
 # ---------------------------------------------------------- Determine own load      my $start_page =
     my $loadavg;          &Apache::loncommon::start_page('Already logged in');
    {      my $end_page =
        my $loadfile=Apache::File->new('/proc/loadavg');          &Apache::loncommon::end_page();
        $loadavg=<$loadfile>;              my $dest = '/adm/roles';
    }              if ($env{'form.firsturl'} ne '') {
     $loadavg =~ s/\s.*//g;                  $dest = $env{'form.firsturl'};
     my $loadpercent=100*$loadavg/$loadlim;              }
       $r->print(
 # ------------------------------------------------------- Do the load balancing                    $start_page
     my $otherserver='http://'.$ENV{'SERVER_NAME'};                   .'<p class="LC_warning">'.&mt('You are already logged in!').'</p>'
     my $firsturl=                   .'<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
     ($ENV{'request.firsturl'}?$ENV{'request.firsturl'}:$ENV{'form.firsturl'});                    '<a href="'.$dest.'">','</a>','<a href="/adm/logout">','</a>').'</p>'
 # ---------------------------------------- Are we access server and overloaded?                   .$end_page
     if (($role eq 'access') && ($loadpercent>100.0)) {                   );
         $otherserver=Apache::lonnet::spareserver($loadpercent);              return OK;
     }          }
       }
 # -------------------------------------------------------- Set login parameters  
   # ---------------------------------------------------- No valid token, continue
     my @hexstr=('0','1','2','3','4','5','6','7',  
                 '8','9','a','b','c','d','e','f');  # ---------------------------- Not possible to really login to domain "public"
     my $lkey='';      if ($env{'form.domain'} eq 'public') {
     for (0..7) {   $env{'form.domain'}='';
         $lkey.=$hexstr[rand(15)];   $env{'form.username'}='';
     }      }
   
     my $ukey='';  # ------ Is this page requested because /adm/migrateuser detected an IP change?
     for (0..7) {      my %sessiondata;
         $ukey.=$hexstr[rand(15)];      if ($env{'form.iptoken'}) {
     }          %sessiondata = &Apache::lonnet::tmpget($env{'form.iptoken'});
           my $delete = &Apache::lonnet::tmpdel($env{'form.token'});
     my $lextkey=hex($lkey);      }
     if ($lextkey>2147483647) { $lextkey-=4294967296; }  # ----------------------------------------------------------- Process Interface
       $env{'form.interface'}=~s/\W//g;
     my $uextkey=hex($ukey);  
     if ($uextkey>2147483647) { $uextkey-=4294967296; }      (undef,undef,undef,undef,undef,undef,my $clientmobile) =
           &Apache::loncommon::decode_user_agent();
 # -------------------------------------------------------- Store away log token  
     my $logtoken=Apache::lonnet::reply(      my $iconpath=
        'tmpput:'.$ukey.$lkey.'&'.$firsturl,   &Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
        $lonhost);  
       my $lonhost = $r->dir_config('lonHostID');
 # ------------------- If we cannot talk to ourselves, we are in serious trouble      my $domain = &Apache::lonnet::default_login_domain();
       my $defdom = $domain;
     if ($logtoken eq 'con_lost') {      if ($lonhost ne '') {
         my $spares='';          unless ($sessiondata{'sessionserver'}) {
         foreach (keys %Apache::lonnet::hostname) {              my $redirect = &check_loginvia($domain,$lonhost);
             if ($_ ne $lonhost) {              if ($redirect) {
                $spares.='<br /><a href="http://'.$Apache::lonnet::hostname{$_}.                  $r->print($redirect);
  '/adm/login?domain='.$authdomain.'">'.                  return OK;
                  $Apache::lonnet::hostname{$_}.'</a>';              }
                if ($Apache::lonnet::spareid{$_}) {          }
    $spares.=' (preferred)';      }
                }  
    }      if (($sessiondata{'domain'}) &&
         }          (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
  $r->print(<<ENDTROUBLE);          $domain=$sessiondata{'domain'};
 <html>      } elsif (($env{'form.domain'}) &&
 <head><title>The LearningOnline Network with CAPA</title></head>   (&Apache::lonnet::domain($env{'form.domain'},'description'))) {
 <body bgcolor="#FFFFFF">   $domain=$env{'form.domain'};
 <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      my $role    = $r->dir_config('lonRole');
 <p>If the problem persists, please contact <tt>$servadm</tt>.</p>      my $loadlim = $r->dir_config('lonLoadLim');
 </body>      my $uloadlim= $r->dir_config('lonUserLoadLim');
 </html>      my $servadm = $r->dir_config('lonAdmEMail');
 ENDTROUBLE      my $tabdir  = $r->dir_config('lonTabDir');
         return OK;      my $include = $r->dir_config('lonIncludes');
     }      my $expire  = $r->dir_config('lonExpire');
       my $version = $r->dir_config('lonVersion');
 # ----------------------------------------------- Apparently we are in business      my $host_name = &Apache::lonnet::hostname($lonhost);
   
     my $domainlogo=&Apache::loncommon::domainlogo();  # --------------------------------------------- Default values for login fields
 # --------------------------------------------------- Print login screen header     
     $r->print(<<ENDHEADER);      my ($authusername,$authdomain);
 <html>      if ($sessiondata{'username'}) {
 <head>          $authusername=$sessiondata{'username'};
 <title>The LearningOnline Network with CAPA Login</title>      } else {
 </head>          $env{'form.username'} = &Apache::loncommon::cleanup_html($env{'form.username'});
 ENDHEADER          $authusername=($env{'form.username'}?$env{'form.username'}:'');
 # ---------------------------------------------------- Serve out DES JavaScript      }
     {      if ($sessiondata{'domain'}) {
  my $jsh=Apache::File->new($include."/londes.js");          $authdomain=$sessiondata{'domain'};
         $r->print(<$jsh>);      } else {
     }          $env{'form.domain'} = &Apache::loncommon::cleanup_html($env{'form.domain'});
           $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);
 # ----------------------------------------------------------- Front page design      }
     my $pgbg=  
       ($fullgraph?&Apache::loncommon::designparm('login.pgbg'):'#FFFFFF');  # ---------------------------------------------------------- Determine own load
     my $font=      my $loadavg;
       ($fullgraph?&Apache::loncommon::designparm('login.font'):'#000000');      {
     my $link=   my $loadfile=Apache::File->new('/proc/loadavg');
       ($fullgraph?&Apache::loncommon::designparm('login.link'):'#0000FF');   $loadavg=<$loadfile>;
     my $vlink=      }
       ($fullgraph?&Apache::loncommon::designparm('login.vlink'):'#0000FF');      $loadavg =~ s/\s.*//g;
     my $alink=&Apache::loncommon::designparm('login.alink');  
     my $mainbg=      my ($loadpercent,$userloadpercent);
       ($fullgraph?&Apache::loncommon::designparm('login.mainbg'):'#FFFFFF');      if ($loadlim) {
     my $sidebg=          $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
       ($fullgraph?&Apache::loncommon::designparm('login.sidebg'):'#FFFFFF');      }
     my $logo=&Apache::loncommon::designparm('login.logo');      if ($uloadlim) {
     my $img=&Apache::loncommon::designparm('login.img');          $userloadpercent=&Apache::lonnet::userload();
       }
   
 # ---------------------------------------------------------- Serve rest of page      my $firsturl=
     $r->print(<<ENDSCRIPT);      ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
   
 <body bgcolor="$pgbg" text="$font" link="$link" vlink="$vlink" alink="$alink"  # ----------------------------------------------------------- Get announcements
   topmargin=0 leftmargin=0 marginwidth=0 marginheight=0>      my $announcements=&Apache::lonnet::getannounce();
   # -------------------------------------------------------- Set login parameters
  <script language="JavaScript">  
     function send()      my @hexstr=('0','1','2','3','4','5','6','7',
     {                  '8','9','a','b','c','d','e','f');
  this.document.server.elements.uname.value      my $lkey='';
        =this.document.client.elements.uname.value;      for (0..7) {
           $lkey.=$hexstr[rand(15)];
         this.document.server.elements.udom.value      }
        =this.document.client.elements.udom.value;  
       my $ukey='';
         this.document.server.elements.imagesuppress.value      for (0..7) {
        =this.document.client.elements.imagesuppress.value;          $ukey.=$hexstr[rand(15)];
       }
         this.document.server.elements.embedsuppress.value  
        =this.document.client.elements.embedsuppress.value;      my $lextkey=hex($lkey);
       if ($lextkey>2147483647) { $lextkey-=4294967296; }
         this.document.server.elements.appletsuppress.value  
        =this.document.client.elements.appletsuppress.value;      my $uextkey=hex($ukey);
       if ($uextkey>2147483647) { $uextkey-=4294967296; }
         this.document.server.elements.fontenhance.value  
        =this.document.client.elements.fontenhance.value;  # -------------------------------------------------------- Store away log token
       my $tokenextras;
         this.document.server.elements.blackwhite.value      if ($env{'form.role'}) {
        =this.document.client.elements.blackwhite.value;          $tokenextras = '&role='.&escape($env{'form.role'});
       }
         this.document.server.elements.remember.value      if ($env{'form.symb'}) {
        =this.document.client.elements.remember.value;          if (!$tokenextras) {
               $tokenextras = '&';
         uextkey=this.document.client.elements.uextkey.value;          }
         lextkey=this.document.client.elements.lextkey.value;          $tokenextras .= '&symb='.&escape($env{'form.symb'});
         initkeys();      }
       my $logtoken=Apache::lonnet::reply(
         this.document.server.elements.upass.value         'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
     =crypted(this.document.client.elements.upass.value);         $lonhost);
   
         this.document.server.submit();  # -- If we cannot talk to ourselves, or hostID does not map to a hostname
  return false;  #    we are in serious trouble
     }  
  </script>      if (($logtoken eq 'con_lost') || ($logtoken eq 'no_such_host')) {
 ENDSCRIPT          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 ($fullgraph) {          }
  $r->print(          my $spares='';
   '<table width="100%" cellpadding=0 cellspacing=0 border=0>');   my $last;
     }          foreach my $hostid (sort
       {
     $r->print(<<ENDSERVERFORM);   &Apache::lonnet::hostname($a) cmp
   <form name="server" action="$otherserver/adm/authenticate" method="post" target="_top">      &Apache::lonnet::hostname($b);
    <input type="hidden" name="logtoken" value="$logtoken" />      }
    <input type="hidden" name="serverid" value="$lonhost" />      keys(%Apache::lonnet::spareid)) {
    <input type="hidden" name="interface" value="$ENV{'form.interface'}" />              next if ($hostid eq $lonhost);
    <input type="hidden" name="uname" value="" />      my $hostname = &Apache::lonnet::hostname($hostid);
    <input type="hidden" name="upass" value="" />      next if (($last eq $hostname) || ($hostname eq ''));
    <input type="hidden" name="udom" value="" />              $spares.='<br /><font size="+1"><a href="http://'.
    <input type="hidden" name="imagesuppress"  value="" />                  $hostname.
    <input type="hidden" name="appletsuppress"  value="" />                  '/adm/login?domain='.$authdomain.'">'.
    <input type="hidden" name="embedsuppress"  value="" />                  $hostname.'</a>'.
    <input type="hidden" name="fontenhance"  value="" />                  ' '.&mt('(preferred)').'</font>'.$/;
    <input type="hidden" name="blackwhite"  value="" />      $last=$hostname;
    <input type="hidden" name="remember"  value="" />          }
   </form>          if ($spares) {
 ENDSERVERFORM              $spares.= '<br />';
     if ($fullgraph) { $r->print(<<ENDTOP);          }
   <!-- The LON-CAPA Header -->          my %all_hostnames = &Apache::lonnet::all_hostnames();
   <tr>          foreach my $hostid (sort
       {
    <!-- Row 1 Columns 2-4 -->   &Apache::lonnet::hostname($a) cmp
    <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>      &Apache::lonnet::hostname($b);
   </tr>      }
       keys(%all_hostnames)) {
   <!-- The gray bar that starts the two table frames -->              next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});
   <tr>              my $hostname = &Apache::lonnet::hostname($hostid);
               next if (($last eq $hostname) || ($hostname eq ''));
    <!-- Row 2 Column 1 -->              $spares.='<br /><a href="http://'.
    <td width=182 height=27 bgcolor="$sidebg">&nbsp;</td>               $hostname.
                '/adm/login?domain='.$authdomain.'">'.
    <!-- Row 2 Column 2 -->               $hostname.'</a>';
    <td width=27 height=27 align="left" background="$iconpath/filltop.gif"><img src="$iconpath/upperleft.gif" border=0 alt="" /></td>              $last=$hostname;
            }
    <!-- Row 2 Column 3 -->           $r->print(
    <td height=27 background="$iconpath/filltop.gif"><img src="$iconpath/filltop.gif" alt="" /></td>     '<html>'
     .'<head><title>'
    <!-- Row 2 Column 4 -->    .&mt('The LearningOnline Network with CAPA')
    <td width=27 height=27 align="right" background="$iconpath/filltop.gif"><img src="$iconpath/upperright.gif" border=0 alt="" /></td>    .'</title></head>'
   </tr>    .'<body bgcolor="#FFFFFF">'
   <tr>    .'<h1>'.&mt('The LearningOnline Network with CAPA').'</h1>'
        .'<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />'
    <!-- A cell that will hold the 'access' and 'about' buttons -->    .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>');
    <!-- Row 3 Column 1 -->          if ($spares) {
    <td valign="top" height=60 align="center" bgcolor="$sidebg">              $r->print('<p>'.&mt('Please attempt to login to one of the following servers:')
     <a href="/adm/login?interface=textual"><img src="$iconpath/accessbutton.gif" border=0 alt="Accessibility Options" /></a>                       .'</p>'
     <br />                       .$spares);
     <a href="/adm/about.html"><img src="$iconpath/aboutlon.gif" border=0 alt="About LON-CAPA" /></a>          }
    </td>          $r->print('</body>'
                    .'</html>'
    <!-- The shaded space between the two main columns -->          );
    <!-- Row 3 Column 2 -->          return OK;
    <td width=27 height=60 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>      }
   
    <!-- The right main column holding the large LON-CAPA logo-->  # ----------------------------------------------- Apparently we are in business
    <!-- Rows 3-4 Column 3 -->      $servadm=~s/\,/\<br \/\>/g;
    <td align="center" valign="top" width="100%" height="100%" rowspan=2 bgcolor="$mainbg">  
     <center>  # ----------------------------------------------------------- Front page design
      <img src="$logo" alt="" />      my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
     </center>      my $font=&Apache::loncommon::designparm('login.font',$domain);
    </td>      my $link=&Apache::loncommon::designparm('login.link',$domain);
       my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
    <!-- Row 3 Column 4 -->      my $alink=&Apache::loncommon::designparm('login.alink',$domain);
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>      my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
   </tr>      my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
   <tr>      my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
       my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
    <!-- The entry form -->      my $logo=&Apache::loncommon::designparm('login.logo',$domain);
    <!-- Row 4 Column 1 -->      my $img=&Apache::loncommon::designparm('login.img',$domain);
    <td align="center" valign="middle" bgcolor="$sidebg">      my $domainlogo=&Apache::loncommon::domainlogo($domain);
 ENDTOP      my $showbanner = 1;
 } else {      my $showmainlogo = 1;
     $r->print('<h1>The Learning<i>Online</i> Network with CAPA</h1><h2>Text-based Interface Login</h2>');      if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
 }          $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
     $r->print('<form name="client" onsubmit="return(send())">');      }
     unless ($fullgraph) {      if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
         $r->print(<<ENDACCESSOPTIONS);          $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
 <h3>Select Accessibility Options</h3>      }
 <input type="checkbox" name="imagesuppress" /> Suppress rendering of images<br />      my $showadminmail;
 <input type="checkbox" name="appletsuppress" /> Suppress Java applets<br />      my @possdoms = &Apache::lonnet::current_machine_domains();
 <input type="checkbox" name="embedsuppress" /> Suppress rendering of embedded multimedia<br />      if (grep(/^\Q$domain\E$/,@possdoms)) {
 <input type="checkbox" name="fontenhance" /> Increase font size<br />          $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
 <input type="checkbox" name="blackwhite" /> Switch to black and white mode<br />      }
 <p>If you have accessibility needs that are not addressed by this interface,       my $showcoursecat =
 please          &Apache::loncommon::designparm('login.coursecatalog',$domain);
 contact the system administrator at <tt>$sysadm</tt>.</p><br />      my $shownewuserlink =
 <input type="checkbox" name="remember" /> Remember these settings for next login<hr />          &Apache::loncommon::designparm('login.newuser',$domain);
 ENDACCESSOPTIONS      my $showhelpdesk =
 } else {          &Apache::loncommon::designparm('login.helpdesk',$domain);
     $r->print(<<ENDNOOPT);      my $now=time;
 <input type="hidden" name="imagesuppress"  value="" />      my $js = (<<ENDSCRIPT);
 <input type="hidden" name="embedsuppress"  value="" />  
 <input type="hidden" name="appletsuppress"  value="" />  <script type="text/javascript" language="JavaScript">
 <input type="hidden" name="fontenhance"  value="" />  // <![CDATA[
 <input type="hidden" name="blackwhite"  value="" />  function send()
 <input type="hidden" name="remember"  value="" />  {
 ENDNOOPT  this.document.server.elements.uname.value
 }  =this.document.client.elements.uname.value;
     $r->print(<<ENDLOGIN);  
      <input type="hidden" name="lextkey" value="$lextkey">  this.document.server.elements.udom.value
      <input type="hidden" name="uextkey" value="$uextkey">  =this.document.client.elements.udom.value;
   
      <!-- Start the sub-table for text and input alignment -->  uextkey=this.document.client.elements.uextkey.value;
      <table border=0 cellspacing=0 cellpadding=0>  lextkey=this.document.client.elements.lextkey.value;
       <tr><td bgcolor="$sidebg" colspan=2><img src="$iconpath/userauthentication.gif" alt="User Authentication" /></td></tr>  initkeys();
       <tr>  
        <td bgcolor="$mainbg"><br /><font size=-1><b>&nbsp;&nbsp;&nbsp;User Name:</b></font></td>  this.document.server.elements.upass0.value
        <td bgcolor="$mainbg"><br /><input type="text" name="uname" size="10" value="$authusername" /></td>      =this.document.client.elements.upass$now.value.substr(0,15);
       </tr>  this.document.server.elements.upass1.value
       <tr>      =this.document.client.elements.upass$now.value.substr(15,15);
        <td bgcolor="$mainbg"><font size=-1><b>&nbsp;&nbsp;&nbsp;Password:</b></font></td>  this.document.server.elements.upass2.value
        <td bgcolor="$mainbg"><input type="password" name="upass" size="10" /></td>      =this.document.client.elements.upass$now.value.substr(30,15);
       </tr>  
       <tr>  if(this.document.server.action.substr(0,5) === 'http:'){
        <td bgcolor="$mainbg"><font size=-1><b>&nbsp;&nbsp;&nbsp;Domain:</b></font></td>      for (var idx in [1,2,3]){
        <td bgcolor="$mainbg"><input type="text" name="udom" size="10" value="$authdomain" /></td>          this.document.server.elements['upass' + idx].value =
       </tr>              crypted(this.document.server.elements['upass' + idx].value);
       <tr>      }
        <td bgcolor="$mainbg">&nbsp;&nbsp;&nbsp;<a href="/adm/loginproblems.html">Help</a></td>  }
        <td bgcolor="$mainbg" valign="bottom" align="center">  
         <br />  this.document.client.elements.uname.value='';
         <input type="submit" value="Log In" />  this.document.client.elements.upass$now.value='';
        </td>  
       </tr>  this.document.server.submit();
      </table>  return false;
      <!-- End sub-table -->  }
     </form>  
 ENDLOGIN  function enableInput() {
     if ($fullgraph) {      this.document.client.elements.upass$now.removeAttribute("readOnly");
  $r->print(<<ENDDOCUMENT);      this.document.client.elements.uname.removeAttribute("readOnly");
    </td>      this.document.client.elements.udom.removeAttribute("readOnly");
       return;
    <!-- Row 4 Column 2 -->  }
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>  
   // ]]>
    <!-- Row 4 Column 4 -->  </script>
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>  
   </tr>  ENDSCRIPT
   <tr>  
   # --------------------------------------------------- Print login screen header
    <!-- Row 5 Column 1 -->  
    <td bgcolor="$sidebg" valign="middle" align="left">      my %add_entries = (
      <br />         bgcolor      => "$mainbg",
      <table border=0 cellspacing=0 cellpadding=0>         text         => "$font",
       <tr>         link         => "$link",
        <td bgcolor="$sidebg" align="left" valign="top">         vlink        => "$vlink",
         <small><b>&nbsp;&nbsp;&nbsp;Domain:&nbsp;</b></small>         alink        => "$alink",
        </td>                 onload       => 'javascript:enableInput();',);
        <td bgcolor="$sidebg" align="left" valign="top">  
         <small><tt>&nbsp;$domain</tt></small>      my %defaultdomconf = &Apache::loncommon::get_domainconf($defdom);
        </td>      my $headextra = $defaultdomconf{$defdom.'.login.headtag_'.$lonhost};
       </tr>      my $headextra_exempt = $defaultdomconf{$domain.'.login.headtag_exempt_'.$lonhost};
       <tr>      if ($headextra) {
        <td bgcolor="$sidebg" align="left" valign="top">          my $omitextra;
         <small><b>&nbsp;&nbsp;&nbsp;Server:&nbsp;</b></small>          if ($headextra_exempt ne '') {
        </td>              my @exempt = split(',',$headextra_exempt);
        <td bgcolor="$sidebg" align="left" valign="top">              my $ip = $ENV{'REMOTE_ADDR'};
         <small><tt>&nbsp;$lonhost ($role)</tt></small>              if (grep(/^\Q$ip\E$/,@exempt)) {
        </td>                  $omitextra = 1;
       </tr>              }
       <tr>          }
        <td bgcolor="$sidebg" align="left" valign="top">          unless ($omitextra) {
         <small><b>&nbsp;&nbsp;&nbsp;Load:&nbsp;</b></small>              my $confname = $defdom.'-domainconfig';
        </td>              if ($headextra =~ m{^\Q/res/$defdom/$confname/login/headtag/$lonhost/\E}) {
        <td bgcolor="$sidebg" align="left" valign="top">                  my $extra = &Apache::lonnet::getfile(&Apache::lonnet::filelocation("",$headextra));
         <small><tt>&nbsp;$loadpercent percent</tt></small>                  unless ($extra eq '-1') {
        </td>                      $js .= "\n".$extra."\n";
       </tr>                  }
      </table>              }
      <br />          }
     <small>      }
      <b>&nbsp;&nbsp;&nbsp;System Administration:</b><br />  
      <tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$sysadm</tt><br />      $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
      <b>&nbsp;&nbsp;&nbsp;Server Administration:</b><br />         { 'redirect'       => [$expire,'/adm/roles'],
      <tt>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$servadm<br />&nbsp;</tt>   'add_entries' => \%add_entries,
     </small>   'only_body'   => 1,}));
    </td>  
   # ----------------------------------------------------------------------- Texts
    <!-- Row 5 Column 2 -->  
    <td width=27 background="$iconpath/fillleft.gif"><img src="$iconpath/fillleft.gif" alt="" /></td>      my %lt=&Apache::lonlocal::texthash(
             'un'       => 'Username',
    <!-- Row 5 Column 3 -->            'pw'       => 'Password',
    <td width="100%" valign="bottom" bgcolor="$mainbg">            'dom'      => 'Domain',
 $domainlogo            'perc'     => 'percent',
 </td>            'load'     => 'Server Load',
             'userload' => 'User Load',
    <!-- Row 5 Column 4 -->            'catalog'  => 'Course/Community Catalog',
    <td width=27 background="$iconpath/fillright.gif"><img src="$iconpath/fillright.gif" alt="" /></td>            'log'      => 'Log in',
   </tr>            'help'     => 'Log-in Help',
   <tr>            'serv'     => 'Server',
             'servadm'  => 'Server Administration',
    <!-- Row 6 Column 1 -->            'helpdesk' => 'Contact Helpdesk',
    <td bgcolor="$sidebg">&nbsp;</td>            'forgotpw' => 'Forgot password?',
             'newuser'  => 'New User?',
    <!-- Row 6 Column 2 -->         );
    <td align="left" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerleft.gif" alt="" /></td>  # -------------------------------------------------- Change password field name
   
    <!-- Row 6 Column 3 -->      my $forgotpw = &forgotpwdisplay(%lt);
    <td background="$iconpath/fillbottom.gif"><img src="$iconpath/fillbottom.gif" alt="" /></td>      $forgotpw .= '<br />' if $forgotpw;
       my $loginhelp = &Apache::lonauth::loginhelpdisplay($authdomain);
    <!-- Row 6 Column 4 -->      if ($loginhelp) {
    <td align="right" background="$iconpath/fillbottom.gif"><img src="$iconpath/lowerright.gif" alt="" /></td>          $loginhelp = '<a href="'.$loginhelp.'">'.$lt{'help'}.'</a><br />';
   </tr>      }
  </table>  
   # ---------------------------------------------------- Serve out DES JavaScript
 <script>      {
 // the if prevents the script error if the browser can't handle this      my $jsh=Apache::File->new($include."/londes.js");
 if ( document.client.uname ) { document.client.uname.focus(); }      $r->print(<$jsh>);
 </script>      }
   # ---------------------------------------------------------- Serve rest of page
 ENDDOCUMENT  
 }      $r->print(
     $r->print('</body></html>');      '<div class="LC_Box"'
     return OK;     .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
 }   );
   
 1;      $r->print(<<ENDSERVERFORM);
 __END__  <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="upass1" value="" />
      <input type="hidden" name="upass2" value="" />
      <input type="hidden" name="udom" value="" />
      <input type="hidden" name="localpath" value="$env{'form.localpath'}" />
      <input type="hidden" name="localres" value="$env{'form.localres'}" />
     </form>
   ENDSERVERFORM
       my $coursecatalog;
       if (($showcoursecat eq '') || ($showcoursecat)) {
           $coursecatalog = &coursecatalog_link($lt{'catalog'}).'<br />';
       }
       my $newuserlink;
       if ($shownewuserlink) {
           $newuserlink = &newuser_link($lt{'newuser'}).'<br />';
       }
       my $logintitle =
           '<h2 class="LC_hcell"'
          .' style="background:'.$loginbox_header_bgcol.';'
          .' color:'.$loginbox_header_textcol.'">'
          .$lt{'log'}
          .'</h2>';
   
       my $noscript_warning='<noscript><span class="LC_warning"><b>'
                           .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
                           .'</b></span></noscript>';
       my $helpdeskscript;
       my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
                                          $authdomain,\$helpdeskscript,
                                          $showhelpdesk,\@possdoms);
   
       my $mobileargs;
       if ($clientmobile) {
           $mobileargs = 'autocapitalize="off" autocorrect="off"';
       }
       my $loginform=(<<LFORM);
   <form name="client" action="" onsubmit="return(send())">
     <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) {
           $r->print(<<HEADER);
   <!-- The LON-CAPA Header -->
   <div style="background:$pgbg;margin:0;width:100%;">
     <img src="$img" border="0" alt="The Learning Online Network with CAPA" />
   </div>
   HEADER
       }
       $r->print(<<ENDTOP);
   <div style="float:left;margin-top:0;">
   <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>
   
   <div>
   ENDTOP
       if ($showmainlogo) {
           $r->print(' <img src="'.$logo.'" alt="" />'."\n");
       }
   $r->print(<<ENDTOP);
   $announcements
   </div>
   <hr style="clear:both;" />
   ENDTOP
       my ($domainrow,$serverrow,$loadrow,$userloadrow,$versionrow);
       $domainrow = <<"END";
         <tr>
          <td  align="left" valign="top">
           <small><b>$lt{'dom'}:&nbsp;</b></small>
          </td>
          <td  align="left" valign="top">
           <small><tt>&nbsp;$domain</tt></small>
          </td>
         </tr>
   END
       $serverrow = <<"END";
         <tr>
          <td  align="left" valign="top">
           <small><b>$lt{'serv'}:&nbsp;</b></small>
          </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$lonhost ($role)</tt></small>
          </td>
         </tr>
   END
       if ($loadlim) {
           $loadrow = <<"END";
         <tr>
          <td align="left" valign="top">
           <small><b>$lt{'load'}:&nbsp;</b></small>
          </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$loadpercent $lt{'perc'}</tt></small>
          </td>
         </tr>
   END
       }
       if ($uloadlim) {
           $userloadrow = <<"END";
         <tr>
          <td align="left" valign="top">
           <small><b>$lt{'userload'}:&nbsp;</b></small>
          </td>
          <td align="left" valign="top">
           <small><tt>&nbsp;$userloadpercent $lt{'perc'}</tt></small>
          </td>
         </tr>
   END
       }
       if (($version ne '') && ($version ne '<!-- VERSION -->')) {
           $versionrow = <<"END";
         <tr>
          <td colspan="2" align="left">
           <small>$version</small>
          </td>
         </tr>
   END
       }
   
       $r->print(<<ENDDOCUMENT);
       <div style="float: left;">
        <table border="0" cellspacing="0" cellpadding="0">
   $domainrow
   $serverrow
   $loadrow    
   $userloadrow
   $versionrow
        </table>
       </div>
       <div style="float: right;">
       $domainlogo
       </div>
       <br style="clear:both;" />
    </div>
   
   <script type="text/javascript">
   // <![CDATA[
   // the if prevents the script error if the browser can not handle this
   if ( document.client.uname ) { document.client.uname.focus(); }
   // ]]>
   </script>
   $helpdeskscript
   
   ENDDOCUMENT
       my %endargs = ( 'noredirectlink' => 1, );
       $r->print(&Apache::loncommon::end_page(\%endargs));
       return OK;
   }
   
   sub check_loginvia {
       my ($domain,$lonhost) = @_;
       if ($domain eq '' || $lonhost 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 = $ENV{'REMOTE_ADDR'};
           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 '') {
                       $output = &redirect_page($newhost,$path);
                   }
               }
           }
       }
       return $output;
   }
   
   sub redirect_page {
       my ($desthost,$path) = @_;
       my $protocol = $Apache::lonnet::protocol{$desthost};
       $protocol = 'http' if ($protocol ne 'https');
       unless ($path =~ m{^/}) {
           $path = '/'.$path;
       }
       my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;
       if ($env{'form.firsturl'} ne '') {
           $url .='?firsturl='.$env{'form.firsturl'};
       }
       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>';
   }
   
   1;
   __END__

Removed from v.1.35  
changed lines
  Added in v.1.161


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.