loncom/auth/lonauth.pm - diff

Return to lonauth.pm CVS log

Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/lonauth.pm between versions 1.76 and 1.82

version 1.76, 2006/05/01 21:04:31	version 1.82, 2006/08/30 22:12:11
Line 29	Line 29
package Apache::lonauth;	package Apache::lonauth;

use strict;	use strict;
	use LONCAPA;
use Apache::Constants qw(:common);	use Apache::Constants qw(:common);
use Apache::File;
use CGI qw(:standard);	use CGI qw(:standard);
use CGI::Cookie();	use CGI::Cookie();
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
Line 46 my %FORM;	Line 46 my %FORM;
# ------------------------------------------------------------ Successful login	# ------------------------------------------------------------ Successful login

sub success {	sub success {
my ($r, $username, $domain, $authhost,$lowerurl) = @_;	my ($r, $username, $domain, $authhost, $lowerurl, $extra_env) = @_;
my $lonids=$r->dir_config('lonIDsDir');	my $lonids=$r->dir_config('lonIDsDir');

my $public=($username eq 'public' && $domain eq 'public');	my $public=($username eq 'public' && $domain eq 'public');
Line 88 sub success {	Line 88 sub success {

# Initialize roles	# Initialize roles

$userroles=Apache::lonnet::rolesinit($domain,$username,$authhost);	$userroles=&Apache::lonnet::rolesinit($domain,$username,$authhost);
}	}
# ------------------------------------ Check browser type and MathML capability	# ------------------------------------ Check browser type and MathML capability

Line 109 sub success {	Line 109 sub success {
}	}
# ------------------------------------------------------------- Get environment	# ------------------------------------------------------------- Get environment

my $userenv;
my %userenv=Apache::lonnet::dump('environment',$domain,$username);	my %userenv=Apache::lonnet::dump('environment',$domain,$username);
my ($tmp) = keys(%userenv);	my ($tmp) = keys(%userenv);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
# default remote control to off	# default remote control to off
if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }	if ($userenv{'remote'} ne 'on') { $userenv{'remote'} = 'off'; }
foreach my $key (keys(%userenv)) {	} else {
$userenv.="environment.$key=$userenv{$key}\n";	undef(%userenv);
}
}	}
if (($userenv{'interface'}) && (!$FORM{'interface'})) {	if (($userenv{'interface'}) && (!$FORM{'interface'})) {
$FORM{'interface'}=$userenv{'interface'};	$FORM{'interface'}=$userenv{'interface'};
Line 134 sub success {	Line 132 sub success {
# --------------------------------------------------------- Write first profile	# --------------------------------------------------------- Write first profile

{	{
my $idf=Apache::File->new(">$lonids/$cookie.id");	my %initial_env =
unless (flock($idf,LOCK_EX)) {	("user.name" => $username,
&Apache::lonnet::logthis("<font color=blue>WARNING: ".	"user.domain" => $domain,
'Could not obtain exclusive lock in lonauth: '.$!);	"user.home" => $authhost,
$idf->close();	"browser.type" => $clientbrowser,
return 'error: '.$!;	"browser.version" => $clientversion,
}	"browser.mathml" => $clientmathml,
if ($userenv ne '') { print $idf "$userenv\n"; }	"browser.unicode" => $clientunicode,
print $idf "user.name=$username\n";	"browser.os" => $clientos,
print $idf "user.domain=$domain\n";	"server.domain" => $r->dir_config('lonDefDomain'),
print $idf "user.home=$authhost\n";	"request.course.fn" => '',
print $idf "browser.type=$clientbrowser\n";	"request.course.uri" => '',
print $idf "browser.version=$clientversion\n";	"request.course.sec" => '',
print $idf "browser.mathml=$clientmathml\n";	"request.role" => 'cm',
print $idf "browser.unicode=$clientunicode\n";	"request.role.adv" => $env{'user.adv'},
print $idf "browser.os=$clientos\n";	"request.host" => $ENV{'REMOTE_ADDR'},);

if ($FORM{'localpath'}) {	if ($FORM{'localpath'}) {
print $idf "browser.localpath=$FORM{'localpath'}\n";	$initial_env{"browser.localpath"} = $FORM{'localpath'};
print $idf "browser.localres=$FORM{'localres'}\n";	$initial_env{"browser.localres"} = $FORM{'localres'};
}	}
print $idf "server.domain=".$r->dir_config('lonDefDomain')."\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 ($public) {	if ($public) {
print $idf "environment.remote=off\n";	$initial_env{"environment.remote"} = "off";
}	}
if ($FORM{'interface'}) {	if ($FORM{'interface'}) {
$FORM{'interface'}=~s/\W//gs;	$FORM{'interface'}=~s/\W//gs;
print $idf "browser.interface=$FORM{'interface'}\n";	$initial_env{"browser.interface"} = $FORM{'interface'};
$env{'browser.interface'}=$FORM{'interface'};	$env{'browser.interface'}=$FORM{'interface'};
foreach ('imagesuppress','appletsuppress',	foreach my $option ('imagesuppress','appletsuppress',
'embedsuppress','fontenhance','blackwhite') {	'embedsuppress','fontenhance','blackwhite') {
if (($FORM{$_} eq 'true') \|\|	if (($FORM{$option} eq 'true') \|\|
($userenv{$_} eq 'on')) {	($userenv{$option} eq 'on')) {
print $idf "browser.$_=on\n";	$initial_env{"browser.$option"} = "on";
}	}
}	}
}	}
if ($userroles ne '') { print $idf "$userroles"; }
$idf->close();	$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: '.$!;
	}

	&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'}='cm';
$env{'request.role.adv'}=$env{'user.adv'};	$env{'request.role.adv'}=$env{'user.adv'};
Line 243 $end_page	Line 249 $end_page
ENDSUCCESS	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!	# --------------------------------------------------------------- Failed login!

sub failed {	sub failed {
Line 367 ENDFAILED	Line 381 ENDFAILED
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 {	} else {
unless (&Apache::lonnet::reply('tmpdel:'.$FORM{'logtoken'},	my $reply = &Apache::lonnet::reply('tmpdel:'.$FORM{'logtoken'},
$FORM{'serverid'}) eq 'ok') {	$FORM{'serverid'});
	if ( $reply ne 'ok' ) {
&failed($r,'Session could not be opened.');	&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");
	return OK;
}	}
}	}
my ($key,$firsturl)=split(/&/,$tmpinfo);	my ($key,$firsturl)=split(/&/,$tmpinfo);
Line 433 ENDFAILED	Line 450 ENDFAILED
&Apache::lonnet::logthis('Non-privileged user attempting switch user');	&Apache::lonnet::logthis('Non-privileged user attempting switch user');
}	}
}	}
&success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl);	if ($r->dir_config("lonBalancer") eq 'yes') {
	&success($r,$FORM{'uname'},$FORM{'udom'},$authhost,'noredirect');
	$r->internal_redirect('/adm/switchserver');
	} else {
	&success($r,$FORM{'uname'},$FORM{'udom'},$authhost,$firsturl);
	}
return OK;	return OK;
}	}

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.76
changed lines
	Added in v.1.82