--- loncom/interface/domainprefs.pm 2008/05/01 00:01:16 1.47
+++ loncom/interface/domainprefs.pm 2014/02/12 20:37:42 1.224
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.47 2008/05/01 00:01:16 raeburn Exp $
+# $Id: domainprefs.pm,v 1.224 2014/02/12 20:37:42 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -28,6 +28,132 @@
###############################################################
##############################################################
+=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 affiliated 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 (quotas,
+requestcourses or requestauthor).
+
+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, and to display/store
+default quota sizes for Authoring Spaces.
+
+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, community, and textbook). 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 automatically 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 +163,17 @@ 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;
+
+my $registered_cleanup;
+my $modified_urls;
sub handler {
my $r=shift;
@@ -50,6 +183,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)) {
@@ -60,25 +194,43 @@ sub handler {
"/adm/domainprefs:mau:0:0:Cannot modify domain settings";
return HTTP_NOT_ACCEPTABLE;
}
+
+ $registered_cleanup=0;
+ @{$modified_urls}=();
+
&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'};
}
+ my %servers = &Apache::lonnet::internet_dom_servers($dom);
my %domconfig =
&Apache::lonnet::get_dom('configuration',['login','rolecolors',
- 'quotas','autoenroll','autoupdate','directorysrch',
- 'usercreation','usermodification','contacts','defaults','scantron'],
- $dom);
+ 'quotas','autoenroll','autoupdate','autocreate',
+ 'directorysrch','usercreation','usermodification',
+ 'contacts','defaults','scantron','coursecategories',
+ 'serverstatuses','requestcourses','helpsettings',
+ 'coursedefaults','usersessions','loadbalancing',
+ 'requestauthor'],$dom);
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
- 'autoupdate','directorysrch','contacts',
- 'usercreation','usermodification','scantron');
+ 'autoupdate','autocreate','directorysrch','contacts',
+ 'usercreation','selfcreation','usermodification','scantron',
+ 'requestcourses','requestauthor','coursecategories',
+ 'serverstatuses','helpsettings',
+ 'coursedefaults','usersessions');
+ my %existing;
+ if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
+ %existing = %{$domconfig{'loadbalancing'}};
+ }
+ if ((keys(%servers) > 1) || (keys(%existing) > 0)) {
+ push(@prefs_order,'loadbalancing');
+ }
my %prefs = (
'rolecolors' =>
{ text => 'Default color schemes',
- help => 'Default_Color_Schemes',
+ help => 'Domain_Configuration_Color_Schemes',
header => [{col1 => 'Student Settings',
col2 => '',},
{col1 => 'Coordinator Settings',
@@ -88,54 +240,64 @@ sub handler {
{col1 => 'Administrator Settings',
col2 => '',}],
},
- 'login' =>
+ 'login' =>
{ text => 'Log-in page options',
- help => 'Domain_Log-in_Page',
- header => [{col1 => 'Item',
- col2 => '',}],
+ help => 'Domain_Configuration_Login_Page',
+ header => [{col1 => 'Log-in Page Items',
+ col2 => '',},
+ {col1 => 'Log-in Help',
+ col2 => 'Value'}],
},
'defaults' =>
- { text => 'Default authentication/language',
- help => '',
+ { text => 'Default authentication/language/timezone/portal',
+ 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 => 'Blogs, personal web pages, webDAV/quotas, portfolios',
+ help => 'Domain_Configuration_Quotas',
+ header => [{col1 => 'User affiliation',
+ col2 => 'Available tools',
+ col3 => 'Quotas, MB; (Authoring requires role)',}],
},
'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 => 'Setting',
+ col2 => 'Affiliation'},
{col1 => 'User population',
- col2 => 'Updataeable user data'}],
+ col2 => 'Updateable user data'}],
+ },
+ 'autocreate' =>
+ { text => 'Auto-course creation settings',
+ help => 'Domain_Configuration_Auto_Creation',
+ header => [{col1 => 'Configuration Setting',
+ col2 => 'Value',}],
},
'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',
@@ -143,121 +305,184 @@ sub handler {
{col1 => 'Context',
col2 => 'Assignable authentication types'}],
},
- 'usermodification' =>
+ 'selfcreation' =>
+ { text => 'Users self-creating accounts',
+ help => 'Domain_Configuration_Self_Creation',
+ header => [{col1 => 'Self-creation with institutional username',
+ col2 => 'Enabled?'},
+ {col1 => 'Institutional user type (login/SSO self-creation)',
+ col2 => 'Information user can enter'},
+ {col1 => 'Self-creation with e-mail as username',
+ col2 => 'Settings'}],
+ },
+ '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'}],
},
- 'scantron' =>
- { text => 'Scantron format file',
- help => 'Domain_Scantron_Formats',
+ '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'},
+ {col1 => 'Available textbooks',
+ col2 => ''}],
+ },
+ 'requestauthor' =>
+ {text => 'Request Authoring Space',
+ help => 'Domain_Configuration_Request_Author',
+ header => [{col1 => 'User affiliation',
+ col2 => 'Availability/Processing of requests',},
+ {col1 => 'Setting',
+ col2 => 'Value'}],
+ },
+ 'coursecategories' =>
+ { text => 'Cataloging of courses/communities',
+ 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',
+ }],
+ },
+ 'helpsettings' =>
+ {text => 'Help page settings',
+ help => 'Domain_Configuration_Help_Settings',
+ header => [{col1 => 'Help Settings (logged-in users)',
+ col2 => 'Value'}],
+ },
+ 'coursedefaults' =>
+ {text => 'Course/Community defaults',
+ help => 'Domain_Configuration_Course_Defaults',
+ header => [{col1 => 'Defaults which can be overridden in each course by a CC',
+ col2 => 'Value',},
+ {col1 => 'Defaults which can be overridden for each course by a DC',
+ col2 => 'Value',},],
+ },
+ 'privacy' =>
+ {text => 'User Privacy',
+ help => 'Domain_Configuration_User_Privacy',
+ header => [{col1 => 'Setting',
+ col2 => 'Value',}],
+ },
+ 'usersessions' =>
+ {text => 'User session hosting/offloading',
+ help => 'Domain_Configuration_User_Sessions',
+ header => [{col1 => 'Domain server',
+ col2 => 'Servers to offload sessions to when busy'},
+ {col1 => 'Hosting of users from other domains',
+ col2 => 'Rules'},
+ {col1 => "Hosting domain's own users elsewhere",
+ col2 => 'Rules'}],
+ },
+ 'loadbalancing' =>
+ {text => 'Dedicated Load Balancer(s)',
+ help => 'Domain_Configuration_Load_Balancing',
+ header => [{col1 => 'Balancers',
+ col2 => 'Default destinations',
+ col3 => 'User affiliation',
+ col4 => 'Overrides'},
+ ],
+ },
);
+ 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 => ''},
+ {col1 => 'Log-in Help',
+ col2 => 'Value'}],
+ };
+ }
+
my @roles = ('student','coordinator','author','admin');
my @actions = &Apache::loncommon::get_env_multiple('form.actions');
&Apache::lonhtmlcommon::add_breadcrumb
({href=>"javascript:changePage(document.$phase,'pickactions')",
- text=>"Pick functionality"});
+ text=>"Settings to display/modify"});
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('
');
- $r->print(&print_footer($r,$phase,'process','Save',\@actions));
- } else {
- $r->print(''.
- ''."\n".
- ''.&mt('No settings chosen').
- '');
+ my $js = &recaptcha_js().
+ &credits_js();
+ if ((keys(%servers) > 1) || (keys(%existing) > 0)) {
+ my ($othertitle,$usertypes,$types) =
+ &Apache::loncommon::sorted_inst_types($dom);
+ $js .= &lonbalance_targets_js($dom,$types,\%servers,
+ $domconfig{'loadbalancing'}).
+ &new_spares_js().
+ &common_domprefs_js().
+ &Apache::loncommon::javascript_array_indexof();
+ }
+ if (grep(/^requestcourses$/,@actions)) {
+ my $javascript_validations;
+ my $coursebrowserjs=&Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'});
+ $js .= <
+$javascript_validations
+
+$coursebrowserjs
+END
}
- $r->print('');
- $r->print(&Apache::loncommon::end_page());
+ &Apache::lonconfigsettings::display_settings($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,$js);
} else {
- if ($phase eq '') {
- $phase = 'pickactions';
+# check if domconfig user exists for the domain.
+ my $servadm = $r->dir_config('lonAdmEMail');
+ my ($configuserok,$author_ok,$switchserver) =
+ &config_check($dom,$confname,$servadm);
+ unless ($configuserok eq 'ok') {
+ &Apache::lonconfigsettings::print_header($r,$phase,$context);
+ $r->print(&mt('The domain configuration user "[_1]" has yet to be created.',
+ $confname).
+ ' '
+ );
+ if ($switchserver) {
+ $r->print(&mt('Ordinarily, that domain configuration user is created when the ./UPDATE script is run to install LON-CAPA for the first time.').
+ ' '.
+ &mt('However, that does not apply when new domains are added to a multi-domain server, and ./UPDATE has not been run recently.').
+ ' '.
+ &mt('The "[_1]" user can be created automatically when a Domain Coordinator visits the web-based "Set domain configuration" screen, in a session hosted on the primary library server.',$confname).
+ ' '.
+ &mt('To do that now, use the following link: [_1]',$switchserver)
+ );
+ } else {
+ $r->print(&mt('To create that user from the command line run the ./UPDATE script found in the top level directory of the extracted LON-CAPA tarball.').
+ ' '.
+ &mt('Once that is done, you will be able to use the web-based "Set domain configuration" to configure the domain')
+ );
+ }
+ $r->print(&Apache::loncommon::end_page());
+ return OK;
}
- my %helphash;
- &print_header($r,$phase);
if (keys(%domconfig) == 0) {
my $primarylibserv = &Apache::lonnet::domain($dom,'primary');
my @ids=&Apache::lonnet::current_machine_ids();
@@ -276,6 +501,7 @@ sub handler {
}
}
if ($custom_img_count > 0) {
+ &Apache::lonconfigsettings::print_header($r,$phase,$context);
my $switch_server = &check_switchserver($dom,$confname);
$r->print(
&mt('Domain configuration settings have yet to be saved for this domain via the web-based domain preferences interface.').' '.
@@ -285,74 +511,66 @@ sub handler {
if ($switch_server) {
$r->print($switch_server.' '.&mt('to primary library server for domain: [_1]',$dom));
}
+ $r->print(&Apache::loncommon::end_page());
return OK;
}
}
}
- $r->print('
'."\n";
+ %defaultchecked = ('coursecredits' => 'off');
+ @toggles = ('coursecredits');
+ my $current = {
+ 'coursecredits' => $currusecredits,
+ };
+ (my $table,$itemcount) =
+ &radiobutton_prefs($current,\@toggles,\%defaultchecked,
+ \%choices,$itemcount,$onclick,$additional);
+ $datatable .= $table;
+ }
+ $$rowtotal += $itemcount;
+ return $datatable;
+}
+
+sub print_usersessions {
+ my ($position,$dom,$settings,$rowtotal) = @_;
+ my ($css_class,$datatable,%checked,%choices);
+ my (%by_ip,%by_location,@intdoms);
+ &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
+
+ my @alldoms = &Apache::lonnet::all_domains();
+ my %serverhomes = %Apache::lonnet::serverhomeIDs;
+ my %servers = &Apache::lonnet::internet_dom_servers($dom);
+ my %altids = &id_for_thisdom(%servers);
+ my $itemcount = 1;
+ if ($position eq 'top') {
+ if (keys(%serverhomes) > 1) {
+ my %spareid = ¤t_offloads_to($dom,$settings,\%servers);
+ $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$rowtotal);
+ } else {
+ $datatable .= '
'.
+ &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.');
+ }
+ } else {
+ if (keys(%by_location) == 0) {
+ $datatable .= '
'.
+ &mt('Nothing to set here, as the cluster to which this domain belongs only contains one institution.');
+ } else {
+ my %lt = &usersession_titles();
+ my $numinrow = 5;
+ my $prefix;
+ my @types;
+ if ($position eq 'bottom') {
+ $prefix = 'remote';
+ @types = ('version','excludedomain','includedomain');
+ } else {
+ $prefix = 'hosted';
+ @types = ('excludedomain','includedomain');
+ }
+ my (%current,%checkedon,%checkedoff);
+ my @lcversions = &Apache::lonnet::all_loncaparevs();
+ my @locations = sort(keys(%by_location));
+ foreach my $type (@types) {
+ $checkedon{$type} = '';
+ $checkedoff{$type} = ' checked="checked"';
+ }
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{$prefix}) eq 'HASH') {
+ foreach my $key (keys(%{$settings->{$prefix}})) {
+ $current{$key} = $settings->{$prefix}{$key};
+ if ($key eq 'version') {
+ if ($current{$key} ne '') {
+ $checkedon{$key} = ' checked="checked"';
+ $checkedoff{$key} = '';
+ }
+ } elsif (ref($current{$key}) eq 'ARRAY') {
+ $checkedon{$key} = ' checked="checked"';
+ $checkedoff{$key} = '';
+ }
+ }
+ }
+ }
+ foreach my $type (@types) {
+ next if ($type ne 'version' && !@locations);
+ $css_class = $itemcount%2 ? ' class="LC_odd_row"' : '';
+ $datatable .= '
+
'.$lt{$type}.'
+
+
+
';
+ if ($type eq 'version') {
+ my $selector = ' ';
+ $datatable .= &mt('remote server must be version: [_1] or later',$selector);
+ } else {
+ $datatable.= '
'.(' 'x2).
+ ''.
+ "\n".
+ '
';
+ my $rem;
+ for (my $i=0; $i<@locations; $i++) {
+ my ($showloc,$value,$checkedtype);
+ if (ref($by_location{$locations[$i]}) eq 'ARRAY') {
+ my $ip = $by_location{$locations[$i]}->[0];
+ if (ref($by_ip{$ip}) eq 'ARRAY') {
+ $value = join(':',@{$by_ip{$ip}});
+ $showloc = join(', ',@{$by_ip{$ip}});
+ if (ref($current{$type}) eq 'ARRAY') {
+ foreach my $loc (@{$by_ip{$ip}}) {
+ if (grep(/^\Q$loc\E$/,@{$current{$type}})) {
+ $checkedtype = ' checked="checked"';
+ last;
+ }
+ }
+ }
+ }
+ }
+ $rem = $i%($numinrow);
+ if ($rem == 0) {
+ if ($i > 0) {
+ $datatable .= '';
+ }
+ $datatable .= '
'."\n";
+ foreach my $option ('original','recaptcha','notused') {
+ $output .= '';
+ unless ($option eq 'notused') {
+ $output .= (' 'x2)."\n";
+ }
+ }
+#
+# Note: If reCAPTCHA is to be used for LON-CAPA servers in a domain, a domain coordinator should visit:
+# https://www.google.com/recaptcha and generate a Public and Private key. For domains with multiple
+# servers a single key pair will be used for all servers, so the internet domain (e.g., yourcollege.edu)
+# specified for use with the key should be broad enough to accommodate all servers in the LON-CAPA domain.
+#
+ $output .= '
';
}
my $defcheck = ' ';
- if (ref($settings->{'cansearch'}) eq 'ARRAY') {
- if (grep(/^default$/,@{$settings->{'cansearch'}})) {
+ if (ref($settings) eq 'HASH') {
+ if (ref($settings->{$context}) eq 'ARRAY') {
+ if (grep(/^default$/,@{$settings->{$context}})) {
+ $defcheck = ' checked="checked" ';
+ }
+ } elsif ($context eq 'statustocreate') {
$defcheck = ' checked="checked" ';
}
}
$output .= '
'.
'
';
@@ -2110,17 +5093,25 @@ sub usertype_update_row {
}
sub modify_login {
- my ($r,$dom,$confname,%domconfig) = @_;
- my ($resulttext,$errors,$colchgtext,%changes,%colchanges);
- my %title = ( coursecatalog => 'Display course catalog',
- adminmail => 'Display administrator E-mail address',
- newuser => 'Link for visitors to create a user account',
- loginheader => 'Log-in box header');
- my @offon = ('off','on');
- my %loginhash;
+ my ($r,$dom,$confname,$lastactref,%domconfig) = @_;
+ my ($resulttext,$errors,$colchgtext,%changes,%colchanges,%newfile,%newurl,
+ %curr_loginvia,%loginhash,@currlangs,@newlangs,$addedfile,%title,@offon);
+ %title = ( coursecatalog => 'Display course catalog',
+ adminmail => 'Display administrator E-mail address',
+ helpdesk => 'Display "Contact Helpdesk" link',
+ newuser => 'Link for visitors to create a user account',
+ loginheader => 'Log-in box header');
+ @offon = ('off','on');
+ if (ref($domconfig{login}) eq 'HASH') {
+ if (ref($domconfig{login}{loginvia}) eq 'HASH') {
+ foreach my $lonhost (keys(%{$domconfig{login}{loginvia}})) {
+ $curr_loginvia{$lonhost} = $domconfig{login}{loginvia}{$lonhost};
+ }
+ }
+ }
($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
\%domconfig,\%loginhash);
- my @toggles = ('coursecatalog','adminmail','newuser');
+ my @toggles = ('coursecatalog','adminmail','helpdesk','newuser');
foreach my $item (@toggles) {
$loginhash{login}{$item} = $env{'form.'.$item};
}
@@ -2129,50 +5120,313 @@ sub modify_login {
$colchgtext = &display_colorchgs($dom,\%colchanges,['login'],
\%loginhash);
}
+
+ my %servers = &Apache::lonnet::internet_dom_servers($dom);
+ my @loginvia_attribs = ('serverpath','custompath','exempt');
+ if (keys(%servers) > 1) {
+ foreach my $lonhost (keys(%servers)) {
+ next if ($env{'form.'.$lonhost.'_server'} eq $lonhost);
+ if (ref($curr_loginvia{$lonhost}) eq 'HASH') {
+ if ($env{'form.'.$lonhost.'_server'} eq $curr_loginvia{$lonhost}{'server'}) {
+ $loginhash{login}{loginvia}{$lonhost}{'server'} = $curr_loginvia{$lonhost}{'server'};
+ } elsif ($curr_loginvia{$lonhost}{'server'} ne '') {
+ if (defined($servers{$env{'form.'.$lonhost.'_server'}})) {
+ $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'};
+ $changes{'loginvia'}{$lonhost} = 1;
+ } else {
+ $loginhash{login}{loginvia}{$lonhost}{'server'} = '';
+ $changes{'loginvia'}{$lonhost} = 1;
+ }
+ } else {
+ if (defined($servers{$env{'form.'.$lonhost.'_server'}})) {
+ $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'};
+ $changes{'loginvia'}{$lonhost} = 1;
+ }
+ }
+ if ($loginhash{login}{loginvia}{$lonhost}{'server'} eq '') {
+ foreach my $item (@loginvia_attribs) {
+ $loginhash{login}{loginvia}{$lonhost}{$item} = '';
+ }
+ } else {
+ foreach my $item (@loginvia_attribs) {
+ my $new = $env{'form.'.$lonhost.'_'.$item};
+ if (($item eq 'serverpath') && ($new eq 'custom')) {
+ $env{'form.'.$lonhost.'_custompath'} =~ s/\s+//g;
+ if ($env{'form.'.$lonhost.'_custompath'} eq '') {
+ $new = '/';
+ }
+ }
+ if (($item eq 'custompath') &&
+ ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) {
+ $new = '';
+ }
+ if ($new ne $curr_loginvia{$lonhost}{$item}) {
+ $changes{'loginvia'}{$lonhost} = 1;
+ }
+ if ($item eq 'exempt') {
+ $new =~ s/^\s+//;
+ $new =~ s/\s+$//;
+ my @poss_ips = split(/\s*[,:]\s*/,$new);
+ my @okips;
+ foreach my $ip (@poss_ips) {
+ if ($ip =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/) {
+ if (($1 <= 255) && ($2 <= 255) && ($3 <= 255) && ($4 <= 255)) {
+ push(@okips,$ip);
+ }
+ }
+ }
+ if (@okips > 0) {
+ $new = join(',',@okips);
+ } else {
+ $new = '';
+ }
+ }
+ $loginhash{login}{loginvia}{$lonhost}{$item} = $new;
+ }
+ }
+ } else {
+ if (defined($servers{$env{'form.'.$lonhost.'_server'}})) {
+ $loginhash{login}{loginvia}{$lonhost}{'server'} = $env{'form.'.$lonhost.'_server'};
+ $changes{'loginvia'}{$lonhost} = 1;
+ foreach my $item (@loginvia_attribs) {
+ my $new = $env{'form.'.$lonhost.'_'.$item};
+ if (($item eq 'serverpath') && ($new eq 'custom')) {
+ if ($env{'form.'.$lonhost.'_custompath'} eq '') {
+ $new = '/';
+ }
+ }
+ if (($item eq 'custompath') &&
+ ($env{'form.'.$lonhost.'_serverpath'} ne 'custom')) {
+ $new = '';
+ }
+ $loginhash{login}{loginvia}{$lonhost}{$item} = $new;
+ }
+ }
+ }
+ }
+ }
+
+ my $servadm = $r->dir_config('lonAdmEMail');
+ my %langchoices = &Apache::lonlocal::texthash(&get_languages_hash());
+ if (ref($domconfig{'login'}) eq 'HASH') {
+ if (ref($domconfig{'login'}{'helpurl'}) eq 'HASH') {
+ foreach my $lang (sort(keys(%{$domconfig{'login'}{'helpurl'}}))) {
+ if ($lang eq 'nolang') {
+ push(@currlangs,$lang);
+ } elsif (defined($langchoices{$lang})) {
+ push(@currlangs,$lang);
+ } else {
+ next;
+ }
+ }
+ }
+ }
+ my @delurls = &Apache::loncommon::get_env_multiple('form.loginhelpurl_del');
+ if (@currlangs > 0) {
+ foreach my $lang (@currlangs) {
+ if (grep(/^\Q$lang\E$/,@delurls)) {
+ $changes{'helpurl'}{$lang} = 1;
+ } elsif ($env{'form.loginhelpurl_'.$lang.'.filename'}) {
+ $changes{'helpurl'}{$lang} = 1;
+ $newfile{$lang} = $env{'form.loginhelpurl_'.$lang.'.filename'};
+ push(@newlangs,$lang);
+ } else {
+ $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang};
+ }
+ }
+ }
+ unless (grep(/^nolang$/,@currlangs)) {
+ if ($env{'form.loginhelpurl_nolang.filename'}) {
+ $changes{'helpurl'}{'nolang'} = 1;
+ $newfile{'nolang'} = $env{'form.loginhelpurl_nolang.filename'};
+ push(@newlangs,'nolang');
+ }
+ }
+ if ($env{'form.loginhelpurl_add_lang'}) {
+ if ((defined($langchoices{$env{'form.loginhelpurl_add_lang'}})) &&
+ ($env{'form.loginhelpurl_add_file.filename'})) {
+ $newfile{$env{'form.loginhelpurl_add_lang'}} = $env{'form.loginhelpurl_add_file.filename'};
+ $addedfile = $env{'form.loginhelpurl_add_lang'};
+ }
+ }
+ if ((@newlangs > 0) || ($addedfile)) {
+ my $error;
+ my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm);
+ if ($configuserok eq 'ok') {
+ if ($switchserver) {
+ $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver);
+ } elsif ($author_ok eq 'ok') {
+ my @allnew = @newlangs;
+ if ($addedfile ne '') {
+ push(@allnew,$addedfile);
+ }
+ foreach my $lang (@allnew) {
+ my $formelem = 'loginhelpurl_'.$lang;
+ if ($lang eq $env{'form.loginhelpurl_add_lang'}) {
+ $formelem = 'loginhelpurl_add_file';
+ }
+ (my $result,$newurl{$lang}) = &publishlogo($r,'upload',$formelem,$dom,$confname,
+ "help/$lang",'','',$newfile{$lang});
+ if ($result eq 'ok') {
+ $loginhash{'login'}{'helpurl'}{$lang} = $newurl{$lang};
+ $changes{'helpurl'}{$lang} = 1;
+ } else {
+ my $puberror = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$newfile{$lang},$result);
+ $errors .= '
'.$puberror.'
';
+ if ((grep(/^\Q$lang\E$/,@currlangs)) &&
+ (!grep(/^\Q$lang\E$/,@delurls))) {
+
+ $loginhash{'login'}{'helpurl'}{$lang} = $domconfig{'login'}{'helpurl'}{$lang};
+ }
+ }
+ }
+ } else {
+ $error = &mt("Upload of custom log-in help file(s) failed because an author role could not be assigned to a Domain Configuration user ([_1]) in domain: [_2]. Error was: [_3].",$confname,$dom,$author_ok);
+ }
+ } else {
+ $error = &mt("Upload of custom log-in help file(s) failed because a Domain Configuration user ([_1]) could not be created in domain: [_2]. Error was: [_3].",$confname,$dom,$configuserok);
+ }
+ if ($error) {
+ &Apache::lonnet::logthis($error);
+ $errors .= '
';
} else {
$resulttext = &mt('No changes made to auto-enrollment settings');
@@ -2927,21 +6857,43 @@ sub modify_autoupdate {
lastname => 'Last Name',
firstname => 'First Name',
middlename => 'Middle Name',
- gen => 'Generation',
+ generation => 'Generation',
);
- my $othertitle = &mt('All users');
+ $othertitle = &mt('All users');
if (keys(%{$usertypes}) > 0) {
$othertitle = &mt('Other users');
}
foreach my $key (keys(%env)) {
if ($key =~ /^form\.updateable_(.+)_([^_]+)$/) {
- push(@{$fields{$1}},$2);
+ my ($usertype,$item) = ($1,$2);
+ if (grep(/^\Q$item\E$/,keys(%fieldtitles))) {
+ if ($usertype eq 'default') {
+ push(@{$fields{$1}},$2);
+ } elsif (ref($types) eq 'ARRAY') {
+ if (grep(/^\Q$usertype\E$/,@{$types})) {
+ push(@{$fields{$1}},$2);
+ }
+ }
+ }
+ }
+ }
+ my @lockablenames = &Apache::loncommon::get_env_multiple('form.lockablenames');
+ @lockablenames = sort(@lockablenames);
+ if (ref($currautoupdate{'lockablenames'}) eq 'ARRAY') {
+ my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames);
+ if (@changed) {
+ $changes{'lockablenames'} = 1;
+ }
+ } else {
+ if (@lockablenames) {
+ $changes{'lockablenames'} = 1;
}
}
my %updatehash = (
autoupdate => { run => $env{'form.autoupdate_run'},
classlists => $env{'form.classlists'},
fields => {%fields},
+ lockablenames => \@lockablenames,
}
);
foreach my $key (keys(%currautoupdate)) {
@@ -2959,9 +6911,11 @@ sub modify_autoupdate {
foreach my $type (@{$currautoupdate{$key}{$item}}) {
if (!exists($fields{$item})) {
$change = 1;
+ last;
} elsif (ref($fields{$item}) eq 'ARRAY') {
if (!grep(/^\Q$type\E$/,@{$fields{$item}})) {
$change = 1;
+ last;
}
}
}
@@ -2971,12 +6925,41 @@ sub modify_autoupdate {
}
}
}
+ } elsif ($key eq 'lockablenames') {
+ if (ref($currautoupdate{$key}) eq 'ARRAY') {
+ my @changed = &Apache::loncommon::compare_arrays($currautoupdate{'lockablenames'},\@lockablenames);
+ if (@changed) {
+ $changes{'lockablenames'} = 1;
+ }
+ } else {
+ if (@lockablenames) {
+ $changes{'lockablenames'} = 1;
+ }
+ }
+ }
+ }
+ unless (grep(/^\Qlockablenames\E$/,keys(%currautoupdate))) {
+ if (@lockablenames) {
+ $changes{'lockablenames'} = 1;
}
}
foreach my $item (@{$types},'default') {
if (defined($fields{$item})) {
if (ref($currautoupdate{'fields'}) eq 'HASH') {
- if (!exists($currautoupdate{'fields'}{$item})) {
+ if (ref($currautoupdate{'fields'}{$item}) eq 'ARRAY') {
+ my $change = 0;
+ if (ref($fields{$item}) eq 'ARRAY') {
+ foreach my $type (@{$fields{$item}}) {
+ if (!grep(/^\Q$type\E$/,@{$currautoupdate{'fields'}{$item}})) {
+ $change = 1;
+ last;
+ }
+ }
+ }
+ if ($change) {
+ push(@{$changes{'fields'}},$item);
+ }
+ } else {
push(@{$changes{'fields'}},$item);
}
} else {
@@ -2990,7 +6973,17 @@ sub modify_autoupdate {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'
';
foreach my $key (sort(keys(%changes))) {
- if (ref($changes{$key}) eq 'ARRAY') {
+ if ($key eq 'lockablenames') {
+ $resulttext .= '
';
+ if (@lockablenames) {
+ $usertypes->{'default'} = $othertitle;
+ $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update), available for the following affiliations:").' '.
+ join(', ', map { $usertypes->{$_}; } @lockablenames).'
';
+ } else {
+ $resulttext .= &mt("User preference to disable replacement of user's name with institutional data (by auto-update) is unavailable.");
+ }
+ $resulttext .= '
';
+ } elsif (ref($changes{$key}) eq 'ARRAY') {
foreach my $item (@{$changes{$key}}) {
my @newvalues;
foreach my $type (@{$fields{$item}}) {
@@ -3029,6 +7022,81 @@ sub modify_autoupdate {
return $resulttext;
}
+sub modify_autocreate {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%changes,%currautocreate,%newvals,%autocreatehash);
+ if (ref($domconfig{'autocreate'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'autocreate'}})) {
+ $currautocreate{$key} = $domconfig{'autocreate'}{$key};
+ }
+ }
+ my %title= ( xml => 'Auto-creation of courses in XML course description files',
+ req => 'Auto-creation of validated requests for official courses',
+ xmldc => 'Identity of course creator of courses from XML files',
+ );
+ my @types = ('xml','req');
+ foreach my $item (@types) {
+ $newvals{$item} = $env{'form.autocreate_'.$item};
+ $newvals{$item} =~ s/\D//g;
+ $newvals{$item} = 0 if ($newvals{$item} eq '');
+ }
+ $newvals{'xmldc'} = $env{'form.autocreate_xmldc'};
+ my %domcoords = &get_active_dcs($dom);
+ unless (exists($domcoords{$newvals{'xmldc'}})) {
+ $newvals{'xmldc'} = '';
+ }
+ %autocreatehash = (
+ autocreate => { xml => $newvals{'xml'},
+ req => $newvals{'req'},
+ }
+ );
+ if ($newvals{'xmldc'} ne '') {
+ $autocreatehash{'autocreate'}{'xmldc'} = $newvals{'xmldc'};
+ }
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%autocreatehash,
+ $dom);
+ if ($putresult eq 'ok') {
+ my @items = @types;
+ if ($newvals{'xml'}) {
+ push(@items,'xmldc');
+ }
+ foreach my $item (@items) {
+ if (exists($currautocreate{$item})) {
+ if ($currautocreate{$item} ne $newvals{$item}) {
+ $changes{$item} = 1;
+ }
+ } elsif ($newvals{$item}) {
+ $changes{$item} = 1;
+ }
+ }
+ if (keys(%changes) > 0) {
+ my @offon = ('off','on');
+ $resulttext = &mt('Changes made:').'
';
+ foreach my $item (@types) {
+ if ($changes{$item}) {
+ my $newtxt = $offon[$newvals{$item}];
+ $resulttext .= '
'.
+ &mt("$title{$item} set to [_1]$newtxt [_2]",
+ '','').
+ '
';
+ }
+ }
+ if ($changes{'xmldc'}) {
+ my ($dcname,$dcdom) = split(':',$newvals{'xmldc'});
+ my $newtxt = &Apache::loncommon::plainname($dcname,$dcdom);
+ $resulttext .= '
'.&mt("$title{'xmldc'} set to [_1]",''.$newtxt.'').'
'.
+ &mt('E-mail record of completed LON-CAPA updates to [_1] set to "'.
+ $offon[$env{'form.reportupdates'}].'".',
+ &Apache::loncommon::modal_link('http://loncapa.org/core.html',
+ &mt('LON-CAPA core group - MSU'),600,500)).
+ '
';
+ }
$resulttext .= '
';
} else {
$resulttext = &mt('No changes made to contact information');
@@ -3314,33 +7445,39 @@ sub modify_contacts {
sub modify_usercreation {
my ($dom,%domconfig) = @_;
- my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate);
+ my ($resulttext,%curr_usercreation,%changes,%authallowed,%cancreate,%save_usercreate);
my $warningmsg;
if (ref($domconfig{'usercreation'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'usercreation'}})) {
- $curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
+ if ($key eq 'cancreate') {
+ if (ref($domconfig{'usercreation'}{$key}) eq 'HASH') {
+ foreach my $item (keys(%{$domconfig{'usercreation'}{$key}})) {
+ if (($item eq 'selfcreate') || ($item eq 'statustocreate') ||
+ ($item eq 'captcha') || ($item eq 'recaptchakeys')) {
+ $save_usercreate{$key}{$item} = $domconfig{'usercreation'}{$key}{$item};
+ } else {
+ $curr_usercreation{$key}{$item} = $domconfig{'usercreation'}{$key}{$item};
+ }
+ }
+ }
+ } elsif ($key eq 'email_rule') {
+ $save_usercreate{$key} = $domconfig{'usercreation'}{$key};
+ } else {
+ $curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
+ }
}
}
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','selfcreate');
+ my @contexts = ('author','course','requestcrs');
foreach my $item(@contexts) {
$cancreate{$item} = $env{'form.can_createuser_'.$item};
- if ($item eq 'selfcreate') {
- 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($curr_usercreation{'cancreate'}) eq 'HASH') {
foreach my $item (@contexts) {
if ($curr_usercreation{'cancreate'}{$item} ne $cancreate{$item}) {
push(@{$changes{'cancreate'}},$item);
- }
+ }
}
} elsif (ref($curr_usercreation{'cancreate'}) eq 'ARRAY') {
foreach my $item (@contexts) {
@@ -3390,21 +7527,6 @@ sub modify_usercreation {
push(@{$changes{'id_rule'}},@id_rule);
}
- if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') {
- foreach my $type (@{$curr_usercreation{'email_rule'}}) {
- if (!grep(/^\Q$type\E$/,@email_rule)) {
- push(@{$changes{'email_rule'}},$type);
- }
- }
- foreach my $type (@email_rule) {
- if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) {
- push(@{$changes{'email_rule'}},$type);
- }
- }
- } else {
- push(@{$changes{'email_rule'}},@email_rule);
- }
-
my @authen_contexts = ('author','course','domain');
my @authtypes = ('int','krb4','krb5','loc');
my %authhash;
@@ -3435,47 +7557,35 @@ sub modify_usercreation {
}
}
+ $save_usercreate{'cancreate'}{'course'} = $cancreate{'course'};
+ $save_usercreate{'cancreate'}{'author'} = $cancreate{'author'};
+ $save_usercreate{'cancreate'}{'requestcrs'} = $cancreate{'requestcrs'};
+ $save_usercreate{'id_rule'} = \@id_rule;
+ $save_usercreate{'username_rule'} = \@username_rule,
+ $save_usercreate{'authtypes'} = \%authhash;
+
my %usercreation_hash = (
- usercreation => {
- cancreate => \%cancreate,
- username_rule => \@username_rule,
- id_rule => \@id_rule,
- email_rule => \@email_rule,
- authtypes => \%authhash,
- }
- );
+ usercreation => \%save_usercreate,
+ );
my $putresult = &Apache::lonnet::put_dom('configuration',\%usercreation_hash,
$dom);
+
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 'selfcreate') {
- if ($cancreate{$type} eq 'none') {
- $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 {
- if ($cancreate{$type} eq 'none') {
- $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
- } elsif ($cancreate{$type} eq 'any') {
- $chgtext .= &mt('creation of new users is permitted for both institutional and non-institutional usernames.');
- } elsif ($cancreate{$type} eq 'official') {
- $chgtext .= &mt('creation of new users is only permitted for institutional usernames.');
- } elsif ($cancreate{$type} eq 'unofficial') {
- $chgtext .= &mt('creation of new users is only permitted for non-institutional usernames.');
- }
+ my $chgtext = $lt{$type}.', ';
+ if ($cancreate{$type} eq 'none') {
+ $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
+ } elsif ($cancreate{$type} eq 'any') {
+ $chgtext .= &mt('creation of new users is permitted for both institutional and non-institutional usernames.');
+ } elsif ($cancreate{$type} eq 'official') {
+ $chgtext .= &mt('creation of new users is only permitted for institutional usernames.');
+ } elsif ($cancreate{$type} eq 'unofficial') {
+ $chgtext .= &mt('creation of new users is only permitted for non-institutional usernames.');
}
$resulttext .= '
'.&mt('There are now no ID formats restricted to verified users in the institutional directory.').'
';
}
}
- if (ref($changes{'email_rule'}) eq 'ARRAY') {
- my ($emailrules,$emailruleorder) =
- &Apache::lonnet::inst_userrules($dom,'email');
- my $chgtext = '
';
- foreach my $type (@email_rule) {
- if (ref($emailrules->{$type}) eq 'HASH') {
- $chgtext .= '
'.$emailrules->{$type}{'name'}.'
';
- }
- }
- $chgtext .= '
';
- if (@email_rule > 0) {
- $resulttext .= '
'.&mt('Accounts may not be created by users self-enrolling with e-mail addresses of the following types: ').$chgtext.'
';
- } else {
- $resulttext .= '
'.&mt('There are now no restrictions on e-mail addresses which may be used as a username when self-enrolling.').'
';
- }
- }
-
my %authname = &authtype_names();
my %context_title = &context_names();
if (ref($changes{'authtypes'}) eq 'ARRAY') {
@@ -3565,12 +7658,538 @@ sub modify_usercreation {
return $resulttext;
}
+sub modify_selfcreation {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,$warningmsg,%curr_usercreation,%curr_usermodify,%changes,%cancreate);
+ my (%save_usercreate,%save_usermodify);
+#
+# Retrieve current domain configuration for self-creation of usernames from $domconfig{'usercreation'}.
+#
+ if (ref($domconfig{'usercreation'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'usercreation'}})) {
+ if ($key eq 'cancreate') {
+ if (ref($domconfig{'usercreation'}{$key}) eq 'HASH') {
+ foreach my $item (keys(%{$domconfig{'usercreation'}{$key}})) {
+ if (($item eq 'selfcreate') || ($item eq 'statustocreate') ||
+ ($item eq 'captcha') || ($item eq 'recaptchakeys') ||
+ ($item eq 'emailusername') || ($item eq 'notify')) {
+ $curr_usercreation{$key}{$item} = $domconfig{'usercreation'}{$key}{$item};
+ } else {
+ $save_usercreate{$key}{$item} = $domconfig{'usercreation'}{$key}{$item};
+ }
+ }
+ }
+ } elsif ($key eq 'email_rule') {
+ $curr_usercreation{$key} = $domconfig{'usercreation'}{$key};
+ } else {
+ $save_usercreate{$key} = $domconfig{'usercreation'}{$key};
+ }
+ }
+ }
+#
+# Retrieve current domain configuration for self-creation of usernames from $domconfig{'usermodification'}.
+#
+ if (ref($domconfig{'usermodification'}) eq 'HASH') {
+ foreach my $key (keys(%{$domconfig{'usermodification'}})) {
+ if ($key eq 'selfcreate') {
+ $curr_usermodify{$key} = $domconfig{'usermodification'}{$key};
+ } else {
+ $save_usermodify{$key} = $domconfig{'usermodification'}{$key};
+ }
+ }
+ }
+
+ my @contexts = ('selfcreate');
+ @{$cancreate{'selfcreate'}} = ();
+ %{$cancreate{'emailusername'}} = ();
+ @{$cancreate{'statustocreate'}} = ();
+ 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 username (automatic creation)',
+ emailapproval => 'users who provide a valid e-mail address for use as username (queued for Domain Coordinator review)',
+ );
+#
+# Populate $cancreate{'selfcreate'} array reference with types of user, for which self-creation of user accounts
+# is permitted.
+#
+ foreach my $item ('login','sso','email') {
+ if ($item eq 'email') {
+ if ($env{'form.cancreate_email'} eq 'email') {
+ push(@{$cancreate{'selfcreate'}},'email');
+ } elsif ($env{'form.cancreate_email'} eq 'emailapproval') {
+ push(@{$cancreate{'selfcreate'}},'emailapproval');
+ }
+ } else {
+ if ($env{'form.cancreate_'.$item}) {
+ push(@{$cancreate{'selfcreate'}},$item);
+ }
+ }
+ }
+ my (@email_rule,%userinfo,%savecaptcha);
+ my ($infofields,$infotitles) = &Apache::loncommon::emailusername_info();
+#
+# Populate $cancreate{'emailusername'} hash ref with information types (if new user will provide data
+# value set to one), if self-creation with e-mail address permitted.
+#
+ if (($env{'form.cancreate_email'} eq 'email') || ($env{'form.cancreate_email'} eq 'emailapproval')) {
+ push(@contexts,'emailusername');
+ map { $userinfo{$_} = 1; } &Apache::loncommon::get_env_multiple('form.canmodify_emailusername');
+ if (ref($infofields) eq 'ARRAY') {
+ foreach my $field (@{$infofields}) {
+ if ($userinfo{$field}) {
+ $cancreate{'emailusername'}{$field} = 1;
+ }
+ }
+ }
+
+#
+# Populate $cancreate{'notify'} hash ref with names of Domain Coordinators who are to be notified of
+# queued requests for self-creation of account using e-mail address as username
+#
+
+ my @approvalnotify = &Apache::loncommon::get_env_multiple('form.selfcreationnotifyapproval');
+ @approvalnotify = sort(@approvalnotify);
+ $cancreate{'notify'}{'approval'} = join(',',@approvalnotify);
+ if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
+ if (ref($curr_usercreation{'cancreate'}{'notify'}) eq 'HASH') {
+ if ($curr_usercreation{'cancreate'}{'notify'}{'approval'} ne $cancreate{'notify'}{'approval'}) {
+ push(@{$changes{'cancreate'}},'notify');
+ }
+ } else {
+ if ($cancreate{'notify'}{'approval'}) {
+ push(@{$changes{'cancreate'}},'notify');
+ }
+ }
+ } elsif ($cancreate{'notify'}{'approval'}) {
+ push(@{$changes{'cancreate'}},'notify');
+ }
+
+#
+# Retrieve rules (if any) governing types of e-mail address which may be used as a username
+#
+ @email_rule = &Apache::loncommon::get_env_multiple('form.email_rule');
+ &process_captcha('cancreate',\%changes,\%savecaptcha,$curr_usercreation{'cancreate'});
+ if (ref($curr_usercreation{'email_rule'}) eq 'ARRAY') {
+ if (@{$curr_usercreation{'email_rule'}} > 0) {
+ foreach my $type (@{$curr_usercreation{'email_rule'}}) {
+ if (!grep(/^\Q$type\E$/,@email_rule)) {
+ push(@{$changes{'email_rule'}},$type);
+ }
+ }
+ }
+ if (@email_rule > 0) {
+ foreach my $type (@email_rule) {
+ if (!grep(/^\Q$type\E$/,@{$curr_usercreation{'email_rule'}})) {
+ push(@{$changes{'email_rule'}},$type);
+ }
+ }
+ }
+ } elsif (@email_rule > 0) {
+ push(@{$changes{'email_rule'}},@email_rule);
+ }
+ }
+#
+# Check if domain default is set appropriately, if selef-creation of accounts is to be available for
+# institutional log-in.
+#
+ if (grep(/^login$/,@{$cancreate{'selfcreate'}})) {
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1);
+ if (!((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) ||
+ ($domdefaults{'auth_def'} eq 'localauth'))) {
+ $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.');
+ }
+ }
+ my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
+ my @fields = ('lastname','firstname','middlename','generation',
+ 'permanentemail','id');
+ my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
+#
+# Where usernames may created for institutional log-in and/or institutional single sign on:
+# (a) populate $cancreate{'statustocreate'} array reference with institutional status types who
+# may self-create accounts
+# (b) populate $save_usermodify{'selfcreate'} hash reference with status types, and information fields
+# which the user may supply, if institutional data is unavailable.
+#
+ if (($env{'form.cancreate_login'}) || ($env{'form.cancreate_sso'})) {
+ if (ref($types) eq 'ARRAY') {
+ if (@{$types} > 0) {
+ @{$cancreate{'statustocreate'}} = &Apache::loncommon::get_env_multiple('form.statustocreate');
+ push(@contexts,'statustocreate');
+ } else {
+ undef($cancreate{'statustocreate'});
+ }
+ push(@{$types},'default');
+ $usertypes->{'default'} = $othertitle;
+ foreach my $type (@{$types}) {
+ my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$type);
+ foreach my $field (@fields) {
+ if (grep(/^\Q$field\E$/,@modifiable)) {
+ $save_usermodify{'selfcreate'}{$type}{$field} = 1;
+ } else {
+ $save_usermodify{'selfcreate'}{$type}{$field} = 0;
+ }
+ }
+ }
+ if (ref($curr_usermodify{'selfcreate'}) eq 'HASH') {
+ foreach my $type (@{$types}) {
+ if (ref($curr_usermodify{'selfcreate'}{$type}) eq 'HASH') {
+ foreach my $field (@fields) {
+ if ($save_usermodify{'selfcreate'}{$type}{$field} ne
+ $curr_usermodify{'selfcreate'}{$type}{$field}) {
+ push(@{$changes{'selfcreate'}},$type);
+ last;
+ }
+ }
+ }
+ }
+ } else {
+ foreach my $type (@{$types}) {
+ push(@{$changes{'selfcreate'}},$type);
+ }
+ }
+ }
+ }
+ foreach my $item (@contexts) {
+ 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);
+ }
+ }
+ }
+ }
+ if (ref($cancreate{$item}) eq 'ARRAY') {
+ foreach my $type (@{$cancreate{$item}}) {
+ if (!grep(/^$type$/,@{$curr_usercreation{'cancreate'}{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ } elsif (ref($curr_usercreation{'cancreate'}{$item}) eq 'HASH') {
+ if (ref($cancreate{$item}) eq 'HASH') {
+ foreach my $curr (keys(%{$curr_usercreation{'cancreate'}{$item}})) {
+ if (!$cancreate{$item}{$curr}) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ foreach my $field (keys(%{$cancreate{$item}})) {
+ if (!$curr_usercreation{'cancreate'}{$item}{$field}) {
+ print STDERR "field $field in cancreate but not in curr\n";
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ }
+ } elsif ($curr_usercreation{'cancreate'}{$item}) {
+ if (ref($cancreate{$item}) eq 'ARRAY') {
+ if (!grep(/^\Q$curr_usercreation{'cancreate'}{$item}\E$/,@{$cancreate{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ } elsif (ref($cancreate{$item}) eq 'HASH') {
+ if (!$cancreate{$item}{$curr_usercreation{'cancreate'}{$item}}) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+ } elsif ($item eq 'emailusername') {
+ if (keys(%userinfo) > 0) {
+ push(@{$changes{'cancreate'}},$item);
+ }
+ }
+ }
+#
+# Populate %save_usercreate hash with updates to self-creation configuration.
+#
+ $save_usercreate{'cancreate'}{'captcha'} = $savecaptcha{'captcha'};
+ $save_usercreate{'cancreate'}{'recaptchakeys'} = $savecaptcha{'recaptchakeys'};
+ $save_usercreate{'cancreate'}{'selfcreate'} = $cancreate{'selfcreate'};
+ if (ref($cancreate{'notify'}) eq 'HASH') {
+ $save_usercreate{'cancreate'}{'notify'} = $cancreate{'notify'};
+ }
+ if (ref($cancreate{'statustocreate'}) eq 'ARRAY') {
+ $save_usercreate{'cancreate'}{'statustocreate'} = $cancreate{'statustocreate'};
+ }
+ $save_usercreate{'cancreate'}{'emailusername'} = $cancreate{'emailusername'};
+ $save_usercreate{'emailrule'} = \@email_rule;
+
+ my %userconfig_hash = (
+ usercreation => \%save_usercreate,
+ usermodification => \%save_usermodify,
+ );
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%userconfig_hash,
+ $dom);
+#
+# Accumulate details of changes to domain cofiguration for self-creation of usernames in $resulttext
+#
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ $resulttext = &mt('Changes made:').'
';
+ if (ref($changes{'cancreate'}) eq 'ARRAY') {
+ my %lt = &selfcreation_types();
+ foreach my $type (@{$changes{'cancreate'}}) {
+ my $chgtext;
+ if ($type eq 'selfcreate') {
+ if (@{$cancreate{$type}} == 0) {
+ $chgtext .= &mt('Self creation of a new user account is not permitted.');
+ } else {
+ $chgtext .= &mt('Self-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.');
+ }
+ }
+ }
+ } elsif ($type eq 'captcha') {
+ if ($savecaptcha{$type} eq 'notused') {
+ $chgtext .= &mt('No CAPTCHA validation in use for self-creation screen.');
+ } else {
+ my %captchas = &captcha_phrases();
+ if ($captchas{$savecaptcha{$type}}) {
+ $chgtext .= &mt("Validation for self-creation screen set to $captchas{$savecaptcha{$type}}.");
+ } else {
+ $chgtext .= &mt('Validation for self-creation screen set to unknown type.');
+ }
+ }
+ } elsif ($type eq 'recaptchakeys') {
+ my ($privkey,$pubkey);
+ if (ref($savecaptcha{$type}) eq 'HASH') {
+ $pubkey = $savecaptcha{$type}{'public'};
+ $privkey = $savecaptcha{$type}{'private'};
+ }
+ $chgtext .= &mt('ReCAPTCHA keys changes').'
';
+ if (!$pubkey) {
+ $chgtext .= '
'.&mt('Public key deleted').'
';
+ } else {
+ $chgtext .= '
'.&mt('Public key set to [_1]',$pubkey).'
';
+ }
+ if (!$privkey) {
+ $chgtext .= '
'.&mt('Private key deleted').'
';
+ } else {
+ $chgtext .= '
'.&mt('Private key set to [_1]',$pubkey).'
';
+ }
+ $chgtext .= '
';
+ } elsif ($type eq 'emailusername') {
+ if (ref($cancreate{'emailusername'}) eq 'HASH') {
+ if (keys(%{$cancreate{'emailusername'}}) > 0) {
+ $chgtext .= &mt('When self-creating account with e-mail as username, user will provide the following information:').
+ '
';
+ foreach my $field (@{$infofields}) {
+ if ($cancreate{'emailusername'}{$field}) {
+ $chgtext .= '
'.$infotitles->{$field}.'
';
+ }
+ }
+ $chgtext .= '
';
+ } else {
+ $chgtext .= &mt('When self creating account with e-mail as username, user will not provide any information besides e-mail address');
+ }
+ }
+ } elsif ($type eq 'notify') {
+ $chgtext = &mt('No Domain Coordinators will receive notification of username requests requiring approval.');
+ if (ref($changes{'cancreate'}) eq 'ARRAY') {
+ if ((grep(/^notify$/,@{$changes{'cancreate'}})) && (ref($cancreate{'notify'}) eq 'HASH')) {
+ if ($cancreate{'notify'}{'approval'}) {
+ $chgtext = &mt('Notification of username requests requiring approval will be sent to: ').$cancreate{'notify'}{'approval'};
+ }
+ }
+ }
+ }
+ if ($chgtext) {
+ $resulttext .= '
'.$chgtext.'
';
+ }
+ }
+ }
+ if (ref($changes{'email_rule'}) eq 'ARRAY') {
+ my ($emailrules,$emailruleorder) =
+ &Apache::lonnet::inst_userrules($dom,'email');
+ my $chgtext = '
';
+ foreach my $type (@email_rule) {
+ if (ref($emailrules->{$type}) eq 'HASH') {
+ $chgtext .= '
'.$emailrules->{$type}{'name'}.'
';
+ }
+ }
+ $chgtext .= '
';
+ if (@email_rule > 0) {
+ $resulttext .= '
'.
+ &mt('Accounts may not be created by users self-enrolling with e-mail addresses of the following types: ').
+ $chgtext.
+ '
';
+ } else {
+ $resulttext .= '
'.
+ &mt('There are now no restrictions on e-mail addresses which may be used as a username when self-enrolling.').
+ '
';
+ my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
+ foreach my $type (@{$changes{'selfcreate'}}) {
+ my $typename = $type;
+ if (ref($usertypes) eq 'HASH') {
+ if ($usertypes->{$type} ne '') {
+ $typename = $usertypes->{$type};
+ }
+ }
+ my @modifiable;
+ $resulttext .= '
'.
+ &mt('Self-creation of account by users with status: [_1]',
+ ''.$typename.'').
+ ' - '.&mt('modifiable fields (if institutional data blank): ');
+ foreach my $field (@fields) {
+ if ($save_usermodify{'selfcreate'}{$type}{$field}) {
+ push(@modifiable,''.$fieldtitles{$field}.'');
+ }
+ }
+ if (@modifiable > 0) {
+ $resulttext .= join(', ',@modifiable);
+ } else {
+ $resulttext .= &mt('none');
+ }
+ $resulttext .= '
';
+ }
+ $resulttext .= '
';
+ }
+ $resulttext .= '
';
+ } else {
+ $resulttext = &mt('No changes made to self-creation settings');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).'';
+ }
+ if ($warningmsg ne '') {
+ $resulttext .= ' '.$warningmsg.' ';
+ }
+ return $resulttext;
+}
+
+sub process_captcha {
+ my ($container,$changes,$newsettings,$current) = @_;
+ return unless ((ref($changes) eq 'HASH') && (ref($newsettings) eq 'HASH') || (ref($current) eq 'HASH'));
+ $newsettings->{'captcha'} = $env{'form.'.$container.'_captcha'};
+ unless ($newsettings->{'captcha'} eq 'recaptcha' || $newsettings->{'captcha'} eq 'notused') {
+ $newsettings->{'captcha'} = 'original';
+ }
+ if ($current->{'captcha'} ne $newsettings->{'captcha'}) {
+ if ($container eq 'cancreate') {
+ if (ref($changes->{'cancreate'}) eq 'ARRAY') {
+ push(@{$changes->{'cancreate'}},'captcha');
+ } elsif (!defined($changes->{'cancreate'})) {
+ $changes->{'cancreate'} = ['captcha'];
+ }
+ } else {
+ $changes->{'captcha'} = 1;
+ }
+ }
+ my ($newpub,$newpriv,$currpub,$currpriv);
+ if ($newsettings->{'captcha'} eq 'recaptcha') {
+ $newpub = $env{'form.'.$container.'_recaptchapub'};
+ $newpriv = $env{'form.'.$container.'_recaptchapriv'};
+ $newpub =~ s/\W//g;
+ $newpriv =~ s/\W//g;
+ $newsettings->{'recaptchakeys'} = {
+ public => $newpub,
+ private => $newpriv,
+ };
+ }
+ if (ref($current->{'recaptchakeys'}) eq 'HASH') {
+ $currpub = $current->{'recaptchakeys'}{'public'};
+ $currpriv = $current->{'recaptchakeys'}{'private'};
+ unless ($newsettings->{'captcha'} eq 'recaptcha') {
+ $newsettings->{'recaptchakeys'} = {
+ public => '',
+ private => '',
+ }
+ }
+ }
+ if (($newpub ne $currpub) || ($newpriv ne $currpriv)) {
+ if ($container eq 'cancreate') {
+ if (ref($changes->{'cancreate'}) eq 'ARRAY') {
+ push(@{$changes->{'cancreate'}},'recaptchakeys');
+ } elsif (!defined($changes->{'cancreate'})) {
+ $changes->{'cancreate'} = ['recaptchakeys'];
+ }
+ } else {
+ $changes->{'recaptchakeys'} = 1;
+ }
+ }
+ return;
+}
+
sub modify_usermodification {
my ($dom,%domconfig) = @_;
- my ($resulttext,%curr_usermodification,%changes);
+ my ($resulttext,%curr_usermodification,%changes,%modifyhash);
if (ref($domconfig{'usermodification'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'usermodification'}})) {
- $curr_usermodification{$key} = $domconfig{'usermodification'}{$key};
+ if ($key eq 'selfcreate') {
+ $modifyhash{$key} = $domconfig{'usermodification'}{$key};
+ } else {
+ $curr_usermodification{$key} = $domconfig{'usermodification'}{$key};
+ }
}
}
my @contexts = ('author','course');
@@ -3585,7 +8204,6 @@ sub modify_usermodification {
course => ['st','ep','ta','in','cr'],
);
my %fieldtitles = &Apache::loncommon::personal_data_fieldtitles();
- my %modifyhash;
foreach my $context (@contexts) {
foreach my $role (@{$roles{$context}}) {
my @modifiable = &Apache::loncommon::get_env_multiple('form.canmodify_'.$role);
@@ -3617,6 +8235,7 @@ sub modify_usermodification {
}
}
}
+# FIXME need to ensure selfcreate stuff is preserved
my %usermodification_hash = (
usermodification => \%modifyhash,
);
@@ -3666,10 +8285,10 @@ sub modify_usermodification {
}
sub modify_defaults {
- my ($dom,$r) = @_;
+ my ($dom,$lastactref,%domconfig) = @_;
my ($resulttext,$mailmsgtxt,%newvalues,%changes,@errors);
- my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
- my @items = ('auth_def','auth_arg_def','lang_def');
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1);
+ my @items = ('auth_def','auth_arg_def','lang_def','timezone_def','datelocale_def','portal_def');
my @authtypes = ('internal','krb4','krb5','localauth');
foreach my $item (@items) {
$newvalues{$item} = $env{'form.'.$item};
@@ -3683,33 +8302,52 @@ 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);
+ }
+ }
+ } elsif ($item eq 'portal_def') {
+ if ($newvalues{$item} ne '') {
+ unless ($newvalues{$item} =~ /^https?\:\/\/(([a-zA-Z0-9]|[a-zA-Z0-9][a-zA-Z0-9\-]*[a-zA-Z0-9])\.)*([A-Za-z]|[A-Za-z][A-Za-z0-9\-]*[A-Za-z0-9])\/?$/) {
+ 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);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'
';
- my $version = $r->dir_config('lonVersion');
+ my $version = &Apache::lonnet::get_server_loncaparev($dom);
my $mailmsgtext = "Changes made to domain settings in a LON-CAPA installation - domain: $dom (running version: $version) - dns_domain.tab needs to be updated with the following changes, to support legacy 2.4, 2.5 and 2.6 versions of LON-CAPA.\n\n";
foreach my $item (sort(keys(%changes))) {
my $value = $env{'form.'.$item};
@@ -3731,12 +8369,25 @@ 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 (ref($lastactref) eq 'HASH') {
+ $lastactref->{'domdefaults'} = 1;
+ }
+ if ($changes{'auth_def'} || $changes{'auth_arg_def'} || $changes{'lang_def'} || $changes{'datelocale_def'}) {
+ my $notify = 1;
+ if (ref($domconfig{'contacts'}) eq 'HASH') {
+ if ($domconfig{'contacts'}{'reportupdates'} == 0) {
+ $notify = 0;
+ }
+ }
+ if ($notify) {
+ &Apache::lonmsg::sendemail('installrecord@loncapa.org',
+ "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 = ''.
@@ -3753,7 +8404,7 @@ sub modify_defaults {
}
sub modify_scantron {
- my ($r,$dom,$confname,$domconfig) = @_;
+ my ($r,$dom,$confname,$lastactref,%domconfig) = @_;
my ($resulttext,%confhash,%changes,$errors);
my $custom = 'custom.tab';
my $default = 'default.tab';
@@ -3764,7 +8415,7 @@ sub modify_scantron {
my $error;
if ($configuserok eq 'ok') {
if ($switchserver) {
- $error = &mt("Upload of scantron format file is not permitted to this server: [_1]",$switchserver);
+ $error = &mt("Upload of bubblesheet format file is not permitted to this server: [_1]",$switchserver);
} else {
if ($author_ok eq 'ok') {
my ($result,$scantronurl) =
@@ -3772,7 +8423,7 @@ sub modify_scantron {
$confname,'scantron','','',$custom);
if ($result eq 'ok') {
$confhash{'scantron'}{'scantronformat'} = $scantronurl;
- $changes{'scantron'}{'scantronformat'} = 1;
+ $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);
}
@@ -3788,13 +8439,11 @@ sub modify_scantron {
$errors .= '
'.$error.'
';
}
}
- if (ref($domconfig) eq 'HASH') {
- if (ref($domconfig->{'scantron'}) eq 'HASH') {
- if ($domconfig->{'scantron'}{'scantronformat'} ne '') {
- if ($env{'form.scantronformat_del'}) {
- $confhash{'scantron'}{'scantronformat'} = '';
- $changes{'scantron'}{'scantronformat'} = 1;
- }
+ if (ref($domconfig{'scantron'}) eq 'HASH') {
+ if ($domconfig{'scantron'}{'scantronformat'} ne '') {
+ if ($env{'form.scantronformat_del'}) {
+ $confhash{'scantron'}{'scantronformat'} = '';
+ $changes{'scantronformat'} = 1;
}
}
}
@@ -3803,27 +8452,31 @@ sub modify_scantron {
$dom);
if ($putresult eq 'ok') {
if (keys(%changes) > 0) {
- $resulttext = &mt('Changes made:').'
';
- if (ref($changes{'scantron'}) eq 'HASH') {
- if ($changes{'scantron'}{'scantronformat'}) {
- if ($confhash{'scantron'}{'scantronformat'} eq '') {
- $resulttext .= '
'.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).'
';
- } else {
- $resulttext .= '
'.&mt('Custom scantron format file ([_1]) uploaded for use with courses in this domain.',$custom).'
';
+ }
+ 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 and community 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,
+ );
+ 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 modify_helpsettings {
+ my ($r,$dom,$confname,%domconfig) = @_;
+ my ($resulttext,$errors,%changes,%helphash);
+ my %defaultchecked = ('submitbugs' => 'on');
+ my @offon = ('off','on');
+ my @toggles = ('submitbugs');
+ if (ref($domconfig{'helpsettings'}) eq 'HASH') {
+ foreach my $item (@toggles) {
+ if ($defaultchecked{$item} eq 'on') {
+ if ($domconfig{'helpsettings'}{$item} eq '') {
+ if ($env{'form.'.$item} eq '0') {
+ $changes{$item} = 1;
+ }
+ } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) {
+ $changes{$item} = 1;
+ }
+ } elsif ($defaultchecked{$item} eq 'off') {
+ if ($domconfig{'helpsettings'}{$item} eq '') {
+ if ($env{'form.'.$item} eq '1') {
+ $changes{$item} = 1;
+ }
+ } elsif ($domconfig{'helpsettings'}{$item} ne $env{'form.'.$item}) {
+ $changes{$item} = 1;
+ }
+ }
+ if (($env{'form.'.$item} eq '0') || ($env{'form.'.$item} eq '1')) {
+ $helphash{'helpsettings'}{$item} = $env{'form.'.$item};
+ }
+ }
+ }
+ my $putresult;
+ if (keys(%changes) > 0) {
+ $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom);
+ if ($putresult eq 'ok') {
+ $resulttext = &mt('Changes made:').'
';
+ foreach my $item (sort(keys(%changes))) {
+ if ($item eq 'submitbugs') {
+ $resulttext .= '
'.&mt('Display link to: [_1] set to "'.$offon[$env{'form.'.$item}].'".',
+ &Apache::loncommon::modal_link('http://bugs.loncapa.org',
+ &mt('LON-CAPA bug tracker'),600,500)).'
';
+ }
+ }
+ $resulttext .= '
';
+ } else {
+ $resulttext = &mt('No changes made to help settings');
+ $errors .= '
';
+ }
+ my ($dcname,$dcdom) = split(':',$domcoord[$i]);
+ my $user = &Apache::loncommon::plainname($dcname,$dcdom);
+ $table .= '
';
+ }
+ $table .= '
';
+ } elsif ($numdcs == 1) {
+ my ($dcname,$dcdom) = split(':',$domcoord[0]);
+ my $user = &Apache::loncommon::plainname($dcname,$dcdom);
+ if ($inputtype eq 'radio') {
+ $table .= ''.$user;
+ if ($user ne $dcname.':'.$dcdom) {
+ $table .= ' ('.$dcname.':'.$dcdom.')';
+ }
+ } else {
+ my $check;
+ if (exists($currhash{$domcoord[0]})) {
+ $check = ' checked="checked"';
+ }
+ $table .= '';
+ $rows ++;
+ }
+ }
+ return ($numdcs,$table,$rows);
+}
+
+sub usersession_titles {
+ return &Apache::lonlocal::texthash(
+ hosted => 'Hosting of sessions for users from other domains on servers in this domain',
+ remote => 'Hosting of sessions for users in this domain on servers in other domains',
+ spares => 'Servers offloaded to, when busy',
+ version => 'LON-CAPA version requirement',
+ excludedomain => 'Allow all, but exclude specific domains',
+ includedomain => 'Deny all, but include specific domains',
+ primary => 'Primary (checked first)',
+ default => 'Default',
+ );
+}
+
+sub id_for_thisdom {
+ my (%servers) = @_;
+ my %altids;
+ foreach my $server (keys(%servers)) {
+ my $serverhome = &Apache::lonnet::get_server_homeID($servers{$server});
+ if ($serverhome ne $server) {
+ $altids{$serverhome} = $server;
+ }
+ }
+ return %altids;
+}
+
+sub count_servers {
+ my ($currbalancer,%servers) = @_;
+ my (@spares,$numspares);
+ foreach my $lonhost (sort(keys(%servers))) {
+ next if ($currbalancer eq $lonhost);
+ push(@spares,$lonhost);
+ }
+ if ($currbalancer) {
+ $numspares = scalar(@spares);
+ } else {
+ $numspares = scalar(@spares) - 1;
+ }
+ return ($numspares,@spares);
+}
+
+sub lonbalance_targets_js {
+ my ($dom,$types,$servers,$settings) = @_;
+ my $select = &mt('Select');
+ my ($alltargets,$allishome,$allinsttypes,@alltypes);
+ if (ref($servers) eq 'HASH') {
+ $alltargets = join("','",sort(keys(%{$servers})));
+ my @homedoms;
+ foreach my $server (sort(keys(%{$servers}))) {
+ if (&Apache::lonnet::host_domain($server) eq $dom) {
+ push(@homedoms,'1');
+ } else {
+ push(@homedoms,'0');
+ }
+ }
+ $allishome = join("','",@homedoms);
+ }
+ if (ref($types) eq 'ARRAY') {
+ if (@{$types} > 0) {
+ @alltypes = @{$types};
+ }
+ }
+ push(@alltypes,'default','_LC_adv','_LC_author','_LC_internetdom','_LC_external');
+ $allinsttypes = join("','",@alltypes);
+ my (%currbalancer,%currtargets,%currrules,%existing);
+ if (ref($settings) eq 'HASH') {
+ %existing = %{$settings};
+ }
+ &get_loadbalancers_config($servers,\%existing,\%currbalancer,
+ \%currtargets,\%currrules);
+ my $balancers = join("','",sort(keys(%currbalancer)));
+ return <<"END";
+
+
+
+END
+}
+
+sub new_spares_js {
+ my @sparestypes = ('primary','default');
+ my $types = join("','",@sparestypes);
+ my $select = &mt('Select');
+ return <<"END";
+
+
+
+END
+
+}
+
+sub common_domprefs_js {
+ return <<"END";
+
+
+
+END
+
+}
+
+sub recaptcha_js {
+ my %lt = &captcha_phrases();
+ return <<"END";
+
+
+
+END
+
+}
+
+sub credits_js {
+ return <<"END";
+
+
+
+END
+
+}
+
+sub captcha_phrases {
+ return &Apache::lonlocal::texthash (
+ priv => 'Private key',
+ pub => 'Public key',
+ original => 'original (CAPTCHA)',
+ recaptcha => 'successor (ReCAPTCHA)',
+ notused => 'unused',
+ );
+}
+
+sub devalidate_remote_domconfs {
+ my ($dom,$cachekeys) = @_;
+ return unless (ref($cachekeys) eq 'HASH');
+ my %servers = &Apache::lonnet::internet_dom_servers($dom);
+ my %thismachine;
+ map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
+ my @posscached = ('domainconfig','domdefaults');
+ if (keys(%servers) > 1) {
+ foreach my $server (keys(%servers)) {
+ next if ($thismachine{$server});
+ my @cached;
+ foreach my $name (@posscached) {
+ if ($cachekeys->{$name}) {
+ push(@cached,&escape($name).':'.&escape($dom));
+ }
+ }
+ if (@cached) {
+ &Apache::lonnet::remote_devalidate_cache($server,\@cached);
+ }
+ }
+ }
+ return;
+}
+
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.