--- loncom/interface/loncommon.pm 2003/02/12 17:57:27 1.78
+++ loncom/interface/loncommon.pm 2003/02/24 23:32:32 1.83
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.78 2003/02/12 17:57:27 www Exp $
+# $Id: loncommon.pm,v 1.83 2003/02/24 23:32:32 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -81,6 +81,7 @@ use GDBM_File;
use POSIX qw(strftime mktime);
use Apache::Constants qw(:common);
use Apache::lonmsg();
+use Apache::lonmenu();
my $readit;
=pod
@@ -518,6 +519,9 @@ sub help_open_topic {
my ($topic, $text, $stayOnPage, $width, $height) = @_;
$text = "" if (not defined $text);
$stayOnPage = 0 if (not defined $stayOnPage);
+ if ($ENV{'browser.interface'} eq 'textual') {
+ $stayOnPage=1;
+ }
$width = 350 if (not defined $width);
$height = 400 if (not defined $height);
my $filename = $topic;
@@ -711,11 +715,27 @@ See loncreateuser.pm for invocation and
sub authform_header{
my %in = (
formname => 'cu',
- kerb_def_dom => 'MSU.EDU',
+ kerb_def_dom => '',
@_,
);
$in{'formname'} = 'document.' . $in{'formname'};
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";
var current = new Object();
current.radiovalue = 'nochange';
@@ -749,12 +769,7 @@ function changed_radio(choice,currentfor
function changed_text(choice,currentform) {
var choicearg = choice + 'arg';
if (currentform.elements[choicearg].value !='') {
- switch (choice) {
- case 'krb': currentform.elements[choicearg].value =
- currentform.elements[choicearg].value.toUpperCase();
- break;
- default:
- }
+ $Javascript_toUpperCase
// clear old field
if ((current.argfield != choicearg) && (current.argfield != null)) {
currentform.elements[current.argfield].value = '';
@@ -810,18 +825,26 @@ sub authform_kerberos{
my %in = (
formname => 'document.cu',
kerb_def_dom => 'MSU.EDU',
+ kerb_def_auth => 'krb4',
@_,
);
my $result='';
+ my $check4;
+ my $check5;
+ if ($in{'kerb_def_auth'} eq 'krb5') {
+ $check5 = " checked=\"on\"";
+ } else {
+ $check4 = " checked=\"on\"";
+ }
$result.=<<"END";
<input type="radio" name="login" value="krb"
onclick="javascript:changed_radio('krb',$in{'formname'});"
onchange="javascript:changed_radio('krb',$in{'formname'});" />
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'});" />
-<input type="radio" name="krbver" value="4" checked="on" />Version 4
-<input type="radio" name="krbver" value="5" />Version 5
+<input type="radio" name="krbver" value="4" $check4 />Version 4
+<input type="radio" name="krbver" value="5" $check5 />Version 5
END
return $result;
}
@@ -885,6 +908,89 @@ 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 ##
###############################################################
@@ -998,7 +1104,17 @@ sub get_related_words {
###############################################################
# -------------------------------------------------------------- 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 {
my ($uname,$udom)=@_;
my %names=&Apache::lonnet::get('environment',
@@ -1012,7 +1128,21 @@ sub plainname {
}
# -------------------------------------------------------------------- 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 {
my ($uname,$udom)=@_;
@@ -1033,6 +1163,14 @@ sub nickname {
# ------------------------------------------------------------------ Screenname
+=pod
+
+=item screenname($uname,$udom)
+
+Gets a users screenname and returns it as a string
+
+=cut
+
sub screenname {
my ($uname,$udom)=@_;
my %names=
@@ -1344,8 +1482,10 @@ sub domainlogo {
my $domain = &determinedomain(shift);
# See if there is a logo
if (-e '/home/httpd/html/adm/lonDomLogos/'.$domain.'.gif') {
- return '<img src="http://'.$ENV{'HTTP_HOST'}.':8080/adm/lonDomLogos/'.
- $domain.'.gif" />';
+ my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
+ if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
+ return '<img src="http://'.$ENV{'HTTP_HOST'}.':'.$lonhttpdPort.
+ '/adm/lonDomLogos/'.$domain.'.gif" />';
} elsif(exists($Apache::lonnet::domaindescription{$domain})) {
return $Apache::lonnet::domaindescription{$domain};
} else {
@@ -1438,18 +1578,23 @@ sub bodytag {
# Set messages
my $messages=&domainlogo($domain);
# Output
+ my $lonhttpdPort=$Apache::lonnet::perlvar{'lonhttpdPort'};
+ if (!defined($lonhttpdPort)) { $lonhttpdPort='8080'; }
my $bodytag = <<END;
<body bgcolor="$pgbg" text="$font" alink="$alink" vlink="$vlink" link="$link"
$addentries>
END
if ($bodyonly) {
return $bodytag;
+ } elsif ($ENV{'browser.interface'} eq 'textual') {
+ return $bodytag.&Apache::lonmenu::menubuttons(undef,'web').
+ '<h1>LON-CAPA: '.$title.'</h1>';
} else {
return(<<ENDBODY);
$bodytag
<table width="100%" cellspacing="0" border="0" cellpadding="0">
<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>
</tr>
<tr>