--- loncom/auth/lonauth.pm	2006/10/06 14:29:44	1.82.2.1
+++ loncom/auth/lonauth.pm	2006/11/23 01:49:41	1.87
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # User Authentication Module
 #
-# $Id: lonauth.pm,v 1.82.2.1 2006/10/06 14:29:44 albertel Exp $
+# $Id: lonauth.pm,v 1.87 2006/11/23 01:49:41 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -40,154 +40,22 @@ use Apache::lonnet;
 use Apache::lonmenu();
 use Fcntl qw(:flock);
 use Apache::lonlocal;
-
-my %FORM;
-
+ 
 # ------------------------------------------------------------ Successful login
-
 sub success {
-    my ($r, $username, $domain, $authhost, $lowerurl, $extra_env) = @_;
-    my $lonids=$r->dir_config('lonIDsDir');
-
-    my $public=($username eq 'public' && $domain eq 'public');
-
-# See if old ID present, if so, remove
-
-    my ($filename,$cookie,$userroles);
-    my $now=time;
-
-    if ($public) {
-	my $max_public=100;
-	my $oldest;
-	my $oldest_time=0;
-	for(my $next=1;$next<=$max_public;$next++) {
-	    if (-e $lonids."/publicuser_$next.id") {
-		my $mtime=(stat($lonids."/publicuser_$next.id"))[9];
-		if ($mtime<$oldest_time || !$oldest_time) {
-		    $oldest_time=$mtime;
-		    $oldest=$next;
-		}
-	    } else {
-		$cookie="publicuser_$next";
-		last;
-	    }
-	}
-	if (!$cookie) { $cookie="publicuser_$oldest"; }
-    } else {
-	opendir(DIR,$lonids);
-	while ($filename=readdir(DIR)) {
-	    if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
-		unlink($lonids.'/'.$filename);
-	    }
-	}
-	closedir(DIR);
-
-# Give them a new cookie
-
-	$cookie="$username\_$now\_$domain\_$authhost";
-    
-# Initialize roles
-
-	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
-    }
-# ------------------------------------ Check browser type and MathML capability
-
-    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')) {
-	foreach ('imagesuppress','appletsuppress',
-		 'embedsuppress','fontenhance','blackwhite') {
-	    if ($FORM{$_} eq 'true') {
-		&Apache::lonnet::put('environment',{$_ => 'on'},
-				     $domain,$username);
-	    } else {
-		&Apache::lonnet::del('environment',[$_],$domain,$username);
-	    }
-	}
-    }
-# ------------------------------------------------------------- Get environment
+    my ($r, $username, $domain, $authhost, $lowerurl, $extra_env,
+	$form) = @_;
 
-    my %userenv=Apache::lonnet::dump('environment',$domain,$username);
-    my ($tmp) = keys(%userenv);
-    if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
-	# default remote control to off
-	if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
-    } else {
-	undef(%userenv);
-    }
-    if (($userenv{'interface'}) && (!$FORM{'interface'})) {
-	$FORM{'interface'}=$userenv{'interface'};
-    }
-    $env{'environment.remote'}=$userenv{'remote'};
-    if ($userenv{'texengine'} eq 'ttm') { $clientmathml=1; }
+# ------------------------------------------------------------ Get cookie ready
+    my $cookie =
+	&Apache::loncommon::init_user_environment($r, $username, $domain,
+						  $authhost, $form,
+						  {'extra_env' => $extra_env,});
 
