version 1.41, 2003/02/20 06:49:23
|
version 1.52, 2003/06/06 02:24:49
|
Line 42 use CGI qw(:standard);
|
Line 42 use CGI qw(:standard);
|
use CGI::Cookie(); |
use CGI::Cookie(); |
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use Crypt::DES; |
use Crypt::DES; |
|
use Apache::loncommon(); |
use Apache::lonnet(); |
use Apache::lonnet(); |
use Apache::lonmenu(); |
use Apache::lonmenu(); |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
Line 77 sub success {
|
Line 78 sub success {
|
|
|
# ------------------------------------ Check browser type and MathML capability |
# ------------------------------------ Check browser type and MathML capability |
|
|
my @browsertype=split(/\&/,$r->dir_config("lonBrowsDet")); |
my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml, |
my %mathcap=split(/\&/,$r->dir_config("lonMathML")); |
$clientunicode,$clientos) = &Apache::loncommon::decode_user_agent($r); |
my $httpbrowser=$ENV{"HTTP_USER_AGENT"}; |
|
my $i; |
|
my $clientbrowser='unknown'; |
|
my $clientversion='0'; |
|
my $clientmathml=''; |
|
my $clientunicode='0'; |
|
for ($i=0;$i<=$#browsertype;$i++) { |
|
my ($bname,$match,$notmatch,$vreg,$minv,$univ)=split(/\:/,$browsertype[$i]); |
|
if (($httpbrowser=~/$match/i) && ($httpbrowser!~/$notmatch/i)) { |
|
$clientbrowser=$bname; |
|
$httpbrowser=~/$vreg/i; |
|
$clientversion=$1; |
|
$clientmathml=($clientversion>=$minv); |
|
$clientunicode=($clientversion>=$univ); |
|
} |
|
} |
|
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'; } |
|
if ($httpbrowser=~/embed/i) { $clientos='pda'; } |
|
|
|
# -------------------------------------- Any accessibility options to remember? |
# -------------------------------------- Any accessibility options to remember? |
if (($FORM{'interface'}) && ($FORM{'remember'} eq 'true')) { |
if (($FORM{'interface'}) && ($FORM{'remember'} eq 'true')) { |
Line 133 sub success {
|
Line 106 sub success {
|
if (($userenv{'interface'}) && (!$FORM{'interface'})) { |
if (($userenv{'interface'}) && (!$FORM{'interface'})) { |
$FORM{'interface'}=$userenv{'interface'}; |
$FORM{'interface'}=$userenv{'interface'}; |
} |
} |
|
$ENV{'environment.remote'}=$userenv{'remote'}; |
# --------------------------------------------------------- Write first profile |
# --------------------------------------------------------- Write first profile |
|
|
{ |
{ |
Line 156 sub success {
|
Line 130 sub success {
|
print $idf "request.course.uri=\n"; |
print $idf "request.course.uri=\n"; |
print $idf "request.course.sec=\n"; |
print $idf "request.course.sec=\n"; |
print $idf "request.role=cm\n"; |
print $idf "request.role=cm\n"; |
print $idf "request.host=$ENV{'HTTP_HOST'}\n"; |
print $idf "request.role.adv=$ENV{'user.adv'}\n"; |
|
print $idf "request.host=$ENV{'REMOTE_ADDR'}\n"; |
if ($FORM{'interface'}) { |
if ($FORM{'interface'}) { |
$FORM{'interface'}=~s/\W//gs; |
$FORM{'interface'}=~s/\W//gs; |
print $idf "browser.interface=$FORM{'interface'}\n"; |
print $idf "browser.interface=$FORM{'interface'}\n"; |
Line 173 sub success {
|
Line 148 sub success {
|
$idf->close(); |
$idf->close(); |
} |
} |
$ENV{'request.role'}='cm'; |
$ENV{'request.role'}='cm'; |
|
$ENV{'request.role.adv'}=$ENV{'user.adv'}; |
$ENV{'browser.type'}=$clientbrowser; |
$ENV{'browser.type'}=$clientbrowser; |
# -------------------------------------------------------------------- Log this |
# -------------------------------------------------------------------- Log this |
|
|
Line 196 sub success {
|
Line 172 sub success {
|
my $startupremote=&Apache::lonmenu::startupremote($lowerurl); |
my $startupremote=&Apache::lonmenu::startupremote($lowerurl); |
my $setflags=&Apache::lonmenu::setflags(); |
my $setflags=&Apache::lonmenu::setflags(); |
my $maincall=&Apache::lonmenu::maincall(); |
my $maincall=&Apache::lonmenu::maincall(); |
|
my $bodytag=&Apache::loncommon::bodytag('Successful Login'); |
# ------------------------------------------------- Output for successful login |
# ------------------------------------------------- Output for successful login |
|
|
$r->send_cgi_header(<<ENDHEADER); |
$r->send_cgi_header(<<ENDHEADER); |
Line 209 ENDHEADER
|
Line 186 ENDHEADER
|
<title>Successful Login to the LearningOnline Network with CAPA</title> |
<title>Successful Login to the LearningOnline Network with CAPA</title> |
$startupremote |
$startupremote |
</head> |
</head> |
<body bgcolor="#FFFFFF"> |
$bodytag |
$setflags |
$setflags |
$windowinfo |
$windowinfo |
<h1>Welcome!</h1> |
<h1>Welcome!</h1> |
Line 227 ENDSUCCESS
|
Line 204 ENDSUCCESS
|
|
|
sub failed { |
sub failed { |
my ($r,$message) = @_; |
my ($r,$message) = @_; |
|
my $bodytag=&Apache::loncommon::bodytag('Unsuccessful Login'); |
$r->send_cgi_header(<<ENDFHEADER); |
$r->send_cgi_header(<<ENDFHEADER); |
Content-type: text/html |
Content-type: text/html |
|
|
Line 237 ENDFHEADER
|
Line 215 ENDFHEADER
|
<title>Unsuccessful Login to the LearningOnline Network with CAPA</title> |
<title>Unsuccessful Login to the LearningOnline Network with CAPA</title> |
</head> |
</head> |
<html> |
<html> |
<body bgcolor="#FFFFFF"> |
$bodytag |
<h1>Sorry ...</h1> |
<h1>Sorry ...</h1> |
<h2>$message to use the Learning<i>Online</i> Network with CAPA</h2> |
<p><b>$message</b></p> |
|
<p>Please <a href="/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}">log in again</a>.</p> |
|
<p> |
|
<a href="/adm/loginproblems.html">Problems?</a></p> |
</body> |
</body> |
</html> |
</html> |
ENDFAILED |
ENDFAILED |
Line 251 sub handler {
|
Line 232 sub handler {
|
my $r = shift; |
my $r = shift; |
|
|
my $buffer; |
my $buffer; |
$r->read($buffer,$r->header_in('Content-length')); |
$r->read($buffer,$r->header_in('Content-length'),0); |
my @pairs=split(/&/,$buffer); |
my @pairs=split(/&/,$buffer); |
my $pair; my $name; my $value; |
my $pair; my $name; my $value; |
undef %FORM; |
undef %FORM; |
Line 264 sub handler {
|
Line 245 sub handler {
|
} |
} |
|
|
if ((!$FORM{'uname'}) || (!$FORM{'upass'}) || (!$FORM{'udom'})) { |
if ((!$FORM{'uname'}) || (!$FORM{'upass'}) || (!$FORM{'udom'})) { |
failed($r,'Username, password and domain need to be specified'); |
failed($r,'Username, password and domain need to be specified.'); |
return OK; |
return OK; |
} |
} |
$FORM{'uname'} =~ s/\W//g; |
$FORM{'uname'} =~ s/\W//g; |
Line 280 sub handler {
|
Line 261 sub handler {
|
$FORM{'serverid'}); |
$FORM{'serverid'}); |
|
|
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) { |
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) { |
failed($r,'Login token missing, inaccessible or expired'); |
failed($r,'Information needed to verify your login information is missing, inaccessible or expired.'); |
return OK; |
return OK; |
|
} else { |
|
unless (&Apache::lonnet::reply('tmpdel:'.$FORM{'logtoken'}, |
|
$FORM{'serverid'}) eq 'ok') { |
|
&failed($r,'Session could not be opened.'); |
|
} |
} |
} |
|
|
my ($key,$firsturl)=split(/&/,$tmpinfo); |
my ($key,$firsturl)=split(/&/,$tmpinfo); |
|
|
my $keybin=pack("H16",$key); |
my $keybin=pack("H16",$key); |
Line 312 sub handler {
|
Line 297 sub handler {
|
# --------------------------------------------------------------------- Failed? |
# --------------------------------------------------------------------- Failed? |
|
|
if ($authhost eq 'no_host') { |
if ($authhost eq 'no_host') { |
failed($r,'Username and/or password could not be authenticated'); |
failed($r,'Username and/or password could not be authenticated.'); |
return OK; |
return OK; |
} |
} |
|
|