File:  [LON-CAPA] / loncom / auth / lonlogin.pm
Revision 1.138: download - view: text, annotated - select for diffs
Fri May 21 15:54:34 2010 UTC (13 years, 11 months ago) by bisitz
Branches: MAIN
CVS tags: HEAD
Bug 6271, Bug 5577:
Get rid of user authentication image on login page (always use text version)
including all corresponding configuration settings.
Although the user interface is cleaned up and functional, the internal domain configuration cleanup could be improved.

# The LearningOnline Network
# Login Screen
#
# $Id: lonlogin.pm,v 1.138 2010/05/21 15:54:34 bisitz Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# 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
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#

package Apache::lonlogin;

use strict;
use Apache::Constants qw(:common);
use Apache::File ();
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonauth();
use Apache::lonlocal;
use Apache::migrateuser();
use lib '/home/httpd/lib/perl/';
use LONCAPA;
 
sub handler {
    my $r = shift;

    &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']);
    if (!defined($env{'form.firsturl'})) {
        &Apache::lonacc::get_posted_cgi($r,['firsturl']);
    }

# -- check if they are a migrating user
    if (defined($env{'form.token'})) {
	return &Apache::migrateuser::handler($r);
    }

    &Apache::loncommon::no_cache($r);
    &Apache::lonlocal::get_language_handle($r);
    &Apache::loncommon::content_type($r,'text/html');
    $r->send_http_header;
    return OK if $r->header_only;


# Are we re-routing?
    if (-e '/home/httpd/html/lon-status/reroute.txt') {
	&Apache::lonauth::reroute($r);
	return OK;
    }


# -------------------------------- Prevent users from attempting to login twice
    my $handle = &Apache::lonnet::check_for_valid_session($r);
    if ($handle ne '') {
        my $lonidsdir=$r->dir_config('lonIDsDir');
        if ($handle=~/^publicuser\_/) {
# For "public user" - remove it, we apparently really want to login
	    unlink($r->dir_config('lonIDsDir')."/$handle.id");
        } else {
# Indeed, a valid token is found
            &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 = $env{'form.firsturl'}; 
            }
	    $r->print(
                  $start_page
                 .'<h1>'.&mt('You are already logged in!').'</h1>'
                 .'<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'}='';
    }
# ----------------------------------------------------------- Process Interface
    $env{'form.interface'}=~s/\W//g;

    my $httpbrowser=$ENV{"HTTP_USER_AGENT"};

    my $iconpath= 
	&Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));

    my $lonhost = $r->dir_config('lonHostID');
    my $domain = &Apache::lonnet::default_login_domain();
    if ($lonhost ne '') {
        my $redirect = &check_loginvia($domain,$lonhost);
        if ($redirect) {
            $r->print($redirect);
            return OK;
        } 
    }

    if (($env{'form.domain'}) && 
	(&Apache::lonnet::domain($env{'form.domain'},'description'))) {
	$domain=$env{'form.domain'};
    }
    my $role    = $r->dir_config('lonRole');
    my $loadlim = $r->dir_config('lonLoadLim');
    my $servadm = $r->dir_config('lonAdmEMail');
    my $tabdir  = $r->dir_config('lonTabDir');
    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=($env{'form.username'}?$env{'form.username'}:'');
    my $authdomain=($env{'form.domain'}?$env{'form.domain'}:$domain);

# ---------------------------------------------------------- Determine own load
    my $loadavg;
    {
	my $loadfile=Apache::File->new('/proc/loadavg');
	$loadavg=<$loadfile>;
    }
    $loadavg =~ s/\s.*//g;
    my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
    my $userloadpercent=&Apache::lonnet::userload();

# ------------------------------------------------------- Do the load balancing
    my $otherserver= &Apache::lonnet::absolute_url($host_name);
    my $firsturl=
    ($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
# ---------------------------------------------------------- Are we overloaded?
    if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
        my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent);
	if ($unloaded) { $otherserver=$unloaded; }
    }

# ----------------------------------------------------------- Get announcements
    my $announcements=&Apache::lonnet::getannounce();
# -------------------------------------------------------- Set login parameters

    my @hexstr=('0','1','2','3','4','5','6','7',
                '8','9','a','b','c','d','e','f');
    my $lkey='';
    for (0..7) {
        $lkey.=$hexstr[rand(15)];
    }

    my $ukey='';
    for (0..7) {
        $ukey.=$hexstr[rand(15)];
    }

    my $lextkey=hex($lkey);
    if ($lextkey>2147483647) { $lextkey-=4294967296; }

    my $uextkey=hex($ukey);
    if ($uextkey>2147483647) { $uextkey-=4294967296; }

# -------------------------------------------------------- Store away log token
    my $tokenextras;
    if ($env{'form.role'}) {
        $tokenextras = '&role='.&escape($env{'form.role'});
    }
    if ($env{'form.symb'}) {
        if (!$tokenextras) {
            $tokenextras = '&';
        }
        $tokenextras .= '&symb='.&escape($env{'form.symb'});
    }
    my $logtoken=Apache::lonnet::reply(
       'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
       $lonhost);

