version 1.43, 2003/03/02 02:16:53
|
version 1.50, 2003/05/23 21:18:56
|
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.role.adv=$ENV{'user.adv'}\n"; |
print $idf "request.host=$ENV{'REMOTE_ADDR'}\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; |
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'); |
my $bodytag=&Apache::loncommon::bodytag('Successful Login',undef,' '); |
# ------------------------------------------------- Output for successful login |
# ------------------------------------------------- Output for successful login |
|
|
$r->send_cgi_header(<<ENDHEADER); |
$r->send_cgi_header(<<ENDHEADER); |
Line 242 ENDFHEADER
|
Line 218 ENDFHEADER
|
$bodytag |
$bodytag |
<h1>Sorry ...</h1> |
<h1>Sorry ...</h1> |
<p><b>$message</b></p> |
<p><b>$message</b></p> |
<p>Please <a href="/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}">login</a> again.</p> |
<p>Please <a href="/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}">log in again</a>.</p> |
<p> |
<p> |
<a href="/adm/loginproblems.html">Problems?</a></p> |
<a href="/adm/loginproblems.html">Problems?</a></p> |
</body> |
</body> |
Line 256 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 287 sub handler {
|
Line 263 sub handler {
|
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) { |
if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) { |
failed($r,'Information needed to verify your login information is 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); |