[BACK]Return to lonauth.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / auth
File:  [LON-CAPA] / loncom / auth / lonauth.pm
Revision 1.26: download - view: text, annotated - select for diffs
Mon Oct 8 22:37:50 2001 UTC (22 years, 8 months ago) by harris41
Branches: MAIN
CVS tags: stable_2001_fall, HEAD
making backwards compatible with old Crypt::DES

# The LearningOnline Network
# User Authentication Module
# 5/21/99,5/22,5/25,5/26,5/27,5/29,6/2,6/11,6/14,6/15
# 16/11,12/16,
# 1/14,2/24,2/28,2/29,3/7,5/29,5/30,5/31,6/1,6/5,6/29,
# 7/1,7/10,10/2,10/5,10/9,10/26,10/30,11/10,
# 05/28,05/29 Gerd Kortemeyer
# 07/24 Scott Harrison
# 07/28,08/03 Gerd Kortemeyer
# 8/15 Scott Harrison
# 8/20 Gerd Kortemeyer

package Apache::lonauth;

use strict;
use Apache::Constants qw(:common);
use Apache::File;
use CGI qw(:standard);
use CGI::Cookie();
use DynaLoader; # for Crypt::DES version
use Crypt::DES;
use Apache::lonnet();
use Apache::lonmenu();
use Fcntl qw(:flock);
# ------------------------------------------------------------ Successful login

sub success {
    my ($r, $username, $domain, $authhost,$lowerurl) = @_;
    my $lonids=$r->dir_config('lonIDsDir');

# See if old ID present, if so, remove

    my $filename;
    opendir(DIR,$lonids);
    while ($filename=readdir(DIR)) {
       if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
	  unlink($lonids.'/'.$filename);
       }
    }
    closedir(DIR);

# Give them a new cookie

    my $cookie;
    my $now=time;
    $cookie="$username\_$now\_$domain\_$authhost";

# Initialize roles

    my $userroles=Apache::lonnet::rolesinit($domain,$username,$authhost);

# ------------------------------------ Check browser type and MathML capability

    my @browsertype=split(/\&/,$r->dir_config("lonBrowsDet"));
    my %mathcap=split(/\&/,$r->dir_config("lonMathML"));
    my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
    my $i;
    my $clientbrowser='unknown';
    my $clientversion='0';
    my $clientmathml='';
    for ($i=0;$i<=$#browsertype;$i++) {
        my ($bname,$match,$notmatch,$vreg,$minv)=split(/\:/,$browsertype[$i]);
	if (($httpbrowser=~/$match/i)  && ($httpbrowser!~/$notmatch/i)) {
	    $clientbrowser=$bname;
            $httpbrowser=~/$vreg/i;
	    $clientversion=$1;
            $clientmathml=($clientversion>=$minv);
        }
    }
    my $clientos='unknown';
    if (($httpbrowser=~/linux/i) ||
        ($httpbrowser=~/unix/i) ||
        ($httpbrowser=~/ux/i) ||
        ($httpbrowser=~/solaris/i)) { $clientos='unix'; }
    if (($httpbrowser=~/vax/i) ||
        ($httpbrowser=~/vms/i)) { $clientos='vms'; }
    if ($httpbrowser=~/next/i) { $clientos='next'; }
    if (($httpbrowser=~/mac/i) ||
        ($httpbrowser=~/powerpc/i)) { $clientos='mac'; }
    if ($httpbrowser=~/win/i) { $clientos='win'; }

# ------------------------------------------------------------- Get environment

    my $userenv=Apache::lonnet::reply("dump:$domain:$username:environment",
                                      $authhost);
    if (($userenv eq 'con_lost') || 
        ($userenv =~ /^error\:/)) {
        $userenv='';
    }
    $userenv=~s/\&/\nenvironment\./g;
    if ($userenv ne '') {
	$userenv='environment.'.$userenv;
    }
# --------------------------------------------------------- Write first profile

       {
	    my $idf=Apache::File->new(">$lonids/$cookie.id");
	    unless (flock($idf,LOCK_EX)) {
	      &Apache::lonnet::logthis("<font color=blue>WARNING: ".
			    'Could not obtain exclusive lock in lonauth: '.$!);
	      $idf->close();
	      return 'error: '.$!;
	    }
            if ($userenv ne '') { print $idf "$userenv\n"; }
            print $idf "user.name=$username\n";
            print $idf "user.domain=$domain\n";
            print $idf "user.home=$authhost\n";
            print $idf "browser.type=$clientbrowser\n";
            print $idf "browser.version=$clientversion\n";
            print $idf "browser.mathml=$clientmathml\n";
            print $idf "browser.os=$clientos\n";
            print $idf "request.course.fn=\n";
            print $idf "request.course.uri=\n";
            print $idf "request.course.sec=\n";
            print $idf "request.role=cm\n";
            print $idf "request.host=$ENV{'HTTP_HOST'}\n"; 
            if ($userroles ne '') { print $idf "$userroles"; }
	    $idf->close();
        }
         $ENV{'request.role'}='cm';
# -------------------------------------------------------------------- Log this

    &Apache::lonnet::log($domain,$username,$authhost,
                         "Login $ENV{'REMOTE_ADDR'}");

# ------------------------------------------------- Check for critical messages

    my @what=&Apache::lonnet::dump('critical',$domain,$username);
    if ($what[0]) {
	if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
	    $lowerurl='/adm/email?critical=display';
        }
    }

# ------------------------------------------------------------ Get cookie ready

    $cookie="lonID=$cookie; path=/";
# -------------------------------------------------------- Menu script and info
    my $windowinfo=&Apache::lonmenu::open();
# ------------------------------------------------------------- Info for Remote
    my $configmenu=&Apache::lonmenu::rawconfig();
# ------------------------------------------------- Output for successful login

    $r->send_cgi_header(<<ENDHEADER);
Content-type: text/html
Set-cookie: $cookie

ENDHEADER
    $r->print(<<ENDSUCCESS);
<html>
<head>
<title>Successful Login to the LearningOnline Network with CAPA</title>
<script>

// --------------------------------------------- Checks if server frame defined

function checkdef() {
   if ((menuloaded==0) && (tim==0)) { setTimeout('checkdef()',100); }
}

// ---------------------------------------------------------- The wait function

function wait() {
   if ((menuloaded==1) || (tim==1)) {
      if (tim==0) {
         clearTimeout(canceltim);
         $configmenu
         window.location='$lowerurl';  
      } else {
         alert("Remote Control Timed Out.");
      }
   } else {
      setTimeout('wait();',100);
   }
}

function main() {
   canceltim=setTimeout('tim=1;',80000);
   checkdef();
   wait();
}

</script>
</head>
<body bgcolor="#FFFFFF">
<script>
    menuloaded=0;
    tim=0;
</script>
$windowinfo
<h1>Welcome!</h1>
<script>
    main();
</script>
</body>
</html>
ENDSUCCESS
}

# --------------------------------------------------------------- Failed login!

sub failed {
    my ($r,$message) = @_;
    $r->send_cgi_header(<<ENDFHEADER);
Content-type: text/html

ENDFHEADER
    $r->print(<<ENDFAILED);
<html>
<head>
<title>Unsuccessful Login to the LearningOnline Network with CAPA</title>
</head>
<html>
<body bgcolor="#FFFFFF">
<h1>Sorry ...</h1>
<h2>$message to use the Learning<i>Online</i> Network with CAPA</h2>
</body>
</html>
ENDFAILED
}

# ---------------------------------------------------------------- Main handler

sub handler {
    my $r = shift;

    my $buffer;
    $r->read($buffer,$r->header_in('Content-length'));
    my @pairs=split(/&/,$buffer);
    my $pair; my $name; my $value; my %FORM;
    foreach $pair (@pairs) {
       ($name,$value) = split(/=/,$pair);
       $value =~ tr/+/ /;
       $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
       $FORM{$name}=$value;
    } 

    if ((!$FORM{'uname'}) || (!$FORM{'upass'}) || (!$FORM{'udom'})) {
	failed($r,'Username, password and domain need to be specified');
        return OK;
    }
    $FORM{'uname'} =~ s/\W//g;
    $FORM{'udom'}  =~ s/\W//g;

    my $role   = $r->dir_config('lonRole');
    my $domain = $r->dir_config('lonDefDomain');
    my $prodir = $r->dir_config('lonUsersDir');

# ---------------------------------------- Get the information from login token

    my $tmpinfo=Apache::lonnet::reply('tmpget:'.$FORM{'logtoken'},
                                      $FORM{'serverid'});

    if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
	failed($r,'Login token missing, inaccessible or expired');
        return OK;
    }
    
    my ($key,$firsturl)=split(/&/,$tmpinfo);

    my $keybin=pack("H16",$key);

    my $cipher;
    if ($Crypt::DES::VERSION>=2.03) {
	$cipher=new Crypt::DES $keybin;
    }
    else {
	$cipher=new DES $keybin;
    }

    my $upass=$cipher->decrypt(
       unpack("a8",pack("H16",substr($FORM{'upass'},0,16))));

    $upass.=$cipher->decrypt(
       unpack("a8",pack("H16",substr($FORM{'upass'},16,16))));

    $upass=substr($upass,1,ord(substr($upass,0,1)));

# ---------------------------------------------------------------- Authenticate
    my $authhost=Apache::lonnet::authenticate($FORM{'uname'},
                                              $upass,
                                              $FORM{'udom'});
    
# --------------------------------------------------------------------- Failed?

    if ($authhost eq 'no_host') {
	failed($r,'Username and/or password could not be authenticated');
        return OK;
    }

    if (($firsturl eq '') || ($firsturl eq '/adm/logout')) {
	$firsturl='/adm/roles';
    }

    success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl);
    return OK;
}

1;
__END__
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.