-# --------------- 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
-
-    {
-	my %initial_env = 
-	    ("user.name"          => $username,
-	     "user.domain"        => $domain,
-	     "user.home"          => $authhost,
-	     "browser.type"       => $clientbrowser,
-	     "browser.version"    => $clientversion,
-	     "browser.mathml"     => $clientmathml,
-	     "browser.unicode"    => $clientunicode,
-	     "browser.os"         => $clientos,
-	     "server.domain"      => $r->dir_config('lonDefDomain'),
-	     "request.course.fn"  => '',
-	     "request.course.uri" => '',
-	     "request.course.sec" => '',
-	     "request.role"       => 'cm',
-	     "request.role.adv"   => $env{'user.adv'},
-	     "request.host"       => $ENV{'REMOTE_ADDR'},);
-
-        if ($FORM{'localpath'}) {
-	    $initial_env{"browser.localpath"}  = $FORM{'localpath'};
-	    $initial_env{"browser.localres"}   = $FORM{'localres'};
-        }
-	
-	if ($public) {
-	    $initial_env{"environment.remote"} = "off";
-	}
-	if ($FORM{'interface'}) {
-	    $FORM{'interface'}=~s/\W//gs;
-	    $initial_env{"browser.interface"} = $FORM{'interface'};
-	    $env{'browser.interface'}=$FORM{'interface'};
-	    foreach my $option ('imagesuppress','appletsuppress',
-				'embedsuppress','fontenhance','blackwhite') {
-		if (($FORM{$option} eq 'true') ||
-		    ($userenv{$option} eq 'on')) {
-		    $initial_env{"browser.$option"} = "on";
-		}
-	    }
-	}
+    my $public=($username eq 'public' && $domain eq 'public');
 
-	$env{'user.environment'} = "$lonids/$cookie.id";
-	open(my $idf,">$lonids/$cookie.id");
-	unless (flock($idf,LOCK_EX)) {
-	    &Apache::lonnet::logthis("<font color=blue>WARNING: ".
-			   'Could not obtain exclusive lock in lonauth: '.$!);
-	    close($idf);
-	    return 'error: '.$!;
-	}
+    if ($public or $lowerurl eq 'noredirect') { return $cookie; }
 
-	&add_to_env($idf,\%initial_env);
-	&add_to_env($idf,\%userenv,'environment.');
-	&add_to_env($idf,$userroles);
-	&add_to_env($idf,$extra_env);
-	close($idf);
-    }
-    $env{'request.role'}='cm';
-    $env{'request.role.adv'}=$env{'user.adv'};
-    $env{'browser.type'}=$clientbrowser;
 # -------------------------------------------------------------------- Log this
 
     &Apache::lonnet::log($domain,$username,$authhost,
@@ -203,12 +71,9 @@ sub success {
     }
 
 # ------------------------------------------------------------ Get cookie ready
-
-    if ($public or $lowerurl eq 'noredirect') { return $cookie; }
-
     $cookie="lonID=$cookie; path=/";
 # -------------------------------------------------------- Menu script and info
-    my $windowinfo=&Apache::lonmenu::open($clientos);
+    my $windowinfo=&Apache::lonmenu::open($env{'browser.os'});
     my $startupremote=&Apache::lonmenu::startupremote($lowerurl);
     my $remoteinfo=&Apache::lonmenu::load_remote_msg($lowerurl);
     my $setflags=&Apache::lonmenu::setflags();
@@ -249,18 +114,10 @@ $end_page
 ENDSUCCESS
 }
 
-sub add_to_env {
-    my ($idf,$env_data,$prefix) = @_;
-    while (my ($key,$value) = each(%$env_data)) {
-	print $idf (&escape($prefix.$key).'='.&escape($value)."\n");
-	$env{$prefix.$key} = $value;
-    }
-}
-
 # --------------------------------------------------------------- Failed login!
 
 sub failed {
-    my ($r,$message) = @_;
+    my ($r,$message,$form) = @_;
     my $start_page = &Apache::loncommon::start_page('Unsuccessful Login',undef,
 						    {'no_inline_link' => 1,});
     my $end_page   = &Apache::loncommon::end_page();
@@ -268,7 +125,7 @@ sub failed {
     my %lt=('sorry'  => &mt('Sorry ...'),
 	    'please' => 
 	    &mt('Please [_1]log in again[_2].',
-		"<a href=\"/adm/login?username=$FORM{'uname'}&domain=$FORM{'udom'}\">",
+		"<a href=\"/adm/login?username=$form->{'uname'}&domain=$form->{'udom'}\">",
 		'</a>'),
 	    'problemspage' => &mt('loginproblems.html'),
 	    'problems'     => 'Problems',
@@ -302,7 +159,7 @@ sub reroute {
 
 sub handler {
     my $r = shift;
-
+    my $form;
 # Are we re-routing?
     if (-e '/home/httpd/html/lon-status/reroute.txt') {
 	&reroute($r);
@@ -316,8 +173,7 @@ sub handler {
     my $lonid=$cookies{'lonID'};
     my $cookie;
     if ($lonid) {
-	my $handle=$lonid->value;
-        $handle=~s/\W//g;
+	my $handle=&LONCAPA::clean_handle($lonid->value);
         my $lonidsdir=$r->dir_config('lonIDsDir');
         if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {
 # Indeed, a valid token is found
@@ -347,28 +203,26 @@ ENDFAILED
     if ($r->header_in('Content-length') > 0) {
 	$r->read($buffer,$r->header_in('Content-length'),0);
     }
-    my @pairs=split(/&/,$buffer);
-    my $pair; my $name; my $value;
-    undef %FORM;
-    %FORM=();
-    foreach $pair (@pairs) {
-       ($name,$value) = split(/=/,$pair);
+    my %form;
+    foreach my $pair (split(/&/,$buffer)) {
+       my ($name,$value) = split(/=/,$pair);
        $value =~ tr/+/ /;
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
-       $FORM{$name}=$value;
+       $form{$name}=$value;
     } 
 
-    if ((!$FORM{'uname'}) || (!$FORM{'upass0'}) || (!$FORM{'udom'})) {
-	failed($r,'Username, password and domain need to be specified.');
+    if ((!$form{'uname'}) || (!$form{'upass0'}) || (!$form{'udom'})) {
+	&failed($r,'Username, password and domain need to be specified.',
+		\%form);
         return OK;
     }
 
 # split user logging in and "su"-user
 
-    ($FORM{'uname'},$FORM{'suname'})=split(/\:/,$FORM{'uname'});
-    $FORM{'uname'} =~ s/\W//g;
-    $FORM{'suname'} =~ s/\W//g;
-    $FORM{'udom'}  =~ s/\W//g;
+    ($form{'uname'},$form{'suname'})=split(/\:/,$form{'uname'});
+    $form{'uname'} = &LONCAPA::clean_username($form{'uname'});
+    $form{'suname'}= &LONCAPA::clean_username($form{'suname'});
+    $form{'udom'}  = &LONCAPA::clean_domain(  $form{'udom'});
 
     my $role   = $r->dir_config('lonRole');
     my $domain = $r->dir_config('lonDefDomain');
@@ -376,18 +230,18 @@ ENDFAILED
 
 # ---------------------------------------- Get the information from login token
 
-    my $tmpinfo=Apache::lonnet::reply('tmpget:'.$FORM{'logtoken'},
-                                      $FORM{'serverid'});
+    my $tmpinfo=Apache::lonnet::reply('tmpget:'.$form{'logtoken'},
+                                      $form{'serverid'});
 
     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.',\%form);
         return OK;
     } else {
-	my $reply = &Apache::lonnet::reply('tmpdel:'.$FORM{'logtoken'},
-					   $FORM{'serverid'});
+	my $reply = &Apache::lonnet::reply('tmpdel:'.$form{'logtoken'},
+					   $form{'serverid'});
         if ( $reply ne 'ok' ) {
-            &failed($r,'Session could not be opened.');
-	    &Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $FORM{'serverid'}." to get login token");
+            &failed($r,'Session could not be opened.',\%form);
+	    &Apache::lonnet::logthis("ERROR got a reply of $reply when trying to contact ". $form{'serverid'}." to get login token");
 	    return OK;
 	}
     }
@@ -405,24 +259,25 @@ ENDFAILED
     my $upass='';
     for (my $i=0;$i<=2;$i++) {
 	my $chunk=
-	    $cipher->decrypt(unpack("a8",pack("H16",substr($FORM{'upass'.$i},0,16))));
+	    $cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},0,16))));
 
 	$chunk.=
-	    $cipher->decrypt(unpack("a8",pack("H16",substr($FORM{'upass'.$i},16,16))));
+	    $cipher->decrypt(unpack("a8",pack("H16",substr($form{'upass'.$i},16,16))));
 
 	$chunk=substr($chunk,1,ord(substr($chunk,0,1)));
 	$upass.=$chunk;
     }
 
 # ---------------------------------------------------------------- Authenticate
-    my $authhost=Apache::lonnet::authenticate($FORM{'uname'},
+    my $authhost=Apache::lonnet::authenticate($form{'uname'},
                                               $upass,
-                                              $FORM{'udom'});
+                                              $form{'udom'});
     
 # --------------------------------------------------------------------- Failed?
 
     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.',
+		\%form);
         return OK;
     }
 
@@ -431,19 +286,19 @@ ENDFAILED
 	$firsturl='/adm/roles';
     }
 # --------------------------------- Are we attempting to login as somebody else?
-    if ($FORM{'suname'}) {
+    if ($form{'suname'}) {
 # ------------ see if the original user has enough privileges to pull this stunt
-	if (&Apache::lonnet::privileged($FORM{'uname'},$FORM{'udom'})) {
+	if (&Apache::lonnet::privileged($form{'uname'},$form{'udom'})) {
 # ---------------------------------------------------- see if the su-user exists
-	    unless (&Apache::lonnet::homeserver($FORM{'suname'},$FORM{'udom'})
+	    unless (&Apache::lonnet::homeserver($form{'suname'},$form{'udom'})
 		eq 'no_host') {
-		&Apache::lonnet::logthis(&Apache::lonnet::homeserver($FORM{'suname'},$FORM{'udom'}));
+		&Apache::lonnet::logthis(&Apache::lonnet::homeserver($form{'suname'},$form{'udom'}));
 # ------------------------------ see if the su-user is not too highly privileged
-		unless (&Apache::lonnet::privileged($FORM{'suname'},$FORM{'udom'})) {
+		unless (&Apache::lonnet::privileged($form{'suname'},$form{'udom'})) {
 # -------------------------------------------------------- actually switch users
-		    &Apache::lonnet::logperm('User '.$FORM{'uname'}.' at '.$FORM{'udom'}.
-			' logging in as '.$FORM{'suname'});
-		    $FORM{'uname'}=$FORM{'suname'};
+		    &Apache::lonnet::logperm('User '.$form{'uname'}.' at '.$form{'udom'}.
+			' logging in as '.$form{'suname'});
+		    $form{'uname'}=$form{'suname'};
 		} else {
 		    &Apache::lonnet::logthis('Attempted switch user to privileged user');
 		}
@@ -452,11 +307,14 @@ ENDFAILED
 	    &Apache::lonnet::logthis('Non-privileged user attempting switch user');
 	}
     }
+
     if ($r->dir_config("lonBalancer") eq 'yes') {
-	&success($r,$FORM{'uname'},$FORM{'udom'},$authhost,'noredirect');
+	&success($r,$form{'uname'},$form{'udom'},$authhost,'noredirect',undef,
+		 \%form);
 	$r->internal_redirect('/adm/switchserver');
     } else {
-	&success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl);
+	&success($r,$form{'uname'},$form{'udom'},$authhost,$firsturl,undef,
+		 \%form);
     }
     return OK;
 }