loncom/auth/lonlogin.pm - diff

Return to lonlogin.pm CVS log

Up to [LON-CAPA] / loncom / auth

Diff for /loncom/auth/lonlogin.pm between versions 1.67 and 1.83

version 1.67, 2005/06/14 20:09:13	version 1.83, 2006/11/10 02:02:57
Line 36 use Apache::lonnet;	Line 36 use Apache::lonnet;
use Apache::loncommon();	use Apache::loncommon();
use Apache::lonauth();	use Apache::lonauth();
use Apache::lonlocal;	use Apache::lonlocal;
	use Apache::migrateuser();
	use lib '/home/httpd/lib/perl/';
	use LONCAPA;


	sub additional_machine_domains {
	my @domains;
	open(my $fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/expected_domains.tab');
	while( my $line = <$fh>) {
	$line =~ s/\s//g;
	push(@domains,$line);
	}
	return @domains;
	}

sub handler {	sub handler {
my $r = shift;	my $r = shift;

	&Apache::loncommon::get_unprocessed_cgi
	(join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
	$ENV{'REDIRECT_QUERY_STRING'}),
	['interface','username','domain','firsturl','localpath','localres',
	'token']);

	# -- check if they are a migrating user
	if (defined($env{'form.token'})) {
	return &Apache::migrateuser::handler($r);
	}

&Apache::loncommon::no_cache($r);	&Apache::loncommon::no_cache($r);
&Apache::lonlocal::get_language_handle($r);	&Apache::lonlocal::get_language_handle($r);
&Apache::loncommon::content_type($r,'text/html');	&Apache::loncommon::content_type($r,'text/html');
Line 52 sub handler {	Line 78 sub handler {
return OK;	return OK;
}	}


# -------------------------------- Prevent users from attempting to login twice	# -------------------------------- Prevent users from attempting to login twice
my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));	my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
my $lonid=$cookies{'lonID'};	my $lonid=$cookies{'lonID'};
Line 60 sub handler {	Line 87 sub handler {
my $handle=$lonid->value;	my $handle=$lonid->value;
$handle=~s/\W//g;	$handle=~s/\W//g;
my $lonidsdir=$r->dir_config('lonIDsDir');	my $lonidsdir=$r->dir_config('lonIDsDir');
if ((-e "$lonidsdir/$handle.id") && ($handle ne '')) {	if (-e "$lonidsdir/$handle.id") {
	# Is there an existing token file?
	if ($handle=~/^publicuser\_/) {
	# For "public user" - remove it, we apparently really want to login
	unlink("$lonidsdir/$handle.id");
	} elsif ($handle ne '') {
# Indeed, a valid token is found	# Indeed, a valid token is found
my $bodytag=&Apache::loncommon::bodytag('Already logged in');	my $start_page =
$r->print(<<ENDFAILED);	&Apache::loncommon::start_page('Already logged in');
<html>	my $end_page =
<head>	&Apache::loncommon::end_page();
<title>Already logged in</title>	$r->print(<<ENDFAILED);
</head>	$start_page
$bodytag
<h1>You are already logged in</h1>	<h1>You are already logged in</h1>
<p>Please either <a href="/adm/roles">continue the current session</a> or	<p>Please either <a href="/adm/roles">continue the current session</a> or
<a href="/adm/logout">logout</a>.</p>	<a href="/adm/logout">logout</a>.</p>
<p>	<p>
<a href="/adm/loginproblems.html">Problems?</a></p>	<a href="/adm/loginproblems.html">Problems?</a></p>
</body>	$end_page
</html>
ENDFAILED	ENDFAILED
return OK;	return OK;
	}
}	}
}	}

# ---------------------------------------------------- No valid token, continue	# ---------------------------------------------------- No valid token, continue

&Apache::loncommon::get_unprocessed_cgi	# ---------------------------- Not possible to really login to domain "public"
($ENV{'QUERY_STRING'}.'&'.$env{'request.querystring'},	if ($env{'form.domain'} eq 'public') {
['interface','username','domain','firsturl','localpath','localres']);	$env{'form.domain'}='';
	$env{'form.username'}='';
	}
# ----------------------------------------------------------- Process Interface	# ----------------------------------------------------------- Process Interface
$env{'form.interface'}=~s/\W//g;	$env{'form.interface'}=~s/\W//g;

Line 108 ENDFAILED	Line 139 ENDFAILED
my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':'.$port_to_use.	my $iconpath= 'http://'.$ENV{'HTTP_HOST'}.':'.$port_to_use.
$r->dir_config('lonIconsURL');	$r->dir_config('lonIconsURL');
my $domain = $r->dir_config('lonDefDomain');	my $domain = $r->dir_config('lonDefDomain');
	my $testdomain=(split(/\./,$ENV{'HTTP_HOST'}))[0];
	foreach my $posdom (&Apache::lonnet::current_machine_domains(),
	&additional_machine_domains()) {
	if (lc($posdom) eq lc($testdomain)) { $domain=$posdom; }
	}
if (($env{'form.domain'}) &&	if (($env{'form.domain'}) &&
($Apache::lonnet::domaindescription{$env{'form.domain'}})) {	($Apache::lonnet::domaindescription{$env{'form.domain'}})) {
$domain=$env{'form.domain'};	$domain=$env{'form.domain'};
}	}
my $role = $r->dir_config('lonRole');	my $role = $r->dir_config('lonRole');
my $loadlim = $r->dir_config('lonLoadLim');	my $loadlim = $r->dir_config('lonLoadLim');
my $servadm = $r->dir_config('lonAdmEMail');
my $sysadm = $r->dir_config('lonSysEMail');
my $lonhost = $r->dir_config('lonHostID');	my $lonhost = $r->dir_config('lonHostID');
my $tabdir = $r->dir_config('lonTabDir');	my $tabdir = $r->dir_config('lonTabDir');
my $include = $r->dir_config('lonIncludes');	my $include = $r->dir_config('lonIncludes');
my $expire = $r->dir_config('lonExpire');	my $expire = $r->dir_config('lonExpire');
my $version = $r->dir_config('lonVersion');	my $version = $r->dir_config('lonVersion');
	my $host_name = $Apache::lonnet::hostname{$lonhost};

# --------------------------------------------- Default values for login fields	# --------------------------------------------- Default values for login fields

Line 138 ENDFAILED	Line 173 ENDFAILED
my $userloadpercent=&Apache::lonnet::userload();	my $userloadpercent=&Apache::lonnet::userload();

# ------------------------------------------------------- Do the load balancing	# ------------------------------------------------------- Do the load balancing
my $otherserver='http://'.$ENV{'SERVER_NAME'};	my $otherserver= &Apache::lonnet::absolute_url($host_name);
my $firsturl=	my $firsturl=
($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});	($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
# ---------------------------------------- Are we access server and overloaded?	# ---------------------------------------- Are we access server and overloaded?
Line 217 ENDFAILED	Line 252 ENDFAILED
<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />	<img src="/adm/lonKaputt/lonlogo_broken.gif" align="right" />
<h3>This LON-CAPA server is temporarily not available for login</h3>	<h3>This LON-CAPA server is temporarily not available for login</h3>
<p>Please attempt to login to one of the following servers:</p>$spares	<p>Please attempt to login to one of the following servers:</p>$spares
<p>If the problem persists, please contact <tt>$servadm</tt>.</p>
</body>	</body>
</html>	</html>
ENDTROUBLE	ENDTROUBLE
Line 227 ENDTROUBLE	Line 261 ENDTROUBLE
# ----------------------------------------------- Apparently we are in business	# ----------------------------------------------- Apparently we are in business

my $domainlogo=&Apache::loncommon::domainlogo($domain);	my $domainlogo=&Apache::loncommon::domainlogo($domain);
$servadm=~s/\,/\<br \/\>/g;
$sysadm=~s/\,/\<br \/\>/g;

# --------------------------------------------------- Print login screen header	# --------------------------------------------------- Print login screen header
$r->print(<<ENDHEADER);	$r->print(<<ENDHEADER);
Line 276 my %lt=&Apache::lonlocal::texthash(	Line 308 my %lt=&Apache::lonlocal::texthash(
'log' => 'Log in',	'log' => 'Log in',
'help' => 'Help',	'help' => 'Help',
'serv' => 'Server',	'serv' => 'Server',
'servadm' => 'Server Administration',	'helpdesk' => 'Contact Helpdesk',
'sysadm' => 'System Administration',	'forgotpw' => 'Forgot password?');
'helpdesk' => 'Contact Helpdesk');
# -------------------------------------------------- Change password field name	# -------------------------------------------------- Change password field name
my $now=time;	my $now=time;
	my $forgotpw = &forgotpwdisplay(\%lt);
# ---------------------------------------------------------- Serve rest of page	# ---------------------------------------------------------- Serve rest of page
$r->print(<<ENDSCRIPT);	$r->print(<<ENDSCRIPT);

Line 425 ENDTOP	Line 457 ENDTOP
<label><input type="checkbox" name="embedsuppress" /> Suppress rendering of embedded multimedia</label><br />	<label><input type="checkbox" name="embedsuppress" /> Suppress rendering of embedded multimedia</label><br />
<label><input type="checkbox" name="fontenhance" /> Increase font size</label><br />	<label><input type="checkbox" name="fontenhance" /> Increase font size</label><br />
<label><input type="checkbox" name="blackwhite" /> Switch to black and white mode</label><br />	<label><input type="checkbox" name="blackwhite" /> Switch to black and white mode</label><br />
<p>If you have accessibility needs that are not addressed by this interface,
please
contact the system administrator at <tt>$sysadm</tt>.</p><br />
<input type="checkbox" name="remember" /> Remember these settings for next login<hr />	<input type="checkbox" name="remember" /> Remember these settings for next login<hr />
ENDACCESSOPTIONS	ENDACCESSOPTIONS
} else {	} else {
Line 466 ENDNOOPT	Line 495 ENDNOOPT
<input type="submit" value="$lt{'log'}" />	<input type="submit" value="$lt{'log'}" />
</td>	</td>
</tr>	</tr>
	<tr>
	<td bgcolor="$mainbg" valign="bottom" align="left" colspan="2">
	$forgotpw
	</td>
	</tr>
</table>	</table>
<!-- End sub-table -->	<!-- End sub-table -->
</form>	</form>
ENDLOGIN	ENDLOGIN
if ($fullgraph) {	if ($fullgraph) {
my $helpdeskscript;	my $helpdeskscript;
my $contactblock = &contactdisplay(\%lt,$sysadm,$servadm,$version,$authdomain,\$helpdeskscript);	my $contactblock = &contactdisplay(\%lt,$version,$authdomain,\$helpdeskscript);
$r->print(<<ENDDOCUMENT);	$r->print(<<ENDDOCUMENT);
</td>	</td>

Line 568 ENDDOCUMENT	Line 602 ENDDOCUMENT
}	}

sub contactdisplay {	sub contactdisplay {
my ($lt,$sysadm,$servadm,$version,$authdomain,$helpdeskscript) = @_;	my ($lt,$version,$authdomain,$helpdeskscript) = @_;
my $contactblock;	my $contactblock;
my $showsysadm = 1;
my $showservadm = 1;
my $showhelpdesk = 0;	my $showhelpdesk = 0;
my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};	my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {	if ($requestmail =~ m/^[^\@]+\@[^\@]+$/) {
$showhelpdesk = 1;	$showhelpdesk = 1;
}	}
if ($showsysadm) {
$contactblock .= '<b>   '.$$lt{'sysadm'}.':</b><br />'.
'<tt>      '.$sysadm.'</tt><br />';
}
if ($showservadm) {
$contactblock .= '<b>   '.$$lt{'servadm'}.':</b><br />'.
'<tt>      '.$servadm.'</tt><br /> <br />';
}
if ($showhelpdesk) {	if ($showhelpdesk) {
$contactblock .= '<b>   <a href="javascript:helpdesk()">'.$$lt{'helpdesk'}.'</a></b><br />';	$contactblock .= '<b>   <a href="javascript:helpdesk()">'.$$lt{'helpdesk'}.'</a></b><br />';
my $thisurl = &Apache::lonnet::escape('/adm/login');	my $thisurl = &escape('/adm/login');
$$helpdeskscript = <<"ENDSCRIPT";	$$helpdeskscript = <<"ENDSCRIPT";
<script type="text/javascript">	<script type="text/javascript">
function helpdesk() {	function helpdesk() {
Line 607 ENDSCRIPT	Line 631 ENDSCRIPT
ENDBLOCK	ENDBLOCK
return $contactblock;	return $contactblock;
}	}

	sub forgotpwdisplay {
	my ($lt) = @_;
	my $prompt_for_resetpw = 1;
	if ($prompt_for_resetpw) {
	return '<br />   <a href="/adm/resetpw">'.$lt->{'forgotpw'}.'</a></b><br /><br />';
	}
	return;
	}


1;	1;

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

Removed from v.1.67
changed lines
	Added in v.1.83