version 1.639, 2008/02/01 23:03:13
|
version 1.643, 2008/03/03 10:50:26
|
Line 78 my $readit;
|
Line 78 my $readit;
|
## Global Variables |
## Global Variables |
## |
## |
|
|
|
|
|
# ----------------------------------------------- SSI with retries: |
|
# |
|
|
|
=pod |
|
|
|
=head1 Server Side incliude with retries: |
|
|
|
=over 4 |
|
|
|
=item * ssi_with_retries(resource, retries form) |
|
|
|
Performs an ssi with some number of retries. Retries continue either |
|
until the result is ok or until the retry count supplied by the |
|
caller is exhausted. |
|
|
|
Inputs: |
|
resource - Identifies the resource to insert. |
|
retries - Count of the number of retries allowed. |
|
form - Hash that identifies the rendering options. |
|
|
|
Returns: |
|
content - The content of the response. If retries were exhausted this is empty. |
|
response - The response from the last attempt (which may or may not have been successful. |
|
|
|
=cut |
|
|
|
sub ssi_with_retries { |
|
my ($resource, $retries, %form) = @_; |
|
|
|
|
|
my $ok = 0; # True if we got a good response. |
|
my $content; |
|
my $response; |
|
|
|
# Try to get the ssi done. within the retries count: |
|
|
|
do { |
|
($content, $response) = &Apache::lonnet::ssi($resource, %form); |
|
$ok = $response->is_success; |
|
$retries--; |
|
} while (!$ok && ($retries > 0)); |
|
|
|
if (!$ok) { |
|
$content = ''; # On error return an empty content. |
|
} |
|
return ($content, $response); |
|
|
|
} |
|
|
|
|
|
|
# ----------------------------------------------- Filetypes/Languages/Copyright |
# ----------------------------------------------- Filetypes/Languages/Copyright |
my %language; |
my %language; |
my %supported_language; |
my %supported_language; |
Line 2242 sub get_assignable_auth {
|
Line 2294 sub get_assignable_auth {
|
} |
} |
|
|
############################################################### |
############################################################### |
## Get Authentication Defaults for Domain ## |
|
############################################################### |
|
|
|
=pod |
|
|
|
=head1 Domains and Authentication |
|
|
|
Returns default authentication type and an associated argument as |
|
listed in file 'domain.tab'. |
|
|
|
=over 4 |
|
|
|
=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 (''). |
|
|
|
=cut |
|
|
|
#------------------------------------------- |
|
sub get_auth_defaults { |
|
my $domain=shift; |
|
return (&Apache::lonnet::domain($domain,'auth_def'), |
|
&Apache::lonnet::domain($domain,'auth_arg_def')); |
|
|
|
} |
|
############################################################### |
|
## End Get Authentication Defaults for Domain ## |
|
############################################################### |
|
|
|
############################################################### |
|
## Get Kerberos Defaults for Domain ## |
## Get Kerberos Defaults for Domain ## |
############################################################### |
############################################################### |
## |
## |
Line 2292 sub get_auth_defaults {
|
Line 2308 sub get_auth_defaults {
|
=item * get_kerberos_defaults |
=item * get_kerberos_defaults |
|
|
get_kerberos_defaults($target_domain) returns the default kerberos |
get_kerberos_defaults($target_domain) returns the default kerberos |
version and domain. If not found in domain.tabs, it defaults to |
version and domain. If not found, it defaults to version 4 and the |
version 4 and the domain of the server. |
domain of the server. |
|
|
($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); |
($def_version, $def_krb_domain) = &get_kerberos_defaults($target_domain); |
|
|
Line 2302 version 4 and the domain of the server.
|
Line 2318 version 4 and the domain of the server.
|
#------------------------------------------- |
#------------------------------------------- |
sub get_kerberos_defaults { |
sub get_kerberos_defaults { |
my $domain=shift; |
my $domain=shift; |
my ($krbdef,$krbdefdom) = |
my ($krbdef,$krbdefdom); |
&Apache::loncommon::get_auth_defaults($domain); |
my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); |
unless ($krbdef =~/^krb/ && $krbdefdom) { |
if (($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) { |
|
$krbdef = $domdefaults{'auth_def'}; |
|
$krbdefdom = $domdefaults{'auth_arg_def'}; |
|
} else { |
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; |
$ENV{'SERVER_NAME'}=~/(\w+\.\w+)$/; |
my $krbdefdom=$1; |
my $krbdefdom=$1; |
$krbdefdom=~tr/a-z/A-Z/; |
$krbdefdom=~tr/a-z/A-Z/; |
Line 2883 sub preferred_languages {
|
Line 2902 sub preferred_languages {
|
map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); |
map { (split(/\s*;\s*/,$_))[0] } (split(/\s*,\s*/,$browser)); |
push(@languages,@browser); |
push(@languages,@browser); |
} |
} |
if (&Apache::lonnet::domain($env{'user.domain'},'lang_def')) { |
|
@languages=(@languages, |
foreach my $domtype ($env{'user.domain'},$env{'request.role.domain'}, |
&Apache::lonnet::domain($env{'user.domain'}, |
$Apache::lonnet::perlvar{'lonDefDomain'}) { |
'lang_def')); |
if ($domtype ne '') { |
} |
my %domdefs = &Apache::lonnet::get_domain_defaults($domtype); |
if (&Apache::lonnet::domain($env{'request.role.domain'},'lang_def')) { |
if ($domdefs{'lang_def'} ne '') { |
@languages=(@languages, |
push(@languages,$domdefs{'lang_def'}); |
&Apache::lonnet::domain($env{'request.role.domain'}, |
} |
'lang_def')); |
} |
} |
|
if (&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, |
|
'lang_def')) { |
|
@languages=(@languages, |
|
&Apache::lonnet::domain($Apache::lonnet::perlvar{'lonDefDomain'}, |
|
'lang_def')); |
|
} |
} |
# turn "en-ca" into "en-ca,en" |
# turn "en-ca" into "en-ca,en" |
my @genlanguages; |
my @genlanguages; |
Line 4004 ENDROLE
|
Line 4017 ENDROLE
|
$lastitem = $thisdisfn; |
$lastitem = $thisdisfn; |
} |
} |
$titleinfo = |
$titleinfo = |
&Apache::loncommon::help_open_menu('','',3,'Authoring'). |
&Apache::loncommon::help_open_menu('','',3,'Authoring') |
'<b>Construction Space</b>: '. |
.'<b>'.&mt('Construction Space').'</b>: ' |
'<form name="dirs" method="post" action="'.$formaction |
.'<form name="dirs" method="post" action="'.$formaction |
.'" target="_top"><tt><b>' |
.'" target="_top"><tt><b>' |
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />" |
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv','','+1',1)."<font size=\"+1\">$lastitem</font></b></tt><br />" |
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') |
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') |
Line 6692 sub personal_data_fieldtitles {
|
Line 6705 sub personal_data_fieldtitles {
|
return %fieldtitles; |
return %fieldtitles; |
} |
} |
|
|
|
sub sorted_inst_types { |
|
my ($dom) = @_; |
|
my ($usertypes,$order) = &Apache::lonnet::retrieve_inst_usertypes($dom); |
|
my $othertitle = &mt('All users'); |
|
if ($env{'request.course.id'}) { |
|
$othertitle = 'any'; |
|
} |
|
my @types; |
|
if (ref($order) eq 'ARRAY') { |
|
@types = @{$order}; |
|
} |
|
if (@types == 0) { |
|
if (ref($usertypes) eq 'HASH') { |
|
@types = sort(keys(%{$usertypes})); |
|
} |
|
} |
|
if (keys(%{$usertypes}) > 0) { |
|
$othertitle = &mt('Other users'); |
|
if ($env{'request.course.id'}) { |
|
$othertitle = 'other'; |
|
} |
|
} |
|
return ($othertitle,$usertypes,\@types); |
|
} |
|
|
=pod |
=pod |
|
|
=back |
=back |