--- loncom/auth/lonlogin.pm 2008/12/10 17:45:29 1.106.2.1
+++ loncom/auth/lonlogin.pm 2010/09/02 09:24:42 1.145
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Login Screen
#
-# $Id: lonlogin.pm,v 1.106.2.1 2008/12/10 17:45:29 raeburn Exp $
+# $Id: lonlogin.pm,v 1.145 2010/09/02 09:24:42 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -46,7 +46,7 @@ sub handler {
(join('&',$ENV{'QUERY_STRING'},$env{'request.querystring'},
$ENV{'REDIRECT_QUERY_STRING'}),
['interface','username','domain','firsturl','localpath','localres',
- 'token']);
+ 'token','role','symb']);
if (!defined($env{'form.firsturl'})) {
&Apache::lonacc::get_posted_cgi($r,['firsturl']);
}
@@ -69,27 +69,35 @@ sub handler {
return OK;
}
+ $env{'form.firsturl'} =~ s/(`)/'/g;
# -------------------------------- Prevent users from attempting to login twice
my $handle = &Apache::lonnet::check_for_valid_session($r);
- if ($handle=~/^publicuser\_/) {
+ if ($handle ne '') {
+ my $lonidsdir=$r->dir_config('lonIDsDir');
+ if ($handle=~/^publicuser\_/) {
# For "public user" - remove it, we apparently really want to login
- unlink($r->dir_config('lonIDsDir')."/$handle.id");
- } elsif ($handle ne '') {
+ unlink($r->dir_config('lonIDsDir')."/$handle.id");
+ } else {
# Indeed, a valid token is found
- my $start_page =
- &Apache::loncommon::start_page('Already logged in');
- my $end_page =
- &Apache::loncommon::end_page();
- $r->print(
+ &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
+ my $start_page =
+ &Apache::loncommon::start_page('Already logged in');
+ my $end_page =
+ &Apache::loncommon::end_page();
+ my $dest = '/adm/roles';
+ if ($env{'form.firsturl'} ne '') {
+ $dest = $env{'form.firsturl'};
+ }
+ $r->print(
$start_page
.'
'.&mt('You are already logged in!').' '
- .''.&mt('Please either [_1]continue the current session[_2] or [_3]logout[_4].',
- '',' ','',' ').'
'
- .''.&mt('Login problems?').'
'
+ .''.&mt('Please either [_1]continue the current session[_2] or [_3]log out[_4].',
+ '',' ','',' ').'
'
.$end_page
);
- return OK;
+ return OK;
+ }
}
# ---------------------------------------------------- No valid token, continue
@@ -102,29 +110,29 @@ sub handler {
# ----------------------------------------------------------- Process Interface
$env{'form.interface'}=~s/\W//g;
- my $textbrowsers=$r->dir_config('lonTextBrowsers');
my $httpbrowser=$ENV{"HTTP_USER_AGENT"};
-
- foreach (split(/\:/,$textbrowsers)) {
- if ($httpbrowser=~/$_/i) {
- $env{'form.interface'}='textual';
- }
- }
-
- my $fullgraph=($env{'form.interface'} ne 'textual');
my $iconpath=
&Apache::loncommon::lonhttpdurl($r->dir_config('lonIconsURL'));
+ my $lonhost = $r->dir_config('lonHostID');
my $domain = &Apache::lonnet::default_login_domain();
+ if ($lonhost ne '') {
+ my $redirect = &check_loginvia($domain,$lonhost);
+ if ($redirect) {
+ $r->print($redirect);
+ return OK;
+ }
+ }
+
if (($env{'form.domain'}) &&
(&Apache::lonnet::domain($env{'form.domain'},'description'))) {
$domain=$env{'form.domain'};
}
my $role = $r->dir_config('lonRole');
my $loadlim = $r->dir_config('lonLoadLim');
+ my $uloadlim= $r->dir_config('lonUserLoadLim');
my $servadm = $r->dir_config('lonAdmEMail');
- my $lonhost = $r->dir_config('lonHostID');
my $tabdir = $r->dir_config('lonTabDir');
my $include = $r->dir_config('lonIncludes');
my $expire = $r->dir_config('lonExpire');
@@ -144,17 +152,12 @@ sub handler {
}
$loadavg =~ s/\s.*//g;
my $loadpercent=sprintf("%.1f",100*$loadavg/$loadlim);
+ unless ($loadlim) { $loadpercent='---'; }
my $userloadpercent=&Apache::lonnet::userload();
+ unless ($uloadlim) { $userloadpercent='---'; }
-# ------------------------------------------------------- Do the load balancing
- my $otherserver= &Apache::lonnet::absolute_url($host_name);
my $firsturl=
($env{'request.firsturl'}?$env{'request.firsturl'}:$env{'form.firsturl'});
-# ---------------------------------------------------------- Are we overloaded?
- if ((($userloadpercent>100.0)||($loadpercent>100.0))) {
- my $unloaded=Apache::lonnet::spareserver($loadpercent,$userloadpercent);
- if ($unloaded) { $otherserver=$unloaded; }
- }
# ----------------------------------------------------------- Get announcements
my $announcements=&Apache::lonnet::getannounce();
@@ -179,8 +182,18 @@ sub handler {
if ($uextkey>2147483647) { $uextkey-=4294967296; }
# -------------------------------------------------------- Store away log token
+ my $tokenextras;
+ if ($env{'form.role'}) {
+ $tokenextras = '&role='.&escape($env{'form.role'});
+ }
+ if ($env{'form.symb'}) {
+ if (!$tokenextras) {
+ $tokenextras = '&';
+ }
+ $tokenextras .= '&symb='.&escape($env{'form.symb'});
+ }
my $logtoken=Apache::lonnet::reply(
- 'tmpput:'.$ukey.$lkey.'&'.$firsturl,
+ 'tmpput:'.$ukey.$lkey.'&'.$firsturl.$tokenextras,
$lonhost);
# ------------------- If we cannot talk to ourselves, we are in serious trouble
@@ -204,476 +217,374 @@ sub handler {
' '.&mt('(preferred)').''.$/;
$last=$hostname;
}
- $spares.= ' ';
- my %all_hostnames = &Apache::lonnet::all_hostnames();
- foreach my $hostid (sort
- {
- &Apache::lonnet::hostname($a) cmp
- &Apache::lonnet::hostname($b);
- }
- keys(%all_hostnames)) {
- next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});
- my $hostname = &Apache::lonnet::hostname($hostid);
- next if ($last eq $hostname);
- $spares.=''.
- $hostname.' ';
- $last=$hostname;
- }
- $r->print(
- ''
- .''
- .&mt('The LearningOnline Network with CAPA')
- .' '
- .''
- .''.&mt('The LearningOnline Network with CAPA').' '
- .' '
- .''.&mt('This LON-CAPA server is temporarily not available for login.').' '
- .''.&mt('Please attempt to login to one of the following servers:').'
'
- .$spares
- .''
- .''
- );
- return OK;
- }
+$spares.= ' ';
+my %all_hostnames = &Apache::lonnet::all_hostnames();
+foreach my $hostid (sort
+ {
+ &Apache::lonnet::hostname($a) cmp
+ &Apache::lonnet::hostname($b);
+ }
+ keys(%all_hostnames)) {
+ next if ($hostid eq $lonhost || $Apache::lonnet::spareid{$hostid});
+ my $hostname = &Apache::lonnet::hostname($hostid);
+ next if ($last eq $hostname);
+ $spares.=''.
+ $hostname.' ';
+ $last=$hostname;
+}
+$r->print(
+ ''
+ .''
+ .&mt('The LearningOnline Network with CAPA')
+ .' '
+ .''
+ .''.&mt('The LearningOnline Network with CAPA').' '
+ .' '
+ .''.&mt('This LON-CAPA server is temporarily not available for login.').' '
+ .''.&mt('Please attempt to login to one of the following servers:').'
'
+ .$spares
+ .''
+ .''
+);
+return OK;
+}
# ----------------------------------------------- Apparently we are in business
- $servadm=~s/\,/\ /g;
+$servadm=~s/\,/\ /g;
# ----------------------------------------------------------- Front page design
- my $pgbg=
- ($fullgraph?&Apache::loncommon::designparm('login.pgbg',$domain):'#FFFFFF');
- my $font=
- ($fullgraph?&Apache::loncommon::designparm('login.font',$domain):'#000000');
- my $link=
- ($fullgraph?&Apache::loncommon::designparm('login.link',$domain):'#0000FF');
- my $vlink=
- ($fullgraph?&Apache::loncommon::designparm('login.vlink',$domain):'#0000FF');
- my $alink=&Apache::loncommon::designparm('login.alink',$domain);
- my $mainbg=
- ($fullgraph?&Apache::loncommon::designparm('login.mainbg',$domain):'#FFFFFF');
- my $sidebg=
- ($fullgraph?&Apache::loncommon::designparm('login.sidebg',$domain):'#FFFFFF');
- my $textcol =
- ($fullgraph?&Apache::loncommon::designparm('login.textcol',$domain):'#000000');
- my $bgcol =
- ($fullgraph?&Apache::loncommon::designparm('login.bgcol',$domain):'#FFFFFF');
- my $logo=&Apache::loncommon::designparm('login.logo',$domain);
- my $img=&Apache::loncommon::designparm('login.img',$domain);
- my $domainlogo=&Apache::loncommon::domainlogo($domain);
- my $login=&Apache::loncommon::designparm('login.login',$domain);
- if ($login eq '') {
- $login = $iconpath.'/'.&mt('userauthentication.gif');
- }
- my $showbanner = 1;
- my $showmainlogo = 1;
- if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
- $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
- }
- if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
- $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
- }
- my $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
- my $showcoursecat =
- &Apache::loncommon::designparm('login.coursecatalog',$domain);
- my $loginheader =&Apache::loncommon::designparm('login.loginheader',$domain);
- my $shownewuserlink =
- &Apache::loncommon::designparm('login.newuser',$domain);
- my $now=time;
- my $js = (<
- function send()
- {
- this.document.server.elements.uname.value
- =this.document.client.elements.uname.value;
-
- this.document.server.elements.udom.value
- =this.document.client.elements.udom.value;
-
- this.document.server.elements.imagesuppress.value
- =this.document.client.elements.imagesuppress.checked;
-
- this.document.server.elements.embedsuppress.value
- =this.document.client.elements.embedsuppress.checked;
-
- this.document.server.elements.appletsuppress.value
- =this.document.client.elements.appletsuppress.checked;
-
- this.document.server.elements.fontenhance.value
- =this.document.client.elements.fontenhance.checked;
-
- this.document.server.elements.blackwhite.value
- =this.document.client.elements.blackwhite.checked;
-
- this.document.server.elements.remember.value
- =this.document.client.elements.remember.checked;
+my $pgbg=&Apache::loncommon::designparm('login.pgbg',$domain);
+my $font=&Apache::loncommon::designparm('login.font',$domain);
+my $link=&Apache::loncommon::designparm('login.link',$domain);
+my $vlink=&Apache::loncommon::designparm('login.vlink',$domain);
+my $alink=&Apache::loncommon::designparm('login.alink',$domain);
+my $mainbg=&Apache::loncommon::designparm('login.mainbg',$domain);
+my $loginbox_bg=&Apache::loncommon::designparm('login.sidebg',$domain);
+my $loginbox_header_bgcol=&Apache::loncommon::designparm('login.bgcol',$domain);
+my $loginbox_header_textcol=&Apache::loncommon::designparm('login.textcol',$domain);
+my $logo=&Apache::loncommon::designparm('login.logo',$domain);
+my $img=&Apache::loncommon::designparm('login.img',$domain);
+my $domainlogo=&Apache::loncommon::domainlogo($domain);
+my $showbanner = 1;
+my $showmainlogo = 1;
+if (defined(&Apache::loncommon::designparm('login.showlogo_img',$domain))) {
+ $showbanner = &Apache::loncommon::designparm('login.showlogo_img',$domain);
+}
+if (defined(&Apache::loncommon::designparm('login.showlogo_logo',$domain))) {
+ $showmainlogo = &Apache::loncommon::designparm('login.showlogo_logo',$domain);
+}
+my $showadminmail=&Apache::loncommon::designparm('login.adminmail',$domain);
+my $showcoursecat =
+&Apache::loncommon::designparm('login.coursecatalog',$domain);
+my $shownewuserlink =
+&Apache::loncommon::designparm('login.newuser',$domain);
+my $now=time;
+my $js = (<
+//
+// ]]>
+
ENDSCRIPT
# --------------------------------------------------- Print login screen header
- my %add_entries = (topmargin => "0",
- leftmargin => "0",
- marginheight => "0",
- marginwidth => "0",
- bgcolor => "$pgbg",
- text => "$font",
- link => "$link",
- vlink => "$vlink",
- alink => "$alink",);
-
- $r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
- { 'redirect' => [$expire,'/adm/roles'],
- 'add_entries' => \%add_entries,
- 'only_body' => 1,}));
+my %add_entries = (
+ bgcolor => "$mainbg",
+ text => "$font",
+ link => "$link",
+ vlink => "$vlink",
+ alink => "$alink",
+ onload => 'javascript:enableInput();',);
+
+$r->print(&Apache::loncommon::start_page('The LearningOnline Network with CAPA Login',$js,
+ { 'redirect' => [$expire,'/adm/roles'],
+ 'add_entries' => \%add_entries,
+ 'only_body' => 1,}));
# ----------------------------------------------------------------------- Texts
my %lt=&Apache::lonlocal::texthash(
- 'un' => 'Username',
- 'pw' => 'Password',
- 'dom' => 'Domain',
- 'perc' => 'percent',
- 'load' => 'Server Load',
- 'userload' => 'User Load',
- 'about' => 'About LON-CAPA',
- 'access' => 'Accessibility Options',
- 'catalog' => 'Course Catalog',
- 'log' => 'Log in',
- 'help' => 'Log-in Help',
- 'serv' => 'Server',
- 'servadm' => 'Server Administration',
- 'helpdesk' => 'Contact Helpdesk',
- 'forgotpw' => 'Forgot password?',
- 'newuser' => 'New User?',
- 'options_headline' => 'Select Accessibility Options',
- 'sprs_img' => 'Suppress rendering of images',
- 'sprs_applet' => 'Suppress Java applets',
- 'sprs_embed' => 'Suppress rendering of embedded multimedia',
- 'sprs_font' => 'Increase font size',
- 'sprs_blackwhite' => 'Switch to black and white mode',
- 'remember' => 'Remember these settings for next login');
+ 'un' => 'Username',
+ 'pw' => 'Password',
+ 'dom' => 'Domain',
+ 'perc' => 'percent',
+ 'load' => 'Server Load',
+ 'userload' => 'User Load',
+ 'catalog' => 'Course/Community Catalog',
+ 'log' => 'Log in',
+ 'help' => 'Log-in Help',
+ 'serv' => 'Server',
+ 'servadm' => 'Server Administration',
+ 'helpdesk' => 'Contact Helpdesk',
+ 'forgotpw' => 'Forgot password?',
+ 'newuser' => 'New User?',
+ );
# -------------------------------------------------- Change password field name
- my $forgotpw = &forgotpwdisplay(%lt);
- my $loginhelp = &loginhelpdisplay(%lt);
+
+my $forgotpw = &forgotpwdisplay(%lt);
+$forgotpw .= ' ' if $forgotpw;
+my $loginhelp = &loginhelpdisplay($authdomain,%lt);
+$loginhelp .= ' ' if $loginhelp;
# ---------------------------------------------------- Serve out DES JavaScript
- {
- my $jsh=Apache::File->new($include."/londes.js");
- $r->print(<$jsh>);
- }
+{
+my $jsh=Apache::File->new($include."/londes.js");
+$r->print(<$jsh>);
+}
# ---------------------------------------------------------- Serve rest of page
- if ($fullgraph) {
- $r->print(
- '');
- }
+$r->print(
+ ''
+);
+
+#
+# If the loadbalancing yielded just http:// because perhaps there's no loadbalancing?
+# then just us a relative link to authenticate:
+#
- $r->print(<
+$r->print(<
-
-
-
-
-
-
-
ENDSERVERFORM
- my $coursecatalog;
- if (($showcoursecat eq '') || ($showcoursecat)) {
- $coursecatalog = &coursecatalog_link($lt{'catalog'});
- }
- my $newuserlink;
- if ($shownewuserlink) {
- $newuserlink = &newuser_link($lt{'newuser'});
- }
- if ($fullgraph) {
- $r->print(<
-
+my $coursecatalog;
+if (($showcoursecat eq '') || ($showcoursecat)) {
+ $coursecatalog = &coursecatalog_link($lt{'catalog'}).' ';
+}
+my $newuserlink;
+if ($shownewuserlink) {
+ $newuserlink = &newuser_link($lt{'newuser'}).' ';
+}
+my $logintitle =
+ ''
+ .$lt{'log'}
+ .' ';
+
+my $noscript_warning=''
+ .&mt('Use of LON-CAPA requires Javascript to be enabled in your web browser.')
+ .' ';
+my $helpdeskscript;
+my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
+ $authdomain,\$helpdeskscript);
+
+my $loginform=(<
+
+
+ $lt{'un'} :
+
+ $lt{'pw'} :
+
+ $lt{'dom'} :
+
+
+
+LFORM
-
-
+ if ($showbanner) {
+ $r->print(<
+
+
+
HEADER
- if ($showbanner) {
- $r->print(<
-ENDBANNER
- }
- $r->print(<
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-ENDSTART
- if ($showmainlogo) {
- $r->print(<
-
-
-ENDLOGO
- }
- $r->print(<
+ }
+ $r->print(<
+
+ $logintitle
+ $loginform
+ $noscript_warning
+
+
+
+ $loginhelp
+ $forgotpw
+ $contactblock
+ $newuserlink
+ $coursecatalog
+
+
-
-
-
-
-
-
-
-
+
ENDTOP
- } else {
- $r->print('
The LearningOnline Network with CAPA '
- .'
'.&mt('Text-based Interface Login').' '
- .$announcements);
- }
- $r->print('
-ENDLOGIN
- if ($fullgraph) {
- my $helpdeskscript;
- my $contactblock = &contactdisplay(\%lt,$servadm,$showadminmail,
- $version,$authdomain,\$helpdeskscript);
- $r->print(<
-
-
-
-
-
-$announcements
-
-
-
-
-
-
-
-
-
-
+ if ($showmainlogo) {
+ $r->print(' '."\n");
+ }
+$r->print(<
+
+ENDTOP
+
+$r->print(<
+
-
- $lt{'dom'}:
+
+ $lt{'dom'}:
-
+
$domain
-
- $lt{'serv'}:
+
+ $lt{'serv'}:
-
+
$lonhost ($role)
-
- $lt{'load'}:
+
+ $lt{'load'}:
-
+
$loadpercent $lt{'perc'}
-
- $lt{'userload'}:
+
+ $lt{'userload'}:
-
+
$userloadpercent $lt{'perc'}
+
+
+ $version
+
+
-
- $contactblock
-
-
-
-
-
-
-
-$domainlogo
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+ $domainlogo
+
+
+
$helpdeskscript
ENDDOCUMENT
-}
my %endargs = ( 'noredirectlink' => 1, );
$r->print(&Apache::loncommon::end_page(\%endargs));
return OK;
}
+sub check_loginvia {
+ my ($domain,$lonhost) = @_;
+ if ($domain eq '' || $lonhost eq '') {
+ return;
+ }
+ my %domconfhash = &Apache::loncommon::get_domainconf($domain);
+ my $loginvia = $domconfhash{$domain.'.login.loginvia_'.$lonhost};
+ my $loginvia_exempt = $domconfhash{$domain.'.login.loginvia_exempt_'.$lonhost};
+ my $output;
+ if ($loginvia ne '') {
+ my $noredirect;
+ my $ip = $ENV{'REMOTE_ADDR'};
+ if ($ip eq '127.0.0.1') {
+ $noredirect = 1;
+ } else {
+ if ($loginvia_exempt ne '') {
+ my @exempt = split(',',$loginvia_exempt);
+ if (grep(/^\Q$ip\E$/,@exempt)) {
+ $noredirect = 1;
+ }
+ }
+ }
+ unless ($noredirect) {
+ my ($newhost,$path);
+ if ($loginvia =~ /:/) {
+ ($newhost,$path) = split(':',$loginvia);
+ } else {
+ $newhost = $loginvia;
+ }
+ if ($newhost ne $lonhost) {
+ if (&Apache::lonnet::hostname($newhost) ne '') {
+ $output = &redirect_page($newhost,$path);
+ }
+ }
+ }
+ }
+ return $output;
+}
+
+sub redirect_page {
+ my ($desthost,$path) = @_;
+ my $protocol = $Apache::lonnet::protocol{$desthost};
+ $protocol = 'http' if ($protocol ne 'https');
+ unless ($path =~ m{^/}) {
+ $path = '/'.$path;
+ }
+ my $url = $protocol.'://'.&Apache::lonnet::hostname($desthost).$path;
+ if ($env{'form.firsturl'} ne '') {
+ $url .='?firsturl='.$env{'form.firsturl'};
+ }
+ my $start_page = &Apache::loncommon::start_page('Switching Server ...',undef,
+ {'redirect' => [0,$url],});
+ my $end_page = &Apache::loncommon::end_page();
+ return $start_page.$end_page;
+}
+
sub contactdisplay {
- my ($lt,$servadm,$showadminmail,$version,$authdomain,$helpdeskscript) = @_;
+ my ($lt,$servadm,$showadminmail,$authdomain,$helpdeskscript) = @_;
my $contactblock;
my $showhelpdesk = 0;
my $requestmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
@@ -681,14 +592,15 @@ sub contactdisplay {
$showhelpdesk = 1;
}
if ($servadm && $showadminmail) {
- $contactblock .= ' '.$$lt{'servadm'}.': '.
- ' '.$servadm.' ';
+ $contactblock .= $$lt{'servadm'}.': '.
+ ''.$servadm.' ';
}
if ($showhelpdesk) {
- $contactblock .= ' '.$lt->{'helpdesk'}.' ';
+ $contactblock .= ''.$lt->{'helpdesk'}.' ';
my $thisurl = &escape('/adm/login');
$$helpdeskscript = <<"ENDSCRIPT";
ENDSCRIPT
}
- $contactblock .= <<"ENDBLOCK";
- $version
-ENDBLOCK
return $contactblock;
}
@@ -711,16 +621,26 @@ sub forgotpwdisplay {
my (%lt) = @_;
my $prompt_for_resetpw = 1;
if ($prompt_for_resetpw) {
- return ' '.$lt{'forgotpw'}.' ';
+ return ''.$lt{'forgotpw'}.' ';
}
return;
}
sub loginhelpdisplay {
- my (%lt) = @_;
+ my ($authdomain,%lt) = @_;
my $login_help = 1;
if ($login_help) {
- return ' '.$lt{'help'}.' ';
+ my $dom = $authdomain;
+ if ($dom eq '') {
+ $dom = &Apache::lonnet::default_login_domain();
+ }
+ my %helpconfig = &Apache::lonnet::get_dom('configuration',['helpsettings'],$dom);
+ my $loginhelp_url = $helpconfig{'helpsettings'}{'loginhelpurl'};
+ if ($loginhelp_url ne '') {
+ return ''.$lt{'help'}.' ';
+ } else {
+ return ''.$lt{'help'}.' ';
+ }
}
return;
}
@@ -728,16 +648,13 @@ sub loginhelpdisplay {
sub coursecatalog_link {
my ($linkname) = @_;
return <<"END";
-
-
- $linkname
-
+ $linkname
END
}
sub newuser_link {
my ($linkname) = @_;
- return ' '.$linkname.' ';
+ return ''.$linkname.' ';
}
1;