# ------------------- If we cannot talk to ourselves, we are in serious trouble

    if ($logtoken eq 'con_lost') {
        my $spares='';
	my $last;
        foreach my $hostid (sort
			    {
				&Apache::lonnet::hostname($a) cmp
				    &Apache::lonnet::hostname($b);
			    }
			    keys(%Apache::lonnet::spareid)) {
            next if ($hostid eq $lonhost);
	    my $hostname = &Apache::lonnet::hostname($hostid);
	    next if ($last eq $hostname);
            $spares.='<br /><font size="+1"><a href="http://'.
                $hostname.
                '/adm/login?domain='.$authdomain.'">'.
                $hostname.'</a>'.
                ' '.&mt('(preferred)').'</font>'.$/;
	    $last=$hostname;
        }
$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 || $Apache::lonnet::spareid{$hostid});
    my $hostname = &Apache::lonnet::hostname($hostid);
    next if ($last eq $hostname);
    $spares.='<br /><a href="http://'.
	$hostname.
	'/adm/login?domain='.$authdomain.'">'.
	$hostname.'</a>';
    $last=$hostname;
}
$r->print(
   '<html>'
  .'<head><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" align="right" />'
  .'<h3>'.&mt('This LON-CAPA server is temporarily not available for login.').'</h3>'
  .'<p>'.&mt('Please attempt to login to one of the following servers:').'</p>'
  .$spares
  .'</body>'
  .'</html>'
);
return OK;
}

# ----------------------------------------------- Apparently we are in business
$servadm=~s/\,/\<br \/\>/g;

# ----------------------------------------------------------- Front page design
my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
my $font=&Apache::loncommon::designparm('login.font',$domain);
my $link=&Apache::loncommon::designparm('login.link',$domain);
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='<div>'.&Apache::loncommon::domainlogo($domain).'</div>';
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=&Apache::loncommon::designparm('login.adminmail',$domain);
my $showcoursecat =
&Apache::loncommon::designparm('login.coursecatalog',$domain);
my $shownewuserlink = 
&Apache::loncommon::designparm('login.newuser',$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
    =crypted(this.document.client.elements.upass$now.value.substr(0,15));
this.document.server.elements.upass1.value
    =crypted(this.document.client.elements.upass$now.value.substr(15,15));
this.document.server.elements.upass2.value
    =crypted(this.document.client.elements.upass$now.value.substr(30,15));

this.document.client.elements.uname.value='';
this.document.client.elements.upass$now.value='';

this.document.server.submit();
return false;
}
// ]]>
</script>

ENDSCRIPT

# --------------------------------------------------- Print login screen header

my %add_entries = (
	       bgcolor      => "$mainbg",
	       text         => "$font",
	       link         => "$link",
	       vlink        => "$vlink",
	       alink        => "$alink",);

$r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
			       { 'redirect'       => [$expire,'/adm/roles'], 
				 'add_entries' => \%add_entries,
				 'only_body'   => 1,}));

# ----------------------------------------------------------------------- Texts

my %lt=&Apache::lonlocal::texthash(
          'un'       => 'Username',
          'pw'       => 'Password',
          'dom'      => 'Domain',
          'perc'     => 'percent',
          'load'     => 'Server Load',
          'userload' => 'User Load',
          'catalog'  => 'Course/Community Catalog',
          'log'      => 'Log in',
          'help'     => 'Log-in Help',
          'serv'     => 'Server',
          'servadm'  => 'Server Administration',
          'helpdesk' => 'Contact Helpdesk',
          'forgotpw' => 'Forgot password?',
          'newuser'  => 'New User?',
       );
# -------------------------------------------------- Change password field name

my $forgotpw = &forgotpwdisplay(%lt);
$forgotpw .= '<br />' if $forgotpw;
my $loginhelp = &loginhelpdisplay($authdomain,%lt);
$loginhelp .= '<br />' if $loginhelp;

# ---------------------------------------------------- Serve out DES JavaScript
{
my $jsh=Apache::File->new($include."/londes.js");
$r->print(<$jsh>);
}
# ---------------------------------------------------------- Serve rest of page

$r->print(
    '<div class="LC_Box"'
   .' style="margin:0 auto; padding:10px; width:90%; height: auto; background-color:#FFFFFF;">'
);

#
#  If the loadbalancing yielded just http:// because perhaps there's no loadbalancing?
#  then just us a relative link to authenticate:
#

$r->print(<<ENDSERVERFORM);
<form name="server" action="$otherserver/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);

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" /><br />
  <b><label for="upass$now">$lt{'pw'}</label>:</b><br />
  <input type="password" name="upass$now" id="upass$now" size="15" /><br />
  <b><label for="udom">$lt{'dom'}</label>:</b><br />
  <input type="text" name="udom" id="udom" size="15" value="$authdomain" /><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;">
<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
$domainlogo
</div>
<hr style="clear:both;" />
ENDTOP

$r->print(<<ENDDOCUMENT);
     <table border="0" cellspacing="0" cellpadding="0">
      <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>
      <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>
      <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>
      <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>
      <tr>
       <td colspan="2" align="left">
        <small>$version</small>
       </td>
      </tr>
     </table>
 </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) = @_;
    my $contactblock;
    my $showhelpdesk = 0;
    my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
    if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {
        $showhelpdesk = 1;
    }
    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 codedom = document.client.udom.value;
    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 loginhelpdisplay {
    my ($authdomain,%lt) = @_;
    my $login_help = 1;
    if ($login_help) {
        my $dom = $authdomain;
        if ($dom eq '') {
            $dom = &Apache::lonnet::default_login_domain();
        }
        my %helpconfig = &Apache::lonnet::get_dom('configuration',['helpsettings'],$dom);
        my $loginhelp_url = $helpconfig{'helpsettings'}{'loginhelpurl'};
        if ($loginhelp_url ne '') {
            return '<a href="'.$loginhelp_url.'">'.$lt{'help'}.'</a>';
        } else {
            return '<a href="/adm/loginproblems.html">'.$lt{'help'}.'</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__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>