version 1.79, 2003/02/13 18:11:26
|
version 1.83, 2003/02/24 23:32:32
|
Line 81 use GDBM_File;
|
Line 81 use GDBM_File;
|
use POSIX qw(strftime mktime); |
use POSIX qw(strftime mktime); |
use Apache::Constants qw(:common); |
use Apache::Constants qw(:common); |
use Apache::lonmsg(); |
use Apache::lonmsg(); |
|
use Apache::lonmenu(); |
my $readit; |
my $readit; |
|
|
=pod |
=pod |
Line 714 See loncreateuser.pm for invocation and
|
Line 715 See loncreateuser.pm for invocation and
|
sub authform_header{ |
sub authform_header{ |
my %in = ( |
my %in = ( |
formname => 'cu', |
formname => 'cu', |
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => '', |
@_, |
@_, |
); |
); |
$in{'formname'} = 'document.' . $in{'formname'}; |
$in{'formname'} = 'document.' . $in{'formname'}; |
my $result=''; |
my $result=''; |
|
|
|
#---------------------------------------------- Code for upper case translation |
|
my $Javascript_toUpperCase; |
|
unless ($in{kerb_def_dom}) { |
|
$Javascript_toUpperCase =<<"END"; |
|
switch (choice) { |
|
case 'krb': currentform.elements[choicearg].value = |
|
currentform.elements[choicearg].value.toUpperCase(); |
|
break; |
|
default: |
|
} |
|
END |
|
} else { |
|
$Javascript_toUpperCase = ""; |
|
} |
|
|
$result.=<<"END"; |
$result.=<<"END"; |
var current = new Object(); |
var current = new Object(); |
current.radiovalue = 'nochange'; |
current.radiovalue = 'nochange'; |
Line 752 function changed_radio(choice,currentfor
|
Line 769 function changed_radio(choice,currentfor
|
function changed_text(choice,currentform) { |
function changed_text(choice,currentform) { |
var choicearg = choice + 'arg'; |
var choicearg = choice + 'arg'; |
if (currentform.elements[choicearg].value !='') { |
if (currentform.elements[choicearg].value !='') { |
switch (choice) { |
$Javascript_toUpperCase |
case 'krb': currentform.elements[choicearg].value = |
|
currentform.elements[choicearg].value.toUpperCase(); |
|
break; |
|
default: |
|
} |
|
// clear old field |
// clear old field |
if ((current.argfield != choicearg) && (current.argfield != null)) { |
if ((current.argfield != choicearg) && (current.argfield != null)) { |
currentform.elements[current.argfield].value = ''; |
currentform.elements[current.argfield].value = ''; |
Line 813 sub authform_kerberos{
|
Line 825 sub authform_kerberos{
|
my %in = ( |
my %in = ( |
formname => 'document.cu', |
formname => 'document.cu', |
kerb_def_dom => 'MSU.EDU', |
kerb_def_dom => 'MSU.EDU', |
|
kerb_def_auth => 'krb4', |
@_, |
@_, |
); |
); |
my $result=''; |
my $result=''; |
|
my $check4; |
|
my $check5; |
|
if ($in{'kerb_def_auth'} eq 'krb5') { |
|
$check5 = " checked=\"on\""; |
|
} else { |
|
$check4 = " checked=\"on\""; |
|
} |
$result.=<<"END"; |
$result.=<<"END"; |
<input type="radio" name="login" value="krb" |
<input type="radio" name="login" value="krb" |
onclick="javascript:changed_radio('krb',$in{'formname'});" |
onclick="javascript:changed_radio('krb',$in{'formname'});" |
onchange="javascript:changed_radio('krb',$in{'formname'});" /> |
onchange="javascript:changed_radio('krb',$in{'formname'});" /> |
Kerberos authenticated with domain |
Kerberos authenticated with domain |
<input type="text" size="10" name="krbarg" value="" |
<input type="text" size="10" name="krbarg" value="$in{'kerb_def_dom'}" |
onchange="javascript:changed_text('krb',$in{'formname'});" /> |
onchange="javascript:changed_text('krb',$in{'formname'});" /> |
<input type="radio" name="krbver" value="4" checked="on" />Version 4 |
<input type="radio" name="krbver" value="4" $check4 />Version 4 |
<input type="radio" name="krbver" value="5" />Version 5 |
<input type="radio" name="krbver" value="5" $check5 />Version 5 |
END |
END |
return $result; |
return $result; |
} |
} |
Line 888 END
|
Line 908 END
|
############################################################### |
############################################################### |
|
|
############################################################### |
############################################################### |
|
## Get Authentication Defaults for Domain ## |
|
############################################################### |
|
## |
|
## Returns default authentication type and an associated argument |
|
## as listed in file domain.tab |
|
## |
|
#------------------------------------------- |
|
|
|
=pod |
|
|
|
=item get_auth_defaults |
|
|
|
get_auth_defaults($target_domain) returns the default authentication |
|
type and an associated argument (initial password or a kerberos domain). |
|
These values are stored in lonTabs/domain.tab |
|
|
|
($def_auth, $def_arg) = &get_auth_defaults($target_domain); |
|
|
|
If target_domain is not found in domain.tab, returns nothing (''). |
|
|
|
=over 4 |
|
|
|
=item get_auth_defaults |
|
|
|
=back |
|
|
|
=cut |
|
|
|
#------------------------------------------- |
|
sub get_auth_defaults { |
|
my $domain=shift; |
|
return ($Apache::lonnet::domain_auth_def{$domain},$Apache::lonnet::domain_auth_arg_def{$domain}); |
|
} |
|
############################################################### |
|
## End Get Authentication Defaults for Domain ## |
|
############################################################### |
|
|
|
############################################################### |
|
## Get Kerberos Defaults for Domain ## |
|
############################################################### |
|
## |
|
## Returns default kerberos version and an associated argument |
|
## as listed in file domain.tab. If not listed, provides |
|
## appropriate default domain and kerberos version. |
|
## |
|
#------------------------------------------- |
|
|
|
=pod |
|
|
|
=item get_kerberos_defaults |
|
|
|
get_kerberos_defaults($target_domain) returns the default kerberos |
|
version and domain. If not found in domain.tabs, it defaults to |
|
version 4 and the domain of the server. |
|
|
|
($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); |
|
|
|
=over 4 |
|
|
|
=item get_kerberos_defaults |
|
|
|
=back |
|
|
|
=cut |
|
|
|
#------------------------------------------- |
|
sub get_kerberos_defaults { |
|
my $domain=shift; |
|
my ($krbdef,$krbdefdom) = |
|
&Apache::loncommon::get_auth_defaults($domain); |
|
unless ($krbdef =~/^krb/ && $krbdefdom) { |
|
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; |
|
my $krbdefdom=$1; |
|
$krbdefdom=~tr/a-z/A-Z/; |
|
$krbdef = "krb4"; |
|
} |
|
return ($krbdef,$krbdefdom); |
|
} |
|
############################################################### |
|
## End Get Kerberos Defaults for Domain ## |
|
############################################################### |
|
|
|
############################################################### |
## Thesaurus Functions ## |
## Thesaurus Functions ## |
############################################################### |
############################################################### |
|
|
Line 1001 sub get_related_words {
|
Line 1104 sub get_related_words {
|
############################################################### |
############################################################### |
|
|
# -------------------------------------------------------------- Plaintext name |
# -------------------------------------------------------------- Plaintext name |
|
=pod |
|
|
|
=item plainname($uname,$udom) |
|
|
|
Gets a users name and returns it as a string in |
|
"first middle last generation" |
|
form |
|
|
|
=cut |
|
|
|
############################################################### |
sub plainname { |
sub plainname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
my %names=&Apache::lonnet::get('environment', |
my %names=&Apache::lonnet::get('environment', |
Line 1015 sub plainname {
|
Line 1128 sub plainname {
|
} |
} |
|
|
# -------------------------------------------------------------------- Nickname |
# -------------------------------------------------------------------- Nickname |
|
=pod |
|
|
|
=item nickname($uname,$udom) |
|
|
|
Gets a users name and returns it as a string as |
|
|
|
""nickname"" |
|
|
|
if the user has a nickname or |
|
|
|
"first middle last generation" |
|
|
|
if the user does not |
|
|
|
=cut |
|
|
sub nickname { |
sub nickname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
Line 1036 sub nickname {
|
Line 1163 sub nickname {
|
|
|
# ------------------------------------------------------------------ Screenname |
# ------------------------------------------------------------------ Screenname |
|
|
|
=pod |
|
|
|
=item screenname($uname,$udom) |
|
|
|
Gets a users screenname and returns it as a string |
|
|
|
=cut |
|
|
sub screenname { |
sub screenname { |
my ($uname,$udom)=@_; |
my ($uname,$udom)=@_; |
my %names= |
my %names= |
Line 1347 sub domainlogo {
|
Line 1482 sub domainlogo {
|
my $domain = &determinedomain(shift); |
my $domain = &determinedomain(shift); |
# See if there is a logo |
# See if there is a logo |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { |
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') { |
return '<img src="http://'.$ENV{'HTTP_HOST'}.':8080/adm/lonDomLogos/'. |
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
$domain.'.gif" />'; |
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
|
return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort. |
|
'/adm/lonDomLogos/'.$domain.'.gif" />'; |
} elsif(exists($Apache::lonnet::domaindescription{$domain})) { |
} elsif(exists($Apache::lonnet::domaindescription{$domain})) { |
return $Apache::lonnet::domaindescription{$domain}; |
return $Apache::lonnet::domaindescription{$domain}; |
} else { |
} else { |
Line 1441 sub bodytag {
|
Line 1578 sub bodytag {
|
# Set messages |
# Set messages |
my $messages=&domainlogo($domain); |
my $messages=&domainlogo($domain); |
# Output |
# Output |
|
my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'}; |
|
if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; } |
my $bodytag = <<END; |
my $bodytag = <<END; |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link" |
$addentries> |
$addentries> |
Line 1448 END
|
Line 1587 END
|
if ($bodyonly) { |
if ($bodyonly) { |
return $bodytag; |
return $bodytag; |
} elsif ($ENV{'browser.interface'} eq 'textual') { |
} elsif ($ENV{'browser.interface'} eq 'textual') { |
return $bodytag.'<h1>LON-CAPA: '.$title. |
return $bodytag.&Apache::lonmenu::menubuttons(undef,'web'). |
'</h1><a href="/adm/menu">Main Menu</a><hr />'; |
'<h1>LON-CAPA: '.$title.'</h1>'; |
} else { |
} else { |
return(<<ENDBODY); |
return(<<ENDBODY); |
$bodytag |
$bodytag |
<table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<table width="100%" cellspacing="0" border="0" cellpadding="0"> |
<tr><td bgcolor="$font"> |
<tr><td bgcolor="$font"> |
<img src="http://$ENV{'HTTP_HOST'}:8080/$img" /></td> |
<img src="http://$ENV{'HTTP_HOST'}:$lonhttpdPort$img" /></td> |
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td> |
<td bgcolor="$font"><font color='$sidebg'>$messages</font></td> |
</tr> |
</tr> |
<tr> |
<tr> |