--- loncom/interface/loncommon.pm	2006/10/03 20:14:35	1.461
+++ loncom/interface/loncommon.pm	2006/10/10 21:57:31	1.462
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.461 2006/10/03 20:14:35 albertel Exp $
+# $Id: loncommon.pm,v 1.462 2006/10/10 21:57:31 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -6001,6 +6001,166 @@ sub escape_url {
     my $lastitem = &escape(pop(@urlslices));
     return join('/',@urlslices).'/'.$lastitem;
 }
+
+# -------------------------------------------------------- Initliaze user login
+sub init_user_environment {
+    my ($r, $username, $domain, $authhost, $form, $extra_env) = @_;
+    my $lonids=$Apache::lonnet::perlvar{'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) = &decode_user_agent($r);
+
+# -------------------------------------- Any accessibility options to remember?
+    if (($form->{'interface'}) && ($form->{'remember'} eq 'true')) {
+	foreach my $option ('imagesuppress','appletsuppress',
+			    'embedsuppress','fontenhance','blackwhite') {
+	    if ($form->{$option} eq 'true') {
+		&Apache::lonnet::put('environment',{$option => 'on'},
+				     $domain,$username);
+	    } else {
+		&Apache::lonnet::del('environment',[$option],
+				     $domain,$username);
+	    }
+	}
+    }
+# ------------------------------------------------------------- Get environment
+
+    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; }
+
+# --------------- Do not trust query string to be put directly into environment
+    foreach my $option ('imagesuppress','appletsuppress',
+			'embedsuppress','fontenhance','blackwhite',
+			'interface','localpath','localres') {
+	$form->{$option}=~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"      => $Apache::lonnet::perlvar{'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";
+		}
+	    }
+	}
+
+	$env{'user.environment'} = "$lonids/$cookie.id";
+	
+	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
+		 &GDBM_WRCREAT(),0640)) {
+	    &_add_to_env(\%disk_env,\%initial_env);
+	    &_add_to_env(\%disk_env,\%userenv,'environment.');
+	    &_add_to_env(\%disk_env,$userroles);
+	    &_add_to_env(\%disk_env,$extra_env);
+	    untie(%disk_env);
+	} else {
+	    &Apache::lonnet::logthis("<font color=\"blue\">WARNING: ".
+			   'Could not create environment storage in lonauth: '.$!.'</font>');
+	    return 'error: '.$!;
+	}
+    }
+    $env{'request.role'}='cm';
+    $env{'request.role.adv'}=$env{'user.adv'};
+    $env{'browser.type'}=$clientbrowser;
+
+    return $cookie;
+
+}
+
+sub _add_to_env {
+    my ($idf,$env_data,$prefix) = @_;
+    while (my ($key,$value) = each(%$env_data)) {
+	$idf->{$prefix.$key} = $value;
+	$env{$prefix.$key}   = $value;
+    }
+}
+
+
 =pod
 
 =back