--- loncom/auth/lonauth.pm	2003/03/02 03:58:55	1.44
+++ loncom/auth/lonauth.pm	2003/09/11 20:54:11	1.55
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # User Authentication Module
 #
-# $Id: lonauth.pm,v 1.44 2003/03/02 03:58:55 www Exp $
+# $Id: lonauth.pm,v 1.55 2003/09/11 20:54:11 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -42,6 +42,7 @@ use CGI qw(:standard);
 use CGI::Cookie();
 use DynaLoader; # for Crypt::DES version
 use Crypt::DES;
+use Apache::loncommon();
 use Apache::lonnet();
 use Apache::lonmenu();
 use Fcntl qw(:flock);
@@ -77,36 +78,8 @@ sub success {
 
 # ------------------------------------ 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='';
-    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'; }
+    my ($httpbrowser,$clientbrowser,$clientversion,$clientmathml,
+        $clientunicode,$clientos) = &Apache::loncommon::decode_user_agent($r);
 
 # -------------------------------------- Any accessibility options to remember?
     if (($FORM{'interface'}) && ($FORM{'remember'} eq 'true')) {
@@ -133,6 +106,13 @@ sub success {
     if (($userenv{'interface'}) && (!$FORM{'interface'})) {
 	$FORM{'interface'}=$userenv{'interface'};
     }
+    $ENV{'environment.remote'}=$userenv{'remote'};
+# --------------- Do not trust query string to be put directly into environment
+    foreach ('imagesuppress','appletsuppress',
+	     'embedsuppress','fontenhance','blackwhite',
+	     'interface','localpath','localres') {
+	$FORM{$_}=~s/[\n\r\=]//gs;
+    }
 # --------------------------------------------------------- Write first profile
 
     {
@@ -152,10 +132,15 @@ sub success {
 	print $idf "browser.mathml=$clientmathml\n";
 	print $idf "browser.unicode=$clientunicode\n";
 	print $idf "browser.os=$clientos\n";
+        if ($FORM{'localpath'}) {
+           print $idf "browser.localpath=$FORM{'localpath'}\n";
+           print $idf "browser.localres=$FORM{'localres'}\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.role.adv=$ENV{'user.adv'}\n";
 	print $idf "request.host=$ENV{'REMOTE_ADDR'}\n";
 	if ($FORM{'interface'}) {
 	    $FORM{'interface'}=~s/\W//gs;
@@ -173,6 +158,7 @@ sub success {
 	$idf->close();
     }
     $ENV{'request.role'}='cm';
+    $ENV{'request.role.adv'}=$ENV{'user.adv'};
     $ENV{'browser.type'}=$clientbrowser;
 # -------------------------------------------------------------------- Log this
 
@@ -242,7 +228,7 @@ ENDFHEADER
 $bodytag
 <h1>Sorry ...</h1>
 <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>
 <a href="/adm/loginproblems.html">Problems?</a></p>
 </body>
@@ -250,13 +236,42 @@ $bodytag
 ENDFAILED
 }
 
+# ------------------------------------------------------------------ Rerouting!
+
+sub reroute {
+    my $r=shift;
+    my $bodytag=&Apache::loncommon::bodytag('Rerouting');
+    $r->send_cgi_header(<<ENDRFHEADER);
+Content-type: text/html
+
+ENDRFHEADER
+    $r->print(<<ENDRFAILED);
+<html>
+<head>
+<title>Rerouting Login to the LearningOnline Network with CAPA</title>
+</head>
+<html>
+$bodytag
+<h1>Sorry ...</h1>
+Please <a href="/">log in again</a>.
+</body>
+</html>
+ENDRFAILED
+}
+
 # ---------------------------------------------------------------- Main handler
 
 sub handler {
     my $r = shift;
 
+# Are we re-routing?
+    if (-e '/home/httpd/html/lon-status/reroute.txt') {
+	&reroute($r);
+	return OK;
+    }
+
     my $buffer;
-    $r->read($buffer,$r->header_in('Content-length'));
+    $r->read($buffer,$r->header_in('Content-length'),0);
     my @pairs=split(/&/,$buffer);
     my $pair; my $name; my $value;
     undef %FORM;