--- loncom/interface/domainprefs.pm 2008/02/24 23:18:40 1.43
+++ loncom/interface/domainprefs.pm 2009/10/25 15:53:25 1.117
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.43 2008/02/24 23:18:40 raeburn Exp $
+# $Id: domainprefs.pm,v 1.117 2009/10/25 15:53:25 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,6 +28,131 @@
###############################################################
##############################################################
+=pod
+
+=head1 NAME
+
+Apache::domainprefs.pm
+
+=head1 SYNOPSIS
+
+Handles configuration of a LON-CAPA domain.
+
+This is part of the LearningOnline Network with CAPA project
+described at http://www.lon-capa.org.
+
+
+=head1 OVERVIEW
+
+Each institution using LON-CAPA will typically have a single domain designated
+for use by individuals affliated with the institution. Accordingly, each domain
+may define a default set of logos and a color scheme which can be used to "brand"
+the LON-CAPA instance. In addition, an institution will typically have a language
+and timezone which are used for the majority of courses.
+
+LON-CAPA provides a mechanism to display and modify these defaults, as well as a
+host of other domain-wide settings which determine the types of functionality
+available to users and courses in the domain.
+
+There is also a mechanism to configure cataloging of courses in the domain, and
+controls on the operation of automated processes which govern such things as
+roster updates, user directory updates and processing of course requests.
+
+The domain coordination manual which is built dynamically on install/update of
+LON-CAPA from the relevant help items provides more information about domain
+configuration.
+
+Most of the domain settings are stored in the configuration.db GDBM file which is
+housed on the primary library server for the domain in /home/httpd/lonUsers/$dom,
+where $dom is the domain. The configuration.db stores settings in a number of
+frozen hashes of hashes. In a few cases, domain information must be uploaded to
+the domain as files (e.g., image files for logos etc., or plain text files for
+bubblesheet formats). In this case the domainprefs.pm must be running in a user
+session hosted on the primary library server in the domain, as these files are
+stored in author space belonging to a special $dom-domainconfig user.
+
+domainprefs.pm in combination with lonconfigsettings.pm will retrieve and display
+the current settings, and provides an interface to make modifications.
+
+=head1 SUBROUTINES
+
+=over
+
+=item print_quotas()
+
+Inputs: 4
+
+$dom,$settings,$rowtotal,$action.
+
+$dom is the domain, $settings is a reference to a hash of current settings for
+the current context, $rowtotal is a reference to the scalar used to record the
+number of rows displayed on the page, and $action is the context (either quotas
+or requestcourses).
+
+The print_quotas routine was orginally created to display/store information
+about default quota sizes for portfolio spaces for the different types of
+institutional affiliation in the domain (e.g., Faculty, Staff, Student etc.),
+but is now also used to manage availability of user tools:
+i.e., blogs, aboutme page, and portfolios, and the course request tool,
+used by course owners to request creation of a course.
+
+Outputs: 1
+
+$datatable - HTML containing form elements which allow settings to be changed.
+
+In the case of course requests, radio buttons are displayed for each institutional
+affiliate type (and also default, and _LC_adv) for each of the course types
+(official, unofficial and community). In each case the radio buttons allow the
+selection of one of four values:
+
+0, approval, validate, autolimit=N (where N is blank, or a positive integer).
+which have the following effects:
+
+0
+
+=over
+
+- course requests are not allowed for this course types/affiliation
+
+=back
+
+approval
+
+=over
+
+- course requests must be approved by a Doman Coordinator in the
+course's domain
+
+=back
+
+validate
+
+=over
+
+- an institutional validation (e.g., check requestor is instructor
+of record) needs to be passed before the course will be created. The required
+validation is in localenroll.pm on the primary library server for the course
+domain.
+
+=back
+
+autolimit
+
+=over
+
+- course requests will be processed autoatically up to a limit of
+N requests for the course type for the particular requestor.
+If N is undefined, there is no limit to the number of course requests
+which a course owner may submit and have processed automatically.
+
+=back
+
+=item modify_quotas()
+
+=back
+
+=cut
+
package Apache::domainprefs;
use strict;
@@ -37,10 +162,14 @@ use Apache::loncommon();
use Apache::lonhtmlcommon();
use Apache::lonlocal;
use Apache::lonmsg();
-use LONCAPA();
+use Apache::lonconfigsettings;
+use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Enrollment;
+use LONCAPA::lonauthcgi();
use File::Copy;
use Locale::Language;
+use DateTime::TimeZone;
+use DateTime::Locale;
sub handler {
my $r=shift;
@@ -50,6 +179,7 @@ sub handler {
return OK;
}
+ my $context = 'domain';
my $dom = $env{'request.role.domain'};
my $domdesc = &Apache::lonnet::domain($dom,'description');
if (&Apache::lonnet::allowed('mau',$dom)) {
@@ -62,7 +192,7 @@ sub handler {
}
&Apache::lonhtmlcommon::clear_breadcrumbs();
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
- ['phase']);
+ ['phase','actions']);
my $phase = 'pickactions';
if ( exists($env{'form.phase'}) ) {
$phase = $env{'form.phase'};
@@ -70,14 +200,17 @@ sub handler {
my %domconfig =
&Apache::lonnet::get_dom('configuration',['login','rolecolors',
'quotas','autoenroll','autoupdate','directorysrch',
- 'usercreation','usermodification','contacts','defaults'],$dom);
+ 'usercreation','usermodification','contacts','defaults',
+ 'scantron','coursecategories','serverstatuses',
+ 'requestcourses'],$dom);
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
'autoupdate','directorysrch','contacts',
- 'usercreation','usermodification');
+ 'usercreation','usermodification','scantron',
+ 'requestcourses','coursecategories','serverstatuses');
my %prefs = (
'rolecolors' =>
{ text => 'Default color schemes',
- help => 'Default_Color_Schemes',
+ help => 'Domain_Configuration_Color_Schemes',
header => [{col1 => 'Student Settings',
col2 => '',},
{col1 => 'Coordinator Settings',
@@ -87,33 +220,35 @@ sub handler {
{col1 => 'Administrator Settings',
col2 => '',}],
},
- 'login' =>
+ 'login' =>
{ text => 'Log-in page options',
- help => 'Domain_Log-in_Page',
+ help => 'Domain_Configuration_Login_Page',
header => [{col1 => 'Item',
col2 => '',}],
},
+
'defaults' =>
- { text => 'Default authentication/language',
- help => '',
+ { text => 'Default authentication/language/timezone',
+ help => 'Domain_Configuration_LangTZAuth',
header => [{col1 => 'Setting',
col2 => 'Value'}],
},
'quotas' =>
- { text => 'Default quotas for user portfolios',
- help => 'Default_User_Quota',
- header => [{col1 => 'User type',
- col2 => 'Default quota'}],
+ { text => 'User blogs, personal information pages and portfolios',
+ help => 'Domain_Configuration_Quotas',
+ header => [{col1 => 'User affiliation',
+ col2 => 'Available tools',
+ col3 => 'Portfolio quota',}],
},
'autoenroll' =>
{ text => 'Auto-enrollment settings',
- help => 'Domain_Auto_Enrollment',
+ help => 'Domain_Configuration_Auto_Enrollment',
header => [{col1 => 'Configuration setting',
col2 => 'Value(s)'}],
},
'autoupdate' =>
{ text => 'Auto-update settings',
- help => 'Domain_Auto_Update',
+ help => 'Domain_Configuration_Auto_Updates',
header => [{col1 => 'Setting',
col2 => 'Value',},
{col1 => 'User population',
@@ -121,20 +256,20 @@ sub handler {
},
'directorysrch' =>
{ text => 'Institutional directory searches',
- help => 'Domain_Directory_Search',
+ help => 'Domain_Configuration_InstDirectory_Search',
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
'contacts' =>
{ text => 'Contact Information',
- help => 'Domain_Contact_Information',
+ help => 'Domain_Configuration_Contact_Info',
header => [{col1 => 'Setting',
col2 => 'Value',}],
},
'usercreation' =>
{ text => 'User creation',
- help => 'Domain_User_Creation',
+ help => 'Domain_Configuration_User_Creation',
header => [{col1 => 'Format rule type',
col2 => 'Format rules in force'},
{col1 => 'User account creation',
@@ -142,15 +277,59 @@ sub handler {
{col1 => 'Context',
col2 => 'Assignable authentication types'}],
},
- 'usermodification' =>
+ 'usermodification' =>
{ text => 'User modification',
- help => 'Domain_User_Modification',
+ help => 'Domain_Configuration_User_Modification',
header => [{col1 => 'Target user has role',
col2 => 'User information updateable in author context'},
{col1 => 'Target user has role',
- col2 => 'User information updateable in course context'}],
+ col2 => 'User information updateable in course context'},
+ {col1 => "Status of user",
+ col2 => 'Information settable when self-creating account (if directory data blank)'}],
},
+ 'scantron' =>
+ { text => 'Bubblesheet format file',
+ help => 'Domain_Configuration_Scantron_Format',
+ header => [ {col1 => 'Item',
+ col2 => '',
+ }],
+ },
+ 'requestcourses' =>
+ {text => 'Request creation of courses',
+ help => 'Domain_Configuration_Request_Courses',
+ header => [{col1 => 'User affiliation',
+ col2 => 'Availability/Processing of requests',},
+ {col1 => 'Setting',
+ col2 => 'Value'}],
+ },
+ 'coursecategories' =>
+ { text => 'Cataloging of courses',
+ help => 'Domain_Configuration_Cataloging_Courses',
+ header => [{col1 => 'Category settings',
+ col2 => '',},
+ {col1 => 'Categories',
+ col2 => '',
+ }],
+ },
+ 'serverstatuses' =>
+ {text => 'Access to server status pages',
+ help => 'Domain_Configuration_Server_Status',
+ header => [{col1 => 'Status Page',
+ col2 => 'Other named users',
+ col3 => 'Specific IPs',
+ }],
+ },
);
+ my %servers = &dom_servers($dom);
+ if (keys(%servers) > 1) {
+ $prefs{'login'} = { text => 'Log-in page options',
+ help => 'Domain_Configuration_Login_Page',
+ header => [{col1 => 'Log-in Service',
+ col2 => 'Server Setting',},
+ {col1 => 'Log-in Page Items',
+ col2 => ''}],
+ };
+ }
my @roles = ('student','coordinator','author','admin');
my @actions = &Apache::loncommon::get_env_multiple('form.actions');
&Apache::lonhtmlcommon::add_breadcrumb
@@ -158,98 +337,10 @@ sub handler {
text=>"Pick functionality"});
my $confname = $dom.'-domainconfig';
if ($phase eq 'process') {
- &Apache::lonhtmlcommon::add_breadcrumb
- ({href=>"javascript:changePage(document.$phase,'display')",
- text=>"Domain Configuration"},
- {href=>"javascript:changePage(document.$phase,'$phase')",
- text=>"Updated"});
- &print_header($r,$phase);
- foreach my $item (@prefs_order) {
- if (grep(/^\Q$item\E$/,@actions)) {
- $r->print('
'.&mt('Set to be unavailable to [_1]',$typetitle).'
';
+ } else {
+ $resulttext .= '
'.&mt('No override set for [_1]',$typetitle).'
';
+ }
+ } else {
+ $resulttext .= '
'.&mt('Set to be unavailable to [_1]',$typetitle).'
';
+ }
+ }
+ }
+ }
+ $resulttext .= '
';
+ }
+ }
+ if ($action eq 'requestcourses') {
+ if (ref($changes{'notify'}) eq 'HASH') {
+ if ($changes{'notify'}{'approval'}) {
+ if (ref($confhash{'notify'}) eq 'HASH') {
+ if ($confhash{'notify'}{'approval'}) {
+ $resulttext .= '
'.&mt('Notification of requests requiring approval will be sent to: ').$confhash{'notify'}{'approval'}.'
';
+ } else {
+ $resulttext .= '
'.&mt('No Domain Coordinators will receive notification of course requests requiring approval.').'
';
+ }
+ }
}
- $resulttext .= '
'.&mt('[_1] set to [_2] Mb',$typetitle,$formhash{$type}).'
';
}
}
$resulttext .= '
';
+ if (keys(%newenv)) {
+ &Apache::lonnet::appenv(\%newenv);
+ }
} else {
- $resulttext = &mt('No changes made to default quotas');
+ if ($context eq 'requestcourses') {
+ $resulttext = &mt('No changes made to rights to request creation of courses.');
+ } else {
+ $resulttext = &mt('No changes made to availability of personal information pages, blogs, portfolios or default quotas');
+ }
}
} else {
$resulttext = ''.
@@ -2796,7 +4243,7 @@ sub modify_autoupdate {
run => 'Auto-update:',
classlists => 'Updates to user information in classlists?'
);
- my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
my %fieldtitles = &Apache::lonlocal::texthash (
id => 'Student/Employee ID',
permanentemail => 'E-mail address',
@@ -2925,7 +4372,7 @@ sub modify_directorysrch {
my @cansearch = &Apache::loncommon::get_env_multiple('form.cansearch');
my @searchby = &Apache::loncommon::get_env_multiple('form.searchby');
- my ($othertitle,$usertypes,$types) = &sorted_inst_types($dom);
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
if (keys(%{$usertypes}) == 0) {
@cansearch = ('default');
} else {
@@ -3089,7 +4536,8 @@ sub modify_contacts {
}
my (%others,%to);
my @contacts = ('supportemail','adminemail');
- my @mailings = ('errormail','packagesmail','helpdeskmail');
+ my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail',
+ 'requestsmail');
foreach my $type (@mailings) {
@{$newsetting{$type}} =
&Apache::loncommon::get_env_multiple('form.'.$type);
@@ -3134,6 +4582,8 @@ sub modify_contacts {
$default{'errormail'} = 'adminemail';
$default{'packagesmail'} = 'adminemail';
$default{'helpdeskmail'} = 'supportemail';
+ $default{'lonstatusmail'} = 'adminemail';
+ $default{'requestsmail'} = 'adminemail';
foreach my $item (@contacts) {
if ($to{$item} ne $default{$item}) {
$changes{$item} = 1;
@@ -3200,23 +4650,96 @@ sub modify_usercreation {
my @username_rule = &Apache::loncommon::get_env_multiple('form.username_rule');
my @id_rule = &Apache::loncommon::get_env_multiple('form.id_rule');
my @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');
- my @contexts = ('author','course','selfenroll');
+ my @contexts = ('author','course','requestcrs','selfcreate');
foreach my $item(@contexts) {
- $cancreate{$item} = $env{'form.can_createuser_'.$item};
- if ($item eq 'selfenroll') {
+ if ($item eq 'selfcreate') {
+ @{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item);
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth'))) {
- if (($cancreate{$item} eq 'any') || ($cancreate{$item} eq 'login')) {
- $warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.');
+ if (ref($cancreate{$item}) eq 'ARRAY') {
+ if (grep(/^login$/,@{$cancreate{$item}})) {
+ $warningmsg = &mt('Although account creation has been set to be available for institutional logins, currently default authentication in this domain has not been set to support this.').' '.&mt('You need to set the default authentication type to Kerberos 4 or 5 (with a Kerberos domain specified), or to Local authentication, if the localauth module has been customized in your domain to authenticate institutional logins.');
+ }
}
}
+ } else {
+ $cancreate{$item} = $env{'form.can_createuser_'.$item};
}
}
+ my ($othertitle,$usertypes,$types) =
+ &Apache::loncommon::sorted_inst_types($dom);
+ if (ref($types) eq 'ARRAY') {
+ if (@{$types} > 0) {
+ @{$cancreate{'statustocreate'}} =
+ &Apache::loncommon::get_env_multiple('form.statustocreate');
+ } else {
+ @{$cancreate{'statustocreate'}} = ();
+ }
+ push(@contexts,'statustocreate');
+ }
if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
foreach my $item (@contexts) {
- if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
- push(@{$changes{'cancreate'}},$item);
- }
+ if (($item eq 'selfcreate') || ($item eq 'statustocreate')) {
+ if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
+ foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) {
+ if (ref($cancreate{$item}) eq 'ARRAY') {
+ if (!grep(/^$curr$/,@{$cancreate{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ } else {
+ if ($curr_usercreation{'cancreate'}{$item} eq '') {
+ if (@{$cancreate{$item}} > 0) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } else {
+ if ($curr_usercreation{'cancreate'}{$item} eq 'any') {
+ if (@{$cancreate{$item}} < 3) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif ($curr_usercreation{'cancreate'}{$item} eq 'none') {
+ if (@{$cancreate{$item}} > 0) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif (!grep(/^$curr_usercreation{'cancreate'}{$item}$/,@{$cancreate{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ foreach my $type (@{$cancreate{$item}}) {
+ if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
+ if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif (($curr_usercreation{'cancreate'}{$item} ne 'any') &&
+ ($curr_usercreation{'cancreate'}{$item} ne 'none')) {
+ if ($curr_usercreation{'cancreate'}{$item} ne $type) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ }
+ } else {
+ if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
}
} elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
foreach my $item (@contexts) {
@@ -3323,24 +4846,77 @@ sub modify_usercreation {
my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
$dom);
+
+ my %selfcreatetypes = (
+ sso => 'users authenticated by institutional single sign on',
+ login => 'users authenticated by institutional log-in',
+ email => 'users who provide a valid e-mail address for use as the username',
+ );
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'
';
if (ref($changes{'cancreate'}) eq 'ARRAY') {
my %lt = &usercreation_types();
foreach my $type (@{$changes{'cancreate'}}) {
- my $chgtext = $lt{$type}.', ';
- if ($type eq 'selfenroll') {
- if ($cancreate{$type} eq 'none') {
+ my $chgtext;
+ unless ($type eq 'statustocreate') {
+ $chgtext = $lt{$type}.', ';
+ }
+ if ($type eq 'selfcreate') {
+ if (@{$cancreate{$type}} == 0) {
$chgtext .= &mt('creation of a new user account is not permitted.');
- } elsif ($cancreate{$type} eq 'any') {
- $chgtext .= &mt('creation of a new account is permitted for users authenticated by institutional log-in and SSO, and also for e-mail addresses used as usernames.');
- } elsif ($cancreate{$type} eq 'login') {
- $chgtext .= &mt('creation of a new account is only permitted for users authenticated by institutional log-in.');
- } elsif ($cancreate{$type} eq 'sso') {
- $chgtext .= &mt('creation of a new account is only permitted for users authenticated by institutional single sign on.');
- } elsif ($cancreate{$type} eq 'email') {
- $chgtext .= &mt('creation of a new account is only permitted for users who provide a valid e-mail address for use as the username.');
+ } else {
+ $chgtext .= &mt('creation of a new account is permitted for:').'
';
+ if (ref($cancreate{$type}) eq 'ARRAY') {
+ if (grep(/^(login|sso)$/,@{$cancreate{$type}})) {
+ if (ref($cancreate{'statustocreate'}) eq 'ARRAY') {
+ if (@{$cancreate{'statustocreate'}} == 0) {
+ $chgtext .= ' '.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").'';
+ }
+ }
+ }
+ }
+ }
+ } elsif ($type eq 'statustocreate') {
+ if ((ref($cancreate{'selfcreate'}) eq 'ARRAY') &&
+ (ref($cancreate{'statustocreate'}) eq 'ARRAY')) {
+ if (@{$cancreate{'selfcreate'}} > 0) {
+ if (@{$cancreate{'statustocreate'}} == 0) {
+
+ $chgtext .= &mt("Institutional affiliations permitted to create accounts set to 'None'.");
+ if (!grep(/^email$/,@{$cancreate{'selfcreate'}})) {
+ $chgtext .= ' '.&mt("However, no institutional affiliations (including 'other') are currently permitted to create accounts.").'';
+ }
+ } elsif (ref($usertypes) eq 'HASH') {
+ if (grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) {
+ $chgtext .= &mt('Creation of a new account for an institutional user is restricted to the following institutional affiliation(s):');
+ } else {
+ $chgtext .= &mt('Institutional affiliations permitted to create accounts with institutional authentication were set as follows:');
+ }
+ $chgtext .= '
';
+ foreach my $case (@{$cancreate{$type}}) {
+ if ($case eq 'default') {
+ $chgtext .= '
'.$othertitle.'
';
+ } else {
+ $chgtext .= '
'.$usertypes->{$case}.'
';
+ }
+ }
+ $chgtext .= '
';
+ if (!grep(/^(login|sso)$/,@{$cancreate{'selfcreate'}})) {
+ $chgtext .= ' '.&mt('However, users authenticated by institutional login/single sign on are not currently permitted to create accounts.').'';
+ }
+ }
+ } else {
+ if (@{$cancreate{$type}} == 0) {
+ $chgtext .= &mt("Institutional affiliations permitted to create accounts were set to 'none'.");
+ } else {
+ $chgtext .= &mt('Although institutional affiliations permitted to create accounts were changed, self creation of accounts is not currently permitted for any authentication types.');
+ }
+ }
}
} else {
if ($cancreate{$type} eq 'none') {
@@ -3449,10 +5025,11 @@ sub modify_usermodification {
$curr_usermodification{$key} = $domconfig{'usermodification'}{$key};
}
}
- my @contexts = ('author','course');
+ my @contexts = ('author','course','selfcreate');
my %context_title = (
author => 'In author context',
course => 'In course context',
+ selfcreate => 'When self creating account',
);
my @fields = ('lastname','firstname','middlename','generation',
'permanentemail','id');
@@ -3460,6 +5037,12 @@ sub modify_usermodification {
author => ['ca','aa'],
course => ['st','ep','ta','in','cr'],
);
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
+ if (ref($types) eq 'ARRAY') {
+ push(@{$types},'default');
+ $usertypes->{'default'} = $othertitle;
+ }
+ $roles{'selfcreate'} = $types;
my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
my %modifyhash;
foreach my $context (@contexts) {
@@ -3507,13 +5090,26 @@ sub modify_usermodification {
if (ref($changes{$context}) eq 'ARRAY') {
foreach my $role (@{$changes{$context}}) {
my $rolename;
- if ($role eq 'cr') {
- $rolename = &mt('Custom');
+ if ($context eq 'selfcreate') {
+ $rolename = $role;
+ if (ref($usertypes) eq 'HASH') {
+ if ($usertypes->{$role} ne '') {
+ $rolename = $usertypes->{$role};
+ }
+ }
} else {
- $rolename = &Apache::lonnet::plaintext($role);
+ if ($role eq 'cr') {
+ $rolename = &mt('Custom');
+ } else {
+ $rolename = &Apache::lonnet::plaintext($role);
+ }
}
my @modifiable;
- $resulttext .= '
'.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: ');
+ if ($context eq 'selfcreate') {
+ $resulttext .= '
'.&mt('Self-creation of account by users with status: [_1] ',$rolename).' - '.&mt('modifiable fields (if institutional data blank): ');
+ } else {
+ $resulttext .= '
'.&mt('Target user with [_1] role',$rolename).' - '.&mt('modifiable fields: ');
+ }
foreach my $field (@fields) {
if ($modifyhash{$context}{$role}{$field}) {
push(@modifiable,$fieldtitles{$field});
@@ -3545,7 +5141,7 @@ sub modify_defaults {
my ($dom,$r) = @_;
my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors);
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
- my @items = ('auth_def','auth_arg_def','lang_def');
+ my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def');
my @authtypes = ('internal','krb4','krb5','localauth');
foreach my $item (@items) {
$newvalues{$item} = $env{'form.'.$item};
@@ -3559,26 +5155,39 @@ sub modify_defaults {
if ($newvalues{$item} ne '') {
if ($newvalues{$item} =~ /^(\w+)/) {
my $langcode = $1;
- if (code2language($langcode) eq '') {
- push(@errors,$item);
+ if ($langcode ne 'x_chef') {
+ if (code2language($langcode) eq '') {
+ push(@errors,$item);
+ }
}
} else {
push(@errors,$item);
}
}
+ } elsif ($item eq 'timezone_def') {
+ if ($newvalues{$item} ne '') {
+ if (!DateTime::TimeZone->is_valid_name($newvalues{$item})) {
+ push(@errors,$item);
+ }
+ }
+ } elsif ($item eq 'datelocale_def') {
+ if ($newvalues{$item} ne '') {
+ my @datelocale_ids = DateTime::Locale->ids();
+ if (!grep(/^\Q$newvalues{$item}\E$/,@datelocale_ids)) {
+ push(@errors,$item);
+ }
+ }
}
if (grep(/^\Q$item\E$/,@errors)) {
$newvalues{$item} = $domdefaults{$item};
} elsif ($domdefaults{$item} ne $newvalues{$item}) {
$changes{$item} = 1;
}
+ $domdefaults{$item} = $newvalues{$item};
}
my %defaults_hash = (
- defaults => { auth_def => $newvalues{'auth_def'},
- auth_arg_def => $newvalues{'auth_arg_def'},
- lang_def => $newvalues{'lang_def'},
- }
- );
+ defaults => \%newvalues,
+ );
my $title = &defaults_titles();
my $putresult = &Apache::lonnet::put_dom('configuration',\%defaults_hash,
$dom);
@@ -3607,12 +5216,13 @@ sub modify_defaults {
$resulttext .= '
';
$mailmsgtext .= "\n";
my $cachetime = 24*60*60;
- &Apache::lonnet::do_cache_new('domdefaults',$dom,
- $defaults_hash{'defaults'},$cachetime);
- my $sysmail = $r->dir_config('lonSysEMail');
- &Apache::lonmsg::sendemail($sysmail,"LON-CAPA Domain Settings Change - $dom",$mailmsgtext);
+ &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
+ if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'} || $changes{'datelocale_def'}) {
+ my $sysmail = $r->dir_config('lonSysEMail');
+ &Apache::lonmsg::sendemail($sysmail,"LON-CAPA Domain Settings Change - $dom",$mailmsgtext);
+ }
} else {
- $resulttext = &mt('No changes made to default authentication/language settings');
+ $resulttext = &mt('No changes made to default authentication/language/timezone settings');
}
} else {
$resulttext = ''.
@@ -3628,4 +5238,465 @@ sub modify_defaults {
return $resulttext;
}
+sub modify_scantron {
+ my ($r,$dom,$confname,%domconfig) = @_;
+ my ($resulttext,%confhash,%changes,$errors);
+ my $custom = 'custom.tab';
+ my $default = 'default.tab';
+ my $servadm = $r->dir_config('lonAdmEMail');
+ my ($configuserok,$author_ok,$switchserver) =
+ &config_check($dom,$confname,$servadm);
+ if ($env{'form.scantronformat.filename'} ne '') {
+ my $error;
+ if ($configuserok eq 'ok') {
+ if ($switchserver) {
+ $error = &mt("Upload of scantron format file is not permitted to this server: [_1]",$switchserver);
+ } else {
+ if ($author_ok eq 'ok') {
+ my ($result,$scantronurl) =
+ &publishlogo($r,'upload','scantronformat',$dom,
+ $confname,'scantron','','',$custom);
+ if ($result eq 'ok') {
+ $confhash{'scantron'}{'scantronformat'} = $scantronurl;
+ $changes{'scantronformat'} = 1;
+ } else {
+ $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$custom,$result);
+ }
+ } else {
+ $error = &mt("Upload of [_1] failed because an author role could not be assigned to a Domain Configuration user ([_2]) in domain: [_3]. Error was: [_4].",$custom,$confname,$dom,$author_ok);
+ }
+ }
+ } else {
+ $error = &mt("Upload of [_1] failed because a Domain Configuration user ([_2]) could not be created in domain: [_3]. Error was: [_4].",$custom,$confname,$dom,$configuserok);
+ }
+ if ($error) {
+ &Apache::lonnet::logthis($error);
+ $errors .= '
'.$error.'
';
+ }
+ }
+ if (ref($domconfig{'scantron'}) eq 'HASH') {
+ if ($domconfig{'scantron'}{'scantronformat'} ne '') {
+ if ($env{'form.scantronformat_del'}) {
+ $confhash{'scantron'}{'scantronformat'} = '';
+ $changes{'scantronformat'} = 1;
+ }
+ }
+ }
+ if (keys(%confhash) > 0) {
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%confhash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ if (ref($confhash{'scantron'}) eq 'HASH') {
+ $resulttext = &mt('Changes made:').'
';
+ }
+ if (keys(%reorderings) > 0) {
+ my %sort_by_trail;
+ $resulttext .= '
'.&mt('Reordered categories:').'
';
+ foreach my $key (keys(%reorderings)) {
+ if ($allitems{$key} ne '') {
+ $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
+ }
+ }
+ foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
+ $resulttext .= '
'.$trails[$trail].'
';
+ }
+ $resulttext .= '
';
+ }
+ if (keys(%adds) > 0) {
+ my %sort_by_trail;
+ $resulttext .= '
'.&mt('Added categories:').'
';
+ foreach my $key (keys(%adds)) {
+ if ($allitems{$key} ne '') {
+ $sort_by_trail{$allitems{$key}} = $trails[$allitems{$key}];
+ }
+ }
+ foreach my $trail (sort {$a <=> $b } (keys(%sort_by_trail))) {
+ $resulttext .= '
'.$trails[$trail].'
';
+ }
+ $resulttext .= '
';
+ }
+ }
+ $resulttext .= '
';
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).'';
+ }
+ } else {
+ $resulttext = &mt('No changes made to course categories');
+ }
+ return $resulttext;
+}
+
+sub modify_serverstatuses {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%changes,%currserverstatus,%newserverstatus);
+ if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
+ %currserverstatus = %{$domconfig{'serverstatuses'}};
+ }
+ my @pages = &serverstatus_pages();
+ foreach my $type (@pages) {
+ $newserverstatus{$type}{'namedusers'} = '';
+ $newserverstatus{$type}{'machines'} = '';
+ if (defined($env{'form.'.$type.'_namedusers'})) {
+ my @users = split(/,/,$env{'form.'.$type.'_namedusers'});
+ my @okusers;
+ foreach my $user (@users) {
+ my ($uname,$udom) = split(/:/,$user);
+ if (($udom =~ /^$match_domain$/) &&
+ (&Apache::lonnet::domain($udom)) &&
+ ($uname =~ /^$match_username$/)) {
+ if (!grep(/^\Q$user\E/,@okusers)) {
+ push(@okusers,$user);
+ }
+ }
+ }
+ if (@okusers > 0) {
+ @okusers = sort(@okusers);
+ $newserverstatus{$type}{'namedusers'} = join(',',@okusers);
+ }
+ }
+ if (defined($env{'form.'.$type.'_machines'})) {
+ my @machines = split(/,/,$env{'form.'.$type.'_machines'});
+ my @okmachines;
+ foreach my $ip (@machines) {
+ my @parts = split(/\./,$ip);
+ next if (@parts < 4);
+ my $badip = 0;
+ for (my $i=0; $i<4; $i++) {
+ if (!(($parts[$i] >= 0) && ($parts[$i] <= 255))) {
+ $badip = 1;
+ last;
+ }
+ }
+ if (!$badip) {
+ push(@okmachines,$ip);
+ }
+ }
+ @okmachines = sort(@okmachines);
+ $newserverstatus{$type}{'machines'} = join(',',@okmachines);
+ }
+ }
+ my %serverstatushash = (
+ serverstatuses => \%newserverstatus,
+ );
+ my %changes;
+ foreach my $type (@pages) {
+ foreach my $setting ('namedusers','machines') {
+ my (@current,@new);
+ if (ref($currserverstatus{$type}) eq 'HASH') {
+ if ($currserverstatus{$type}{$setting} ne '') {
+ @current = split(/,/,$currserverstatus{$type}{$setting});
+ }
+ }
+ if ($newserverstatus{$type}{$setting} ne '') {
+ @new = split(/,/,$newserverstatus{$type}{$setting});
+ }
+ if (@current > 0) {
+ if (@new > 0) {
+ foreach my $item (@current) {
+ if (!grep(/^\Q$item\E$/,@new)) {
+ $changes{$type}{$setting} = 1;
+ last;
+ }
+ }
+ foreach my $item (@new) {
+ if (!grep(/^\Q$item\E$/,@current)) {
+ $changes{$type}{$setting} = 1;
+ last;
+ }
+ }
+ } else {
+ $changes{$type}{$setting} = 1;
+ }
+ } elsif (@new > 0) {
+ $changes{$type}{$setting} = 1;
+ }
+ }
+ }
+ if (keys(%changes) > 0) {
+ my $titles= &LONCAPA::lonauthcgi::serverstatus_titles();
+ my $putresult = &Apache::lonnet::put_dom('configuration',
+ \%serverstatushash,$dom);
+ if ($putresult eq 'ok') {
+ $resulttext .= &mt('Changes made:').'
';
+ foreach my $type (@pages) {
+ if (ref($changes{$type}) eq 'HASH') {
+ $resulttext .= '
'.$titles->{$type}.'
';
+ if ($changes{$type}{'namedusers'}) {
+ if ($newserverstatus{$type}{'namedusers'} eq '') {
+ $resulttext .= '
'.&mt("Access terminated for all specific (named) users").'
'."\n";
+ } else {
+ $resulttext .= '
'.&mt("Access available for the following specified users: ").$newserverstatus{$type}{'namedusers'}.'
'."\n";
+ }
+ }
+ if ($changes{$type}{'machines'}) {
+ if ($newserverstatus{$type}{'machines'} eq '') {
+ $resulttext .= '
'.&mt("Access terminated for all specific IP addresses").'
'."\n";
+ } else {
+ $resulttext .= '
'.&mt("Access available for the following specified IP addresses: ").$newserverstatus{$type}{'machines'}.'
'."\n";
+ }
+
+ }
+ $resulttext .= '
';
+ }
+ }
+ $resulttext .= '
';
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred saving access settings for server status pages: [_1].',$putresult).'';
+
+ }
+ } else {
+ $resulttext = &mt('No changes made to access to server status pages');
+ }
+ return $resulttext;
+}
+
+sub recurse_check {
+ my ($chkcats,$categories,$depth,$name) = @_;
+ if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
+ my $chg = 0;
+ for (my $j=0; $j<@{$chkcats->[$depth]{$name}}; $j++) {
+ my $category = $chkcats->[$depth]{$name}[$j];
+ my $item;
+ if ($category eq '') {
+ $chg ++;
+ } else {
+ my $deeper = $depth + 1;
+ $item = &escape($category).':'.&escape($name).':'.$depth;
+ if ($chg) {
+ $categories->{$item} -= $chg;
+ }
+ &recurse_check($chkcats,$categories,$deeper,$category);
+ $deeper --;
+ }
+ }
+ }
+ return;
+}
+
+sub recurse_cat_deletes {
+ my ($item,$coursecategories,$deletions) = @_;
+ my ($deleted,$container,$depth) = map { &unescape($_); } split(/:/,$item);
+ my $subdepth = $depth + 1;
+ if (ref($coursecategories) eq 'HASH') {
+ foreach my $subitem (keys(%{$coursecategories})) {
+ my ($child,$parent,$itemdepth) = map { &unescape($_); } split(/:/,$subitem);
+ if (($parent eq $deleted) && ($itemdepth == $subdepth)) {
+ delete($coursecategories->{$subitem});
+ $deletions->{$subitem} = 1;
+ &recurse_cat_deletes($subitem,$coursecategories,$deletions);
+ }
+ }
+ }
+ return;
+}
+
+sub dom_servers {
+ my ($dom) = @_;
+ my (%uniqservers,%servers);
+ my $primaryserver = &Apache::lonnet::hostname(&Apache::lonnet::domain($dom,'primary'));
+ my @machinedoms = &Apache::lonnet::machine_domains($primaryserver);
+ foreach my $mdom (@machinedoms) {
+ my %currservers = %servers;
+ my %server = &Apache::lonnet::get_servers($mdom);
+ %servers = (%currservers,%server);
+ }
+ my %by_hostname;
+ foreach my $id (keys(%servers)) {
+ push(@{$by_hostname{$servers{$id}}},$id);
+ }
+ foreach my $hostname (sort(keys(%by_hostname))) {
+ if (@{$by_hostname{$hostname}} > 1) {
+ my $match = 0;
+ foreach my $id (@{$by_hostname{$hostname}}) {
+ if (&Apache::lonnet::host_domain($id) eq $dom) {
+ $uniqservers{$id} = $hostname;
+ $match = 1;
+ }
+ }
+ unless ($match) {
+ $uniqservers{$by_hostname{$hostname}[0]} = $hostname;
+ }
+ } else {
+ $uniqservers{$by_hostname{$hostname}[0]} = $hostname;
+ }
+ }
+ return %uniqservers;
+}
+
1;
500 Internal Server Error
Internal Server Error
The server encountered an internal error or
misconfiguration and was unable to complete
your request.
Please contact the server administrator at
root@localhost to inform them of the time this error occurred,
and the actions you performed just before this error.
More information about this error may be available
in the server error log.