'
- .'1 '
- .'2 '
- .&mt('Official courses (with institutional codes)')
- .' '
- .' '
- .&mt('Display').' '
- .' '.&mt('Do not display')
+ my ($datatable,$css_class,$chgstr);
+ my %default_names = (
+ instcode => 'Official courses (with institutional codes)',
+ communities => 'Communities',
+ );
+ my $select0 = ' selected="selected"';
+ my $select1 = '';
+ foreach my $default ('instcode','communities') {
+ $css_class = $itemcount%2?' class="LC_odd_row"':'';
+ $chgstr = ' onchange="javascript:reorderCats(this.form,'."'',$default"."_pos','0'".');"';
+ if ($default eq 'communities') {
+ $select1 = $select0;
+ $select0 = '';
+ }
+ $datatable .= ''
+ .''
+ .'1 '
+ .'2 '
+ .'3 '
+ .$default_names{$default}
+ .' '
+ .' '
+ .&mt('Display').' '
+ .' '.&mt('Do not display')
.' ';
- $itemcount ++;
+ $itemcount ++;
+ }
$css_class = $itemcount%2?' class="LC_odd_row"':'';
$chgstr = ' onchange="javascript:reorderCats(this.form,'."'','addcategory_pos','0'".');"';
$datatable .= ''
- .'1 '
- .'2 '
+ .''
+ .'1 '
+ .'2 '
+ .'3 '
.&mt('Add category').' '.&mt('Name:')
.' ';
return $datatable;
@@ -2723,11 +4305,24 @@ sub modifiable_userdata_row {
return $output;
}
-sub users_cansearch_row {
- my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle) = @_;
+sub insttypes_row {
+ my ($settings,$types,$usertypes,$dom,$numinrow,$othertitle,$context) = @_;
+ my %lt = &Apache::lonlocal::texthash (
+ cansearch => 'Users allowed to search',
+ statustocreate => 'Institutional affiliation(s) able to create own account (login/SSO)',
+ lockablenames => 'User preference to lock name',
+ );
+ my $showdom;
+ if ($context eq 'cansearch') {
+ $showdom = ' ('.$dom.')';
+ }
+ my $class = 'LC_left_item';
+ if ($context eq 'statustocreate') {
+ $class = 'LC_right_item';
+ }
my $output = ''.
- ''.&mt('Users allowed to search').' ('.$dom.')'.
- ' ';
+ ''.$lt{$context}.$showdom.
+ ' ';
@@ -2853,6 +4458,14 @@ sub modify_login {
newuser => 'Link for visitors to create a user account',
loginheader => 'Log-in box header');
my @offon = ('off','on');
+ my %curr_loginvia;
+ 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};
+ }
+ }
+ }
my %loginhash;
($errors,%colchanges) = &modify_colors($r,$dom,$confname,['login'],
\%domconfig,\%loginhash);
@@ -2865,6 +4478,93 @@ 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 $putresult = &Apache::lonnet::put_dom('configuration',\%loginhash,
$dom);
if ($putresult eq 'ok') {
@@ -2896,21 +4596,40 @@ sub modify_login {
}
}
}
- if (($domconfig{'login'}{'loginheader'} eq 'text') &&
- ($env{'form.loginheader'} eq 'image')) {
- $changes{'loginheader'} = 1;
- } elsif (($domconfig{'login'}{'loginheader'} eq '' ||
- $domconfig{'login'}{'loginheader'} eq 'image') &&
- ($env{'form.loginheader'} eq 'text')) {
- $changes{'loginheader'} = 1;
- }
}
if (keys(%changes) > 0 || $colchgtext) {
&Apache::loncommon::devalidate_domconfig_cache($dom);
$resulttext = &mt('Changes made:').'';
foreach my $item (sort(keys(%changes))) {
- if ($item eq 'loginheader') {
- $resulttext .= ''.&mt("$title{$item} set to $env{'form.loginheader'}").' ';
+ if ($item eq 'loginvia') {
+ if (ref($changes{$item}) eq 'HASH') {
+ $resulttext .= ''.&mt('Log-in page availability:').'';
+ foreach my $lonhost (sort(keys(%{$changes{$item}}))) {
+ if (defined($servers{$loginhash{login}{loginvia}{$lonhost}{'server'}})) {
+ if (ref($loginhash{login}{loginvia}{$lonhost}) eq 'HASH') {
+ my $protocol = $Apache::lonnet::protocol{$env{'form.'.$lonhost.'_server'}};
+ $protocol = 'http' if ($protocol ne 'https');
+ my $target = $protocol.'://'.$servers{$env{'form.'.$lonhost.'_server'}};
+
+ if ($loginhash{login}{loginvia}{$lonhost}{'serverpath'} eq 'custom') {
+ $target .= $loginhash{login}{loginvia}{$lonhost}{'custompath'};
+ } else {
+ $target .= $loginhash{login}{loginvia}{$lonhost}{'serverpath'};
+ }
+ $resulttext .= ''.&mt('Server: [_1] log-in page redirects to [_2].',$servers{$lonhost},''.$target.' ');
+ if ($loginhash{login}{loginvia}{$lonhost}{'exempt'} ne '') {
+ $resulttext .= ' '.&mt('No redirection for clients from following IPs:').' '.$loginhash{login}{loginvia}{$lonhost}{'exempt'};
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext .= ''.&mt('Server: [_1] has standard log-in page.',$lonhost).' ';
+ }
+ } else {
+ $resulttext .= ''.&mt('Server: [_1] has standard log-in page.',$servers{$lonhost}).' ';
+ }
+ }
+ $resulttext .= ' ';
+ }
} else {
$resulttext .= ''.&mt("$title{$item} set to $offon[$env{'form.'.$item}]").' ';
}
@@ -2938,6 +4657,7 @@ sub color_font_choices {
links => "Link colors",
images => "Images",
font => "Font color",
+ fontmenu => "Font Menu",
pgbg => "Page",
tabbg => "Header",
sidebg => "Border",
@@ -2995,6 +4715,7 @@ sub modify_colors {
@logintext = ('textcol','bgcol');
} else {
%choices = &color_font_choices();
+ $confhash->{$role}{'fontmenu'} = $env{'form.'.$role.'_fontmenu'};
}
if ($role eq 'login') {
@images = ('img','logo','domlogo','login');
@@ -3117,6 +4838,17 @@ sub modify_colors {
$changes{$role}{'font'} = 1;
}
}
+ if ($role ne 'login') {
+ if ($domconfig->{$role}{'fontmenu'} ne '') {
+ if ($confhash->{$role}{'fontmenu'} ne $domconfig->{$role}{'fontmenu'}) {
+ $changes{$role}{'fontmenu'} = 1;
+ }
+ } else {
+ if ($confhash->{$role}{'fontmenu'}) {
+ $changes{$role}{'fontmenu'} = 1;
+ }
+ }
+ }
foreach my $item (@bgs) {
if ($domconfig->{$role}{$item} ne '') {
if ($confhash->{$role}{$item} ne $domconfig->{$role}{$item}) {
@@ -3342,15 +5074,17 @@ sub publishlogo {
# See if there is anything left
unless ($fname) { return ('error: no uploaded file'); }
$fname="$subdir/$fname";
- my $filepath='/home/'.$confname.'/public_html';
+ my $docroot=$r->dir_config('lonDocRoot');
+ my $filepath="$docroot/priv";
+ my $relpath = "$dom/$confname";
my ($fnamepath,$file,$fetchthumb);
$file=$fname;
if ($fname=~m|/|) {
($fnamepath,$file) = ($fname =~ m|^(.*)/([^/]+)$|);
}
- my @parts=split(/\//,$filepath.'/'.$fnamepath);
+ my @parts=split(/\//,"$filepath/$relpath/$fnamepath");
my $count;
- for ($count=4;$count<=$#parts;$count++) {
+ for ($count=5;$count<=$#parts;$count++) {
$filepath.="/$parts[$count]";
if ((-e $filepath)!=1) {
mkdir($filepath,02770);
@@ -3397,7 +5131,6 @@ $env{'user.name'}.':'.$env{'user.domain'
close(FH);
chmod(0660, $source); # Permissions to rw-rw---.
- my $docroot=$r->dir_config('lonDocRoot');
my $targetdir=$docroot.'/res/'.$dom.'/'.$confname .'/'.$fnamepath;
my $copyfile=$targetdir.'/'.$file;
@@ -3420,8 +5153,15 @@ $env{'user.name'}.':'.$env{'user.domain'
if (copy($source,$copyfile)) {
print $logfile "\nCopied original source to ".$copyfile."\n";
$output = 'ok';
- &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile);
$logourl = '/res/'.$dom.'/'.$confname.'/'.$fname;
+ push(@{$modified_urls},[$copyfile,$source]);
+ my $metaoutput =
+ &write_metadata($dom,$confname,$formname,$targetdir,$file,$logfile);
+ unless ($registered_cleanup) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]);
+ $registered_cleanup=1;
+ }
} else {
print $logfile "\nUnable to write ".$copyfile.':'.$!."\n";
$output = &mt('Failed to copy file to RES space').", $!";
@@ -3439,8 +5179,15 @@ $env{'user.name'}.':'.$env{'user.domain'
my $copyfile=$targetdir.'/tn-'.$file;
if (copy($outfile,$copyfile)) {
print $logfile "\nCopied source to ".$copyfile."\n";
- &write_metadata($dom,$confname,$formname,
- $targetdir,'tn-'.$file,$logfile);
+ my $thumb_metaoutput =
+ &write_metadata($dom,$confname,$formname,
+ $targetdir,'tn-'.$file,$logfile);
+ push(@{$modified_urls},[$copyfile,$outfile]);
+ unless ($registered_cleanup) {
+ my $handlers = $r->get_handlers('PerlCleanupHandler');
+ $r->set_handlers('PerlCleanupHandler' => [\¬ifysubscribed,@{$handlers}]);
+ $registered_cleanup=1;
+ }
} else {
print $logfile "\nUnable to write ".$copyfile.
':'.$!."\n";
@@ -3505,30 +5252,79 @@ sub write_metadata {
{
print $logfile "\nWrite metadata file for ".$targetdir.'/'.$file;
my $mfh;
- unless (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) {
+ if (open($mfh,'>'.$targetdir.'/'.$file.'.meta')) {
+ foreach (sort keys %metadatafields) {
+ unless ($_=~/\./) {
+ my $unikey=$_;
+ $unikey=~/^([A-Za-z]+)/;
+ my $tag=$1;
+ $tag=~tr/A-Z/a-z/;
+ print $mfh "\n\<$tag";
+ foreach (split(/\,/,$metadatakeys{$unikey})) {
+ my $value=$metadatafields{$unikey.'.'.$_};
+ $value=~s/\"/\'\'/g;
+ print $mfh ' '.$_.'="'.$value.'"';
+ }
+ print $mfh '>'.
+ &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
+ .''.$tag.'>';
+ }
+ }
+ $output = 'ok';
+ print $logfile "\nWrote metadata";
+ close($mfh);
+ } else {
+ print $logfile "\nFailed to open metadata file";
$output = &mt('Could not write metadata');
}
- foreach (sort keys %metadatafields) {
- unless ($_=~/\./) {
- my $unikey=$_;
- $unikey=~/^([A-Za-z]+)/;
- my $tag=$1;
- $tag=~tr/A-Z/a-z/;
- print $mfh "\n\<$tag";
- foreach (split(/\,/,$metadatakeys{$unikey})) {
- my $value=$metadatafields{$unikey.'.'.$_};
- $value=~s/\"/\'\'/g;
- print $mfh ' '.$_.'="'.$value.'"';
- }
- print $mfh '>'.
- &HTML::Entities::encode($metadatafields{$unikey},'<>&"')
- .''.$tag.'>';
- }
- }
- $output = 'ok';
- print $logfile "\nWrote metadata";
- close($mfh);
}
+ return $output;
+}
+
+sub notifysubscribed {
+ foreach my $targetsource (@{$modified_urls}){
+ next unless (ref($targetsource) eq 'ARRAY');
+ my ($target,$source)=@{$targetsource};
+ if ($source ne '') {
+ if (open(my $logfh,'>>'.$source.'.log')) {
+ print $logfh "\nCleanup phase: Notifications\n";
+ my @subscribed=&subscribed_hosts($target);
+ foreach my $subhost (@subscribed) {
+ print $logfh "\nNotifying host ".$subhost.':';
+ my $reply=&Apache::lonnet::critical('update:'.$target,$subhost);
+ print $logfh $reply;
+ }
+ my @subscribedmeta=&subscribed_hosts("$target.meta");
+ foreach my $subhost (@subscribedmeta) {
+ print $logfh "\nNotifying host for metadata only ".$subhost.':';
+ my $reply=&Apache::lonnet::critical('update:'.$target.'.meta',
+ $subhost);
+ print $logfh $reply;
+ }
+ print $logfh "\n============ Done ============\n";
+ close($logfh);
+ }
+ }
+ }
+ return OK;
+}
+
+sub subscribed_hosts {
+ my ($target) = @_;
+ my @subscribed;
+ if (open(my $fh,"<$target.subscription")) {
+ while (my $subline=<$fh>) {
+ if ($subline =~ /^($match_lonid):/) {
+ my $host = $1;
+ if ($host ne $Apache::lonnet::perlvar{'lonHostID'}) {
+ unless (grep(/^\Q$host\E$/,@subscribed)) {
+ push(@subscribed,$host);
+ }
+ }
+ }
+ }
+ }
+ return @subscribed;
}
sub check_switchserver {
@@ -3546,64 +5342,115 @@ sub check_switchserver {
return $switchserver;
}
-sub javascript_set_colnums {
- return < 1100) {
- document.pickactions.numcols[1].checked = true;
- } else {
- document.pickactions.numcols[0].checked = true;
- }
-}
-END
-}
-
sub modify_quotas {
my ($dom,$action,%domconfig) = @_;
- my ($context,@usertools);
+ my ($context,@usertools,@options,%validations,%titles,%confhash,%toolshash,
+ %limithash,$toolregexp,%conditions,$resulttext,%changes);
if ($action eq 'quotas') {
$context = 'tools';
- } else {
+ } else {
$context = $action;
}
if ($context eq 'requestcourses') {
- @usertools = ('official','unofficial');
+ @usertools = ('official','unofficial','community');
+ @options =('norequest','approval','validate','autolimit');
+ %validations = &Apache::lonnet::auto_courserequest_checks($dom);
+ %titles = &courserequest_titles();
+ $toolregexp = join('|',@usertools);
+ %conditions = &courserequest_conditions();
+ } elsif ($context eq 'requestauthor') {
+ @usertools = ('author');
+ %titles = &authorrequest_titles();
} else {
- @usertools = ('aboutme','blog','portfolio');
+ @usertools = ('aboutme','blog','webdav','portfolio');
+ %titles = &tool_titles();
}
my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
- my ($resulttext,%changes);
my ($othertitle,$usertypes,$types) = &Apache::loncommon::sorted_inst_types($dom);
- my %titles = &tool_titles();
- my (%confhash,%toolshash);
foreach my $key (keys(%env)) {
- unless ($context eq 'requestcourses') {
+ if ($context eq 'requestcourses') {
+ if ($key =~ /^form\.crsreq_($toolregexp)_(.+)$/) {
+ my $item = $1;
+ my $type = $2;
+ if ($type =~ /^limit_(.+)/) {
+ $limithash{$item}{$1} = $env{$key};
+ } else {
+ $confhash{$item}{$type} = $env{$key};
+ }
+ }
+ } elsif ($context eq 'requestauthor') {
+ if ($key =~ /^\Qform.authorreq_\E(.+)$/) {
+ $confhash{$1} = $env{$key};
+ }
+ } else {
if ($key =~ /^form\.quota_(.+)$/) {
$confhash{'defaultquota'}{$1} = $env{$key};
}
- }
- if ($key =~ /^form\.\Q$context\E_(.+)$/) {
- @{$toolshash{$1}} = &Apache::loncommon::get_env_multiple($key);
+ if ($key =~ /^form\.\Q$context\E_(.+)$/) {
+ @{$toolshash{$1}} = &Apache::loncommon::get_env_multiple($key);
+ }
}
}
- unless ($context eq 'requestcourses') {
+ if (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
+ my @approvalnotify = &Apache::loncommon::get_env_multiple('form.reqapprovalnotify');
+ @approvalnotify = sort(@approvalnotify);
+ $confhash{'notify'}{'approval'} = join(',',@approvalnotify);
+ if (ref($domconfig{$action}) eq 'HASH') {
+ if (ref($domconfig{$action}{'notify'}) eq 'HASH') {
+ if ($domconfig{$action}{'notify'}{'approval'} ne $confhash{'notify'}{'approval'}) {
+ $changes{'notify'}{'approval'} = 1;
+ }
+ } else {
+ if ($confhash{'notify'}{'approval'}) {
+ $changes{'notify'}{'approval'} = 1;
+ }
+ }
+ } else {
+ if ($confhash{'notify'}{'approval'}) {
+ $changes{'notify'}{'approval'} = 1;
+ }
+ }
+ } else {
$confhash{'defaultquota'}{'default'} = $env{'form.defaultquota'};
}
foreach my $item (@usertools) {
foreach my $type (@{$types},'default','_LC_adv') {
- if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) {
- $confhash{$item}{$type} = 1;
+ my $unset;
+ if ($context eq 'requestcourses') {
+ $unset = '0';
+ if ($type eq '_LC_adv') {
+ $unset = '';
+ }
+ if ($confhash{$item}{$type} eq 'autolimit') {
+ $confhash{$item}{$type} .= '=';
+ unless ($limithash{$item}{$type} =~ /\D/) {
+ $confhash{$item}{$type} .= $limithash{$item}{$type};
+ }
+ }
+ } elsif ($context eq 'requestauthor') {
+ $unset = '0';
+ if ($type eq '_LC_adv') {
+ $unset = '';
+ }
} else {
- $confhash{$item}{$type} = 0;
+ if (grep(/^\Q$type\E$/,@{$toolshash{$item}})) {
+ $confhash{$item}{$type} = 1;
+ } else {
+ $confhash{$item}{$type} = 0;
+ }
}
if (ref($domconfig{$action}) eq 'HASH') {
- if (ref($domconfig{$action}{$item}) eq 'HASH') {
+ if ($action eq 'requestauthor') {
+ if ($domconfig{$action}{$type} ne $confhash{$type}) {
+ $changes{$type} = 1;
+ }
+ } elsif (ref($domconfig{$action}{$item}) eq 'HASH') {
if ($domconfig{$action}{$item}{$type} ne $confhash{$item}{$type}) {
$changes{$item}{$type} = 1;
}
} else {
if ($context eq 'requestcourses') {
- if ($confhash{$item}{$type}) {
+ if ($confhash{$item}{$type} ne $unset) {
$changes{$item}{$type} = 1;
}
} else {
@@ -3614,9 +5461,13 @@ sub modify_quotas {
}
} else {
if ($context eq 'requestcourses') {
- if ($confhash{$item}{$type}) {
+ if ($confhash{$item}{$type} ne $unset) {
$changes{$item}{$type} = 1;
}
+ } elsif ($context eq 'requestauthor') {
+ if ($confhash{$type} ne $unset) {
+ $changes{$type} = 1;
+ }
} else {
if (!$confhash{$item}{$type}) {
$changes{$item}{$type} = 1;
@@ -3625,7 +5476,7 @@ sub modify_quotas {
}
}
}
- unless ($context eq 'requestcourses') {
+ unless (($context eq 'requestcourses') || ($context eq 'requestauthor')) {
if (ref($domconfig{'quotas'}) eq 'HASH') {
if (ref($domconfig{'quotas'}{'defaultquota'}) eq 'HASH') {
foreach my $key (keys(%{$domconfig{'quotas'}{'defaultquota'}})) {
@@ -3668,10 +5519,14 @@ sub modify_quotas {
}
}
- foreach my $key (keys(%confhash)) {
- $domdefaults{$key} = $confhash{$key};
+ if ($context eq 'requestauthor') {
+ $domdefaults{'requestauthor'} = \%confhash;
+ } else {
+ foreach my $key (keys(%confhash)) {
+ $domdefaults{$key} = $confhash{$key};
+ }
}
-
+
my %quotahash = (
$action => { %confhash }
);
@@ -3683,7 +5538,8 @@ sub modify_quotas {
&Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
$resulttext = &mt('Changes made:').'';
- unless ($context eq 'requestcourses') {
+ unless (($context eq 'requestcourses') ||
+ ($context eq 'requestauthor')) {
if (ref($changes{'defaultquota'}) eq 'HASH') {
$resulttext .= ''.&mt('Portfolio default quotas').'';
foreach my $type (@{$types},'default') {
@@ -3700,12 +5556,25 @@ sub modify_quotas {
}
my %newenv;
foreach my $item (@usertools) {
- if (ref($changes{$item}) eq 'HASH') {
+ my (%haschgs,%inconf);
+ if ($context eq 'requestauthor') {
+ %haschgs = %changes;
+ %inconf = %confhash;
+ } else {
+ if (ref($changes{$item}) eq 'HASH') {
+ %haschgs = %{$changes{$item}};
+ }
+ if (ref($confhash{$item}) eq 'HASH') {
+ %inconf = %{$confhash{$item}};
+ }
+ }
+ if (keys(%haschgs) > 0) {
my $newacc =
&Apache::lonnet::usertools_access($env{'user.name'},
$env{'user.domain'},
$item,'reload',$context);
- if ($context eq 'requestcourses') {
+ if (($context eq 'requestcourses') ||
+ ($context eq 'requestauthor')) {
if ($env{'environment.canrequest.'.$item} ne $newacc) {
$newenv{'environment.canrequest.'.$item} = $newacc;
}
@@ -3714,23 +5583,62 @@ sub modify_quotas {
$newenv{'environment.availabletools.'.$item} = $newacc;
}
}
- $resulttext .= ''.$titles{$item}.'';
+ unless ($context eq 'requestauthor') {
+ $resulttext .= ''.$titles{$item}.'';
+ }
foreach my $type (@{$types},'default','_LC_adv') {
- if ($changes{$item}{$type}) {
+ if ($haschgs{$type}) {
my $typetitle = $usertypes->{$type};
if ($type eq 'default') {
$typetitle = $othertitle;
} elsif ($type eq '_LC_adv') {
$typetitle = 'LON-CAPA Advanced Users';
}
- if ($confhash{$item}{$type}) {
- $resulttext .= ''.&mt('Set to be available to [_1]',$typetitle).' ';
+ if ($inconf{$type}) {
+ if ($context eq 'requestcourses') {
+ my $cond;
+ if ($inconf{$type} =~ /^autolimit=(\d*)$/) {
+ if ($1 eq '') {
+ $cond = &mt('(Automatic processing of any request).');
+ } else {
+ $cond = &mt('(Automatic processing of requests up to limit of [quant,_1,request] per user).',$1);
+ }
+ } else {
+ $cond = $conditions{$inconf{$type}};
+ }
+ $resulttext .= ''.&mt('Set to be available to [_1].',$typetitle).' '.$cond.' ';
+ } else {
+ $resulttext .= ''.&mt('Set to be available to [_1]',$typetitle).' ';
+ }
} else {
- $resulttext .= ''.&mt('Set to be unavailable to [_1]',$typetitle).' ';
+ if ($type eq '_LC_adv') {
+ if ($inconf{$type} eq '0') {
+ $resulttext .= ''.&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).' ';
+ }
+ }
+ }
+ }
+ unless ($context eq 'requestauthor') {
+ $resulttext .= ' ';
+ }
+ }
+ }
+ if (($action eq 'requestcourses') || ($action eq 'requestauthor')) {
+ 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 requests requiring approval.').' ';
}
}
}
- $resulttext .= ' ';
}
}
$resulttext .= ' ';
@@ -3740,6 +5648,8 @@ sub modify_quotas {
} else {
if ($context eq 'requestcourses') {
$resulttext = &mt('No changes made to rights to request creation of courses.');
+ } elsif ($context eq 'requestauthor') {
+ $resulttext = &mt('No changes made to rights to request author space.');
} else {
$resulttext = &mt('No changes made to availability of personal information pages, blogs, portfolios or default quotas');
}
@@ -3762,7 +5672,8 @@ sub modify_autoenroll {
}
my $autorun = &Apache::lonnet::auto_run(undef,$dom),
my %title = ( run => 'Auto-enrollment active',
- sender => 'Sender for notification messages');
+ sender => 'Sender for notification messages',
+ coowners => 'Automatic assignment of co-ownership to instructors of record (institutional data)');
my @offon = ('off','on');
my $sender_uname = $env{'form.sender_uname'};
my $sender_domain = $env{'form.sender_domain'};
@@ -3771,11 +5682,12 @@ sub modify_autoenroll {
} elsif ($sender_uname eq '') {
$sender_domain = '';
}
+ my $coowners = $env{'form.autoassign_coowners'};
my %autoenrollhash = (
- autoenroll => { run => $env{'form.autoenroll_run'},
- sender_uname => $sender_uname,
- sender_domain => $sender_domain,
-
+ autoenroll => { 'run' => $env{'form.autoenroll_run'},
+ 'sender_uname' => $sender_uname,
+ 'sender_domain' => $sender_domain,
+ 'co-owners' => $coowners,
}
);
my $putresult = &Apache::lonnet::put_dom('configuration',\%autoenrollhash,
@@ -3796,6 +5708,13 @@ sub modify_autoenroll {
if ($currautoenroll{'sender_domain'} ne $sender_domain) {
$changes{'sender'} = 1;
}
+ if ($currautoenroll{'co-owners'} ne '') {
+ if ($currautoenroll{'co-owners'} ne $coowners) {
+ $changes{'coowners'} = 1;
+ }
+ } elsif ($coowners) {
+ $changes{'coowners'} = 1;
+ }
if (keys(%changes) > 0) {
$resulttext = &mt('Changes made:').'';
if ($changes{'run'}) {
@@ -3808,6 +5727,10 @@ sub modify_autoenroll {
$resulttext .= ''.&mt("$title{'sender'} set to [_1]",$sender_uname.':'.$sender_domain).' ';
}
}
+ if ($changes{'coowners'}) {
+ $resulttext .= ''.&mt("$title{'coowners'} set to $offon[$env{'form.autoassign_coowners'}]").' ';
+ &Apache::loncommon::devalidate_domconfig_cache($dom);
+ }
$resulttext .= ' ';
} else {
$resulttext = &mt('No changes made to auto-enrollment settings');
@@ -3839,21 +5762,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)) {
@@ -3871,9 +5816,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;
}
}
}
@@ -3883,12 +5830,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 {
@@ -3902,7 +5878,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}}) {
@@ -3941,6 +5927,78 @@ 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 [_2]",'',' ').' ';
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to auto-creation settings');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ return $resulttext;
+}
+
sub modify_directorysrch {
my ($dom,%domconfig) = @_;
my ($resulttext,%changes);
@@ -4123,9 +6181,10 @@ sub modify_contacts {
$currsetting{$key} = $domconfig{'contacts'}{$key};
}
}
- my (%others,%to);
+ my (%others,%to,%bcc);
my @contacts = ('supportemail','adminemail');
- my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail');
+ my @mailings = ('errormail','packagesmail','helpdeskmail','lonstatusmail',
+ 'requestsmail');
foreach my $type (@mailings) {
@{$newsetting{$type}} =
&Apache::loncommon::get_env_multiple('form.'.$type);
@@ -4138,6 +6197,10 @@ sub modify_contacts {
}
$others{$type} = $env{'form.'.$type.'_others'};
$contacts_hash{contacts}{$type}{'others'} = $others{$type};
+ if ($type eq 'helpdeskmail') {
+ $bcc{$type} = $env{'form.'.$type.'_bcc'};
+ $contacts_hash{contacts}{$type}{'bcc'} = $bcc{$type};
+ }
}
foreach my $item (@contacts) {
$to{$item} = $env{'form.'.$item};
@@ -4162,6 +6225,11 @@ sub modify_contacts {
if ($others{$type} ne $currsetting{$type}{'others'}) {
push(@{$changes{$type}},'others');
}
+ if ($type eq 'helpdeskmail') {
+ if ($bcc{$type} ne $currsetting{$type}{'bcc'}) {
+ push(@{$changes{$type}},'bcc');
+ }
+ }
}
} else {
my %default;
@@ -4171,6 +6239,7 @@ sub modify_contacts {
$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;
@@ -4183,7 +6252,12 @@ sub modify_contacts {
}
if ($others{$type} ne '') {
push(@{$changes{$type}},'others');
- }
+ }
+ if ($type eq 'helpdeskmail') {
+ if ($bcc{$type} ne '') {
+ push(@{$changes{$type}},'bcc');
+ }
+ }
}
}
my $putresult = &Apache::lonnet::put_dom('configuration',\%contacts_hash,
@@ -4211,7 +6285,13 @@ sub modify_contacts {
push(@text,$others{$type});
}
$resulttext .= ''.
- join(', ',@text).' ';
+ join(', ',@text).'';
+ if ($type eq 'helpdeskmail') {
+ if ($bcc{$type} ne '') {
+ $resulttext .= ' '.&mt('with Bcc to').': '.$bcc{$type}.' ';
+ }
+ }
+ $resulttext .= '';
}
}
$resulttext .= ' ';
@@ -4237,7 +6317,7 @@ 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','selfcreate');
+ my @contexts = ('author','course','requestcrs','selfcreate');
foreach my $item(@contexts) {
if ($item eq 'selfcreate') {
@{$cancreate{$item}} = &Apache::loncommon::get_env_multiple('form.can_createuser_'.$item);
@@ -4253,14 +6333,28 @@ sub modify_usercreation {
$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');
+ }
+ &process_captcha('cancreate',\%changes,\%cancreate,\%curr_usercreation);
if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
foreach my $item (@contexts) {
- if ($item eq 'selfcreate') {
- if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
+ if (($item eq 'selfcreate') || ($item eq 'statustocreate')) {
+ if (ref($curr_usercreation{'cancreate'}{$item}) eq 'ARRAY') {
foreach my $curr (@{$curr_usercreation{'cancreate'}{$item}}) {
- if (!grep(/^$curr$/,@{$cancreate{$item}})) {
- if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
- push(@{$changes{'cancreate'}},$item);
+ if (ref($cancreate{$item}) eq 'ARRAY') {
+ if (!grep(/^$curr$/,@{$cancreate{$item}})) {
+ if (!grep(/^$item$/,@{$changes{'cancreate'}})) {
+ push(@{$changes{'cancreate'}},$item);
+ }
}
}
}
@@ -4432,17 +6526,95 @@ sub modify_usercreation {
if (ref($changes{'cancreate'}) eq 'ARRAY') {
my %lt = &usercreation_types();
foreach my $type (@{$changes{'cancreate'}}) {
- my $chgtext = $lt{$type}.', ';
+ my $chgtext;
+ unless (($type eq 'statustocreate') || ($type eq 'captcha') || ($type eq 'recaptchakeys')) {
+ $chgtext = $lt{$type}.', ';
+ }
if ($type eq 'selfcreate') {
if (@{$cancreate{$type}} == 0) {
$chgtext .= &mt('creation of a new user account is not permitted.');
} else {
- $chgtext .= &mt('creation of a new account is permitted for:');
+ $chgtext .= &mt('creation of a new account is permitted for:').'';
foreach my $case (@{$cancreate{$type}}) {
$chgtext .= ''.$selfcreatetypes{$case}.' ';
}
$chgtext .= ' ';
+ 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 ($cancreate{$type} eq 'notused') {
+ $chgtext .= &mt('No CAPTCHA validation in use for self-creation screen.');
+ } else {
+ my %captchas = &captcha_phrases();
+ if ($captchas{$cancreate{$type}}) {
+ $chgtext .= &mt("Validation for self-creation screen set to $captchas{$cancreate{$type}}.");
+ } else {
+ $chgtext .= &mt('Validation for self-creation screen set to unknown type.');
+ }
+ }
+ } elsif ($type eq 'recaptchakeys') {
+ my ($privkey,$pubkey);
+ if (ref($cancreate{$type}) eq 'HASH') {
+ $pubkey = $cancreate{$type}{'public'};
+ $privkey = $cancreate{$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 .= ' ';
} else {
if ($cancreate{$type} eq 'none') {
$chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
@@ -4542,6 +6714,43 @@ sub modify_usercreation {
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 (ref($changes->{'cancreate'}) eq 'ARRAY') {
+ push(@{$changes->{'cancreate'}},'captcha');
+ } elsif (!defined($changes->{'cancreate'})) {
+ $changes->{'cancreate'} = ['captcha'];
+ }
+ }
+ my ($newpub,$newpriv,$currpub,$currpriv);
+ if ($newsettings->{'captcha'} eq 'recaptcha') {
+ $newpub = $env{'form.'.$container.'_recaptchapub'};
+ $newpriv = $env{'form.'.$container.'_recaptchapriv'};
+ }
+ $newsettings->{'recaptchakeys'} = {
+ public => $newpub,
+ private => $newpriv,
+ };
+ if (ref($current->{'recaptchakeys'}) eq 'HASH') {
+ $currpub = $current->{'recaptchakeys'}{'public'};
+ $currpriv = $current->{'recaptchakeys'}{'private'};
+ }
+ if (($newpub ne $currpub) || ($newpriv ne $currpriv)) {
+ if (ref($changes->{'cancreate'}) eq 'ARRAY') {
+ push(@{$changes->{'cancreate'}},'recaptchakeys');
+ } elsif (!defined($changes->{'cancreate'})) {
+ $changes->{'cancreate'} = ['recaptchakeys'];
+ }
+ }
+ return;
+}
+
sub modify_usermodification {
my ($dom,%domconfig) = @_;
my ($resulttext,%curr_usermodification,%changes);
@@ -4631,7 +6840,7 @@ sub modify_usermodification {
}
my @modifiable;
if ($context eq 'selfcreate') {
- $resulttext .= ''.&mt('Self-creation of account by users with status: [_1] ',$rolename).' - '.&mt('modifiable fields (if institutional data blank): ');
+ $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: ');
}
@@ -4666,7 +6875,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','timezone_def','datelocale_def');
+ 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};
@@ -4680,8 +6889,10 @@ 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);
@@ -4700,6 +6911,12 @@ sub modify_defaults {
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};
@@ -4773,7 +6990,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) =
@@ -4813,25 +7030,25 @@ sub modify_scantron {
if (ref($confhash{'scantron'}) eq 'HASH') {
$resulttext = &mt('Changes made:').'';
if ($confhash{'scantron'}{'scantronformat'} eq '') {
- $resulttext .= ''.&mt('[_1] scantron format file removed; [_2] file will be used for courses in this domain.',$custom,$default).' ';
+ $resulttext .= ''.&mt('[_1] bubblesheet 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).' ';
+ $resulttext .= ''.&mt('Custom bubblesheet format file ([_1]) uploaded for use with courses in this domain.',$custom).' ';
}
$resulttext .= ' ';
} else {
- $resulttext = &mt('Changes made to scantron format file.');
+ $resulttext = &mt('Changes made to bubblesheet format file.');
}
$resulttext .= ' ';
&Apache::loncommon::devalidate_domconfig_cache($dom);
} else {
- $resulttext = &mt('No changes made to scantron format file');
+ $resulttext = &mt('No changes made to bubblesheet format file');
}
} else {
$resulttext = ''.
&mt('An error occurred: [_1]',$putresult).' ';
}
} else {
- $resulttext = &mt('No changes made to scantron format file');
+ $resulttext = &mt('No changes made to bubblesheet format file');
}
if ($errors) {
$resulttext .= &mt('The following errors occurred: ').''.
@@ -4855,18 +7072,33 @@ sub modify_coursecategories {
$changes{'categorize'} = 1;
$domconfig{'coursecategories'}{'categorize'} = $env{'form.categorize'};
}
+ if ($domconfig{'coursecategories'}{'togglecatscomm'} ne $env{'form.togglecatscomm'}) {
+ $changes{'togglecatscomm'} = 1;
+ $domconfig{'coursecategories'}{'togglecatscomm'} = $env{'form.togglecatscomm'};
+ }
+ if ($domconfig{'coursecategories'}{'categorizecomm'} ne $env{'form.categorizecomm'}) {
+ $changes{'categorizecomm'} = 1;
+ $domconfig{'coursecategories'}{'categorizecomm'} = $env{'form.categorizecomm'};
+ }
} else {
$changes{'togglecats'} = 1;
$changes{'categorize'} = 1;
+ $changes{'togglecatscomm'} = 1;
+ $changes{'categorizecomm'} = 1;
$domconfig{'coursecategories'} = {
togglecats => $env{'form.togglecats'},
categorize => $env{'form.categorize'},
+ togglecatscomm => $env{'form.togglecatscomm'},
+ categorizecomm => $env{'form.categorizecomm'},
};
}
if (ref($cathash) eq 'HASH') {
if (($domconfig{'coursecategories'}{'cats'}{'instcode::0'} ne '') && ($env{'form.instcode'} == 0)) {
push (@deletecategory,'instcode::0');
}
+ if (($domconfig{'coursecategories'}{'cats'}{'communities::0'} ne '') && ($env{'form.communities'} == 0)) {
+ push(@deletecategory,'communities::0');
+ }
}
my (@predelcats,@predeltrails,%predelallitems,%sort_by_deltrail);
if (ref($cathash) eq 'HASH') {
@@ -4916,10 +7148,26 @@ sub modify_coursecategories {
$adds{$newitem} = 1;
}
}
+ if ($env{'form.communities'} eq '1') {
+ if (ref($cathash) eq 'HASH') {
+ my $newitem = 'communities::0';
+ if ($cathash->{$newitem} eq '') {
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.communities_pos'};
+ $adds{$newitem} = 1;
+ }
+ } else {
+ my $newitem = 'communities::0';
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.communities_pos'};
+ $adds{$newitem} = 1;
+ }
+ }
if ($env{'form.addcategory_name'} ne '') {
- my $newitem = &escape($env{'form.addcategory_name'}).'::0';
- $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos'};
- $adds{$newitem} = 1;
+ if (($env{'form.addcategory_name'} ne 'instcode') &&
+ ($env{'form.addcategory_name'} ne 'communities')) {
+ my $newitem = &escape($env{'form.addcategory_name'}).'::0';
+ $domconfig{'coursecategories'}{'cats'}{$newitem} = $env{'form.addcategory_pos'};
+ $adds{$newitem} = 1;
+ }
}
my $putresult;
if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
@@ -4956,12 +7204,15 @@ sub modify_coursecategories {
$putresult = &Apache::lonnet::put_dom('configuration',\%domconfig,$dom);
if ($putresult eq 'ok') {
my %title = (
- togglecats => 'Show/Hide a course in the catalog',
- categorize => 'Category assigned to course',
+ togglecats => 'Show/Hide a course in catalog',
+ categorize => 'Assign a category to a course',
+ togglecatscomm => 'Show/Hide a community in catalog',
+ categorizecomm => 'Assign a category to a community',
);
my %level = (
- dom => 'set from "Modify Course" (Domain)',
- crs => 'set from "Parameters" (Course)',
+ dom => 'set in Domain ("Modify Course/Community")',
+ crs => 'set in Course ("Course Configuration")',
+ comm => 'set in Community ("Community Configuration")',
);
$resulttext = &mt('Changes made:').'';
if ($changes{'togglecats'}) {
@@ -4970,6 +7221,12 @@ sub modify_coursecategories {
if ($changes{'categorize'}) {
$resulttext .= ''.&mt("$title{'categorize'} $level{$env{'form.categorize'}}").' ';
}
+ if ($changes{'togglecatscomm'}) {
+ $resulttext .= ''.&mt("$title{'togglecatscomm'} $level{$env{'form.togglecatscomm'}}").' ';
+ }
+ if ($changes{'categorizecomm'}) {
+ $resulttext .= ''.&mt("$title{'categorizecomm'} $level{$env{'form.categorizecomm'}}").' ';
+ }
if ((keys(%deletions) > 0) || (keys(%reorderings) > 0) || (keys(%adds) > 0)) {
my $cathash;
if (ref($domconfig{'coursecategories'}) eq 'HASH') {
@@ -5019,7 +7276,7 @@ sub modify_coursecategories {
&mt('An error occurred: [_1]',$putresult).'';
}
} else {
- $resulttext = &mt('No changes made to course categories');
+ $resulttext = &mt('No changes made to course and community categories');
}
return $resulttext;
}
@@ -5076,7 +7333,6 @@ sub modify_serverstatuses {
my %serverstatushash = (
serverstatuses => \%newserverstatus,
);
- my %changes;
foreach my $type (@pages) {
foreach my $setting ('namedusers','machines') {
my (@current,@new);
@@ -5149,6 +7405,671 @@ sub modify_serverstatuses {
return $resulttext;
}
+sub modify_helpsettings {
+ my ($r,$dom,$confname,%domconfig) = @_;
+ my ($resulttext,$errors,%changes,%helphash);
+ my $customhelpfile = $env{'form.loginhelpurl.filename'};
+ my $defaulthelpfile = '/adm/loginproblems.html';
+ my $defaulttext = &mt('Default in use');
+ my $servadm = $r->dir_config('lonAdmEMail');
+ my ($configuserok,$author_ok,$switchserver) = &config_check($dom,$confname,$servadm);
+ my %defaultchecked = ('submitbugs' => 'on');
+ my @offon = ('off','on');
+ my %title = (
+ submitbugs => 'Display link for users to submit a bug',
+ loginhelpurl => 'Unauthenticated login help page set to custom file'
+ );
+ my @toggles = ('submitbugs');
+ $helphash{'helpsettings'} = {};
+ if (ref($domconfig{'helpsettings'}) ne 'HASH') {
+ if ($domconfig{'helpsettings'} eq '') {
+ $domconfig{'helpsettings'} = {};
+ }
+ }
+ 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};
+ }
+ }
+ if ($customhelpfile ne '') {
+ my $error;
+ if ($configuserok eq 'ok') {
+ if ($switchserver) {
+ $error = &mt("Upload of custom help file is not permitted to this server: [_1]",$switchserver);
+ } else {
+ if ($author_ok eq 'ok') {
+ my ($result,$loginhelpurl) = &publishlogo($r,'upload','loginhelpurl',$dom,
+ $confname,'help','','',$customhelpfile);
+ if ($result eq 'ok') {
+ $helphash{'helpsettings'}{'loginhelpurl'} = $loginhelpurl;
+ $changes{'loginhelpurl'} = 1;
+ } else {
+ $error = &mt("Upload of [_1] failed because an error occurred publishing the file in RES space. Error was: [_2].",$customhelpfile,$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].",$customhelpfile,$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].",$customhelpfile,$confname,$dom,$configuserok);
+ }
+ if ($error) {
+ &Apache::lonnet::logthis($error);
+ $errors .= ''.$error.' ';
+ }
+ }
+ if ($domconfig{'helpsettings'}{'loginhelpurl'} ne '') {
+ if ($env{'form.loginhelpurl_del'}) {
+ $helphash{'helpsettings'}{'loginhelpurl'} = '';
+ $changes{'loginhelpurl'} = 1;
+ }
+ }
+ }
+ my $putresult;
+ if (keys(%changes) > 0) {
+ $putresult = &Apache::lonnet::put_dom('configuration',\%helphash,$dom);
+ } else {
+ $putresult = 'ok';
+ }
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ $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)).' ';
+ }
+ if ($item eq 'loginhelpurl') {
+ if ($helphash{'helpsettings'}{'loginhelpurl'} eq '') {
+ $resulttext .= ''.&mt('custom log-in help file removed.').' '.
+ &Apache::loncommon::modal_link($defaulthelpfile,
+ $defaulttext,600,500).' ';
+ } else {
+ $resulttext .= ''.&Apache::loncommon::modal_link(
+ $helphash{'helpsettings'}{'loginhelpurl'}.
+ '?inhibitmenu=yes',
+ &mt('custom log-in help file'),600,500).
+ ' ';
+ }
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to help settings');
+ }
+ } else {
+ $errors .= ''.&mt('An error occurred storing the settings: [_1]',
+ $putresult).' ';
+ }
+ if ($errors) {
+ $resulttext .= &mt('The following errors occurred: ').'';
+ }
+ return $resulttext;
+}
+
+sub modify_coursedefaults {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,$errors,%changes,%defaultshash);
+ my %defaultchecked = ('canuse_pdfforms' => 'off');
+ my @offon = ('off','on');
+ my @toggles = ('canuse_pdfforms');
+
+ $defaultshash{'coursedefaults'} = {};
+
+ if (ref($domconfig{'coursedefaults'}) ne 'HASH') {
+ if ($domconfig{'coursedefaults'} eq '') {
+ $domconfig{'coursedefaults'} = {};
+ }
+ }
+
+ if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
+ foreach my $item (@toggles) {
+ if ($defaultchecked{$item} eq 'on') {
+ if (($domconfig{'coursedefaults'}{$item} eq '') &&
+ ($env{'form.'.$item} eq '0')) {
+ $changes{$item} = 1;
+ } elsif ($domconfig{'coursdefaults'}{$item} ne $env{'form.'.$item}) {
+ $changes{$item} = 1;
+ }
+ } elsif ($defaultchecked{$item} eq 'off') {
+ if (($domconfig{'coursedefaults'}{$item} eq '') &&
+ ($env{'form.'.$item} eq '1')) {
+ $changes{$item} = 1;
+ } elsif ($domconfig{'coursedefaults'}{$item} ne $env{'form.'.$item}) {
+ $changes{$item} = 1;
+ }
+ }
+ $defaultshash{'coursedefaults'}{$item} = $env{'form.'.$item};
+ }
+ my $currdefresponder = $domconfig{'coursedefaults'}{'anonsurvey_threshold'};
+ my $newdefresponder = $env{'form.anonsurvey_threshold'};
+ $newdefresponder =~ s/\D//g;
+ if ($newdefresponder eq '' || $newdefresponder < 1) {
+ $newdefresponder = 1;
+ }
+ $defaultshash{'coursedefaults'}{'anonsurvey_threshold'} = $newdefresponder;
+ if ($currdefresponder ne $newdefresponder) {
+ unless ($currdefresponder eq '' && $newdefresponder == 10) {
+ $changes{'anonsurvey_threshold'} = 1;
+ }
+ }
+ }
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ if ($changes{'canuse_pdfforms'}) {
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
+ $domdefaults{'canuse_pdfforms'}=$defaultshash{'coursedefaults'}{'canuse_pdfforms'};
+ my $cachetime = 24*60*60;
+ &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
+ }
+ $resulttext = &mt('Changes made:').'';
+ foreach my $item (sort(keys(%changes))) {
+ if ($item eq 'canuse_pdfforms') {
+ if ($env{'form.'.$item} eq '1') {
+ $resulttext .= ''.&mt("Course/Community users can create/upload PDF forms set to 'on'").' ';
+ } else {
+ $resulttext .= ''.&mt('Course/Community users can create/upload PDF forms set to "off"').' ';
+ }
+ } elsif ($item eq 'anonsurvey_threshold') {
+ $resulttext .= ''.&mt('Responder count required for display of anonymous survey submissions set to [_1].',$defaultshash{'coursedefaults'}{'anonsurvey_threshold'}).' ';
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = &mt('No changes made to course defaults');
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ return $resulttext;
+}
+
+sub modify_usersessions {
+ my ($dom,%domconfig) = @_;
+ my @hostingtypes = ('version','excludedomain','includedomain');
+ my @offloadtypes = ('primary','default');
+ my %types = (
+ remote => \@hostingtypes,
+ hosted => \@hostingtypes,
+ spares => \@offloadtypes,
+ );
+ my @prefixes = ('remote','hosted','spares');
+ my @lcversions = &Apache::lonnet::all_loncaparevs();
+ my (%by_ip,%by_location,@intdoms);
+ &build_location_hashes(\@intdoms,\%by_ip,\%by_location);
+ my @locations = sort(keys(%by_location));
+ my (%defaultshash,%changes);
+ foreach my $prefix (@prefixes) {
+ $defaultshash{'usersessions'}{$prefix} = {};
+ }
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($dom);
+ my $resulttext;
+ my %iphost = &Apache::lonnet::get_iphost();
+ foreach my $prefix (@prefixes) {
+ next if ($prefix eq 'spares');
+ foreach my $type (@{$types{$prefix}}) {
+ my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'};
+ if ($type eq 'version') {
+ my $value = $env{'form.'.$prefix.'_'.$type};
+ my $okvalue;
+ if ($value ne '') {
+ if (grep(/^\Q$value\E$/,@lcversions)) {
+ $okvalue = $value;
+ }
+ }
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') {
+ if ($domconfig{'usersessions'}{$prefix}{$type} ne '') {
+ if ($inuse == 0) {
+ $changes{$prefix}{$type} = 1;
+ } else {
+ if ($okvalue ne $domconfig{'usersessions'}{$prefix}{$type}) {
+ $changes{$prefix}{$type} = 1;
+ }
+ if ($okvalue ne '') {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ }
+ }
+ } else {
+ if (($inuse == 1) && ($okvalue ne '')) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if (($inuse == 1) && ($okvalue ne '')) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if (($inuse == 1) && ($okvalue ne '')) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = $okvalue;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ my @vals = &Apache::loncommon::get_env_multiple('form.'.$prefix.'_'.$type);
+ my @okvals;
+ foreach my $val (@vals) {
+ if ($val =~ /:/) {
+ my @items = split(/:/,$val);
+ foreach my $item (@items) {
+ if (ref($by_location{$item}) eq 'ARRAY') {
+ push(@okvals,$item);
+ }
+ }
+ } else {
+ if (ref($by_location{$val}) eq 'ARRAY') {
+ push(@okvals,$val);
+ }
+ }
+ }
+ @okvals = sort(@okvals);
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{$prefix}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{$prefix}{$type}) eq 'ARRAY') {
+ if ($inuse == 0) {
+ $changes{$prefix}{$type} = 1;
+ } else {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ my @changed = &Apache::loncommon::compare_arrays($domconfig{'usersessions'}{$prefix}{$type},$defaultshash{'usersessions'}{$prefix}{$type});
+ if (@changed > 0) {
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if ($inuse == 1) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if ($inuse == 1) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ } else {
+ if ($inuse == 1) {
+ $defaultshash{'usersessions'}{$prefix}{$type} = \@okvals;
+ $changes{$prefix}{$type} = 1;
+ }
+ }
+ }
+ }
+ }
+
+ my @alldoms = &Apache::lonnet::all_domains();
+ my %servers = &Apache::lonnet::internet_dom_servers($dom);
+ my %spareid = ¤t_offloads_to($dom,$domconfig{'usersessions'},\%servers);
+ my $savespares;
+
+ foreach my $lonhost (sort(keys(%servers))) {
+ my $serverhomeID =
+ &Apache::lonnet::get_server_homeID($servers{$lonhost});
+ my $serverhostname = &Apache::lonnet::hostname($lonhost);
+ $defaultshash{'usersessions'}{'spares'}{$lonhost} = {};
+ my %spareschg;
+ foreach my $type (@{$types{'spares'}}) {
+ my @okspares;
+ my @checked = &Apache::loncommon::get_env_multiple('form.spare_'.$type.'_'.$lonhost);
+ foreach my $server (@checked) {
+ if (&Apache::lonnet::hostname($server) ne '') {
+ unless (&Apache::lonnet::hostname($server) eq $serverhostname) {
+ unless (grep(/^\Q$server\E$/,@okspares)) {
+ push(@okspares,$server);
+ }
+ }
+ }
+ }
+ my $new = $env{'form.newspare_'.$type.'_'.$lonhost};
+ my $newspare;
+ if (($new ne '') && (&Apache::lonnet::hostname($new))) {
+ unless (&Apache::lonnet::hostname($new) eq $serverhostname) {
+ $newspare = $new;
+ }
+ }
+ my @spares;
+ if (($newspare ne '') && (!grep(/^\Q$newspare\E$/,@okspares))) {
+ @spares = sort(@okspares,$newspare);
+ } else {
+ @spares = sort(@okspares);
+ }
+ $defaultshash{'usersessions'}{'spares'}{$lonhost}{$type} = \@spares;
+ if (ref($spareid{$lonhost}) eq 'HASH') {
+ if (ref($spareid{$lonhost}{$type}) eq 'ARRAY') {
+ my @diffs = &Apache::loncommon::compare_arrays($spareid{$lonhost}{$type},\@spares);
+ if (@diffs > 0) {
+ $spareschg{$type} = 1;
+ }
+ }
+ }
+ }
+ if (keys(%spareschg) > 0) {
+ $changes{'spares'}{$lonhost} = \%spareschg;
+ }
+ }
+
+ if (ref($domconfig{'usersessions'}) eq 'HASH') {
+ if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
+ if (ref($changes{'spares'}) eq 'HASH') {
+ if (keys(%{$changes{'spares'}}) > 0) {
+ $savespares = 1;
+ }
+ }
+ } else {
+ $savespares = 1;
+ }
+ }
+
+ my $nochgmsg = &mt('No changes made to settings for user session hosting/offloading.');
+ if ((keys(%changes) > 0) || ($savespares)) {
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
+ $dom);
+ if ($putresult eq 'ok') {
+ if (ref($defaultshash{'usersessions'}) eq 'HASH') {
+ if (ref($defaultshash{'usersessions'}{'remote'}) eq 'HASH') {
+ $domdefaults{'remotesessions'} = $defaultshash{'usersessions'}{'remote'};
+ }
+ if (ref($defaultshash{'usersessions'}{'hosted'}) eq 'HASH') {
+ $domdefaults{'hostedsessions'} = $defaultshash{'usersessions'}{'hosted'};
+ }
+ }
+ my $cachetime = 24*60*60;
+ &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime);
+ if (keys(%changes) > 0) {
+ my %lt = &usersession_titles();
+ $resulttext = &mt('Changes made:').'';
+ foreach my $prefix (@prefixes) {
+ if (ref($changes{$prefix}) eq 'HASH') {
+ $resulttext .= ''.$lt{$prefix}.'';
+ if ($prefix eq 'spares') {
+ if (ref($changes{$prefix}) eq 'HASH') {
+ foreach my $lonhost (sort(keys(%{$changes{$prefix}}))) {
+ $resulttext .= ''.$lonhost.' ';
+ my $lonhostdom = &Apache::lonnet::host_domain($lonhost);
+ &Apache::lonnet::remote_devalidate_cache($lonhost,'spares',$lonhostdom);
+ if (ref($changes{$prefix}{$lonhost}) eq 'HASH') {
+ foreach my $type (@{$types{$prefix}}) {
+ if ($changes{$prefix}{$lonhost}{$type}) {
+ my $offloadto = &mt('None');
+ if (ref($defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}) eq 'ARRAY') {
+ if (@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}} > 0) {
+ $offloadto = join(', ',@{$defaultshash{'usersessions'}{'spares'}{$lonhost}{$type}});
+ }
+ }
+ $resulttext .= &mt('[_1] set to: [_2].',''.$lt{$type}.' ',$offloadto).(' 'x3);
+ }
+ }
+ }
+ $resulttext .= ' ';
+ }
+ }
+ } else {
+ foreach my $type (@{$types{$prefix}}) {
+ if (defined($changes{$prefix}{$type})) {
+ my $newvalue;
+ if (ref($defaultshash{'usersessions'}) eq 'HASH') {
+ if (ref($defaultshash{'usersessions'}{$prefix})) {
+ if ($type eq 'version') {
+ $newvalue = $defaultshash{'usersessions'}{$prefix}{$type};
+ } elsif (ref($defaultshash{'usersessions'}{$prefix}{$type}) eq 'ARRAY') {
+ if (@{$defaultshash{'usersessions'}{$prefix}{$type}} > 0) {
+ $newvalue = join(', ',@{$defaultshash{'usersessions'}{$prefix}{$type}});
+ }
+ }
+ }
+ }
+ if ($newvalue eq '') {
+ if ($type eq 'version') {
+ $resulttext .= ''.&mt('[_1] set to: off',$lt{$type}).' ';
+ } else {
+ $resulttext .= ''.&mt('[_1] set to: none',$lt{$type}).' ';
+ }
+ } else {
+ if ($type eq 'version') {
+ $newvalue .= ' '.&mt('(or later)');
+ }
+ $resulttext .= ''.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).' ';
+ }
+ }
+ }
+ }
+ $resulttext .= ' ';
+ }
+ }
+ $resulttext .= ' ';
+ } else {
+ $resulttext = $nochgmsg;
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ } else {
+ $resulttext = $nochgmsg;
+ }
+ return $resulttext;
+}
+
+sub modify_loadbalancing {
+ my ($dom,%domconfig) = @_;
+ my $primary_id = &Apache::lonnet::domain($dom,'primary');
+ my $intdom = &Apache::lonnet::internet_dom($primary_id);
+ my ($othertitle,$usertypes,$types) =
+ &Apache::loncommon::sorted_inst_types($dom);
+ my %servers = &Apache::lonnet::internet_dom_servers($dom);
+ my @sparestypes = ('primary','default');
+ my %typetitles = &sparestype_titles();
+ my $resulttext;
+ if (keys(%servers) > 1) {
+ my ($currbalancer,$currtargets,$currrules);
+ if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
+ $currbalancer = $domconfig{'loadbalancing'}{'lonhost'};
+ $currtargets = $domconfig{'loadbalancing'}{'targets'};
+ $currrules = $domconfig{'loadbalancing'}{'rules'};
+ } else {
+ ($currbalancer,$currtargets) =
+ &Apache::lonnet::get_lonbalancer_config(\%servers);
+ }
+ my ($saveloadbalancing,%defaultshash,%changes);
+ my ($alltypes,$othertypes,$titles) =
+ &loadbalancing_titles($dom,$intdom,$usertypes,$types);
+ my %ruletitles = &offloadtype_text();
+ my $balancer = $env{'form.loadbalancing_lonhost'};
+ if (!$servers{$balancer}) {
+ undef($balancer);
+ }
+ if ($currbalancer ne $balancer) {
+ $changes{'lonhost'} = 1;
+ }
+ $defaultshash{'loadbalancing'}{'lonhost'} = $balancer;
+ if ($balancer ne '') {
+ unless (ref($domconfig{'loadbalancing'}) eq 'HASH') {
+ $saveloadbalancing = 1;
+ }
+ foreach my $sparetype (@sparestypes) {
+ my @targets = &Apache::loncommon::get_env_multiple('form.loadbalancing_target_'.$sparetype);
+ my @offloadto;
+ foreach my $target (@targets) {
+ if (($servers{$target}) && ($target ne $balancer)) {
+ if ($sparetype eq 'default') {
+ if (ref($defaultshash{'loadbalancing'}{'targets'}{'primary'}) eq 'ARRAY') {
+ next if (grep(/^\Q$target\E$/,@{$defaultshash{'loadbalancing'}{'targets'}{'primary'}}));
+ }
+ }
+ unless(grep(/^\Q$target\E$/,@offloadto)) {
+ push(@offloadto,$target);
+ }
+ }
+ $defaultshash{'loadbalancing'}{'targets'}{$sparetype} = \@offloadto;
+ }
+ }
+ } else {
+ foreach my $sparetype (@sparestypes) {
+ $defaultshash{'loadbalancing'}{'targets'}{$sparetype} = [];
+ }
+ }
+ if (ref($currtargets) eq 'HASH') {
+ foreach my $sparetype (@sparestypes) {
+ if (ref($currtargets->{$sparetype}) eq 'ARRAY') {
+ my @targetdiffs = &Apache::loncommon::compare_arrays($currtargets->{$sparetype},$defaultshash{'loadbalancing'}{'targets'}{$sparetype});
+ if (@targetdiffs > 0) {
+ $changes{'targets'} = 1;
+ }
+ } elsif (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') {
+ if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) {
+ $changes{'targets'} = 1;
+ }
+ }
+ }
+ } else {
+ foreach my $sparetype (@sparestypes) {
+ if (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') {
+ if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) {
+ $changes{'targets'} = 1;
+ }
+ }
+ }
+ }
+ my $ishomedom;
+ if ($balancer ne '') {
+ if (&Apache::lonnet::host_domain($balancer) eq $dom) {
+ $ishomedom = 1;
+ }
+ }
+ if (ref($alltypes) eq 'ARRAY') {
+ foreach my $type (@{$alltypes}) {
+ my $rule;
+ if ($balancer ne '') {
+ unless ((($type eq '_LC_external') || ($type eq '_LC_internetdom')) &&
+ (!$ishomedom)) {
+ $rule = $env{'form.loadbalancing_rules_'.$type};
+ }
+ if ($rule eq 'specific') {
+ $rule = $env{'form.loadbalancing_singleserver_'.$type};
+ }
+ }
+ $defaultshash{'loadbalancing'}{'rules'}{$type} = $rule;
+ if (ref($currrules) eq 'HASH') {
+ if ($rule ne $currrules->{$type}) {
+ $changes{'rules'}{$type} = 1;
+ }
+ } elsif ($rule ne '') {
+ $changes{'rules'}{$type} = 1;
+ }
+ }
+ }
+ my $nochgmsg = &mt('No changes made to Load Balancer settings.');
+ if ((keys(%changes) > 0) || ($saveloadbalancing)) {
+ my $putresult = &Apache::lonnet::put_dom('configuration',
+ \%defaultshash,$dom);
+ if ($putresult eq 'ok') {
+ if (keys(%changes) > 0) {
+ if ($changes{'lonhost'}) {
+ if ($currbalancer ne '') {
+ &Apache::lonnet::remote_devalidate_cache($currbalancer,'loadbalancing',$dom);
+ }
+ if ($balancer eq '') {
+ $resulttext .= ''.&mt('Load Balancing with dedicated server discontinued').' ';
+ } else {
+ &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom);
+ $resulttext .= ''.&mt('Dedicated Load Balancer server set to [_1]',$balancer);
+ }
+ } else {
+ &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom);
+ }
+ if (($changes{'targets'}) && ($balancer ne '')) {
+ my %offloadstr;
+ foreach my $sparetype (@sparestypes) {
+ if (ref($defaultshash{'loadbalancing'}{'targets'}{$sparetype}) eq 'ARRAY') {
+ if (@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}} > 0) {
+ $offloadstr{$sparetype} = join(', ',@{$defaultshash{'loadbalancing'}{'targets'}{$sparetype}});
+ }
+ }
+ }
+ if (keys(%offloadstr) == 0) {
+ $resulttext .= ' '.&mt("Servers to which Load Balance server offloads set to 'None', by default").' ';
+ } else {
+ my $showoffload;
+ foreach my $sparetype (@sparestypes) {
+ $showoffload .= ''.$typetitles{$sparetype}.' : ';
+ if (defined($offloadstr{$sparetype})) {
+ $showoffload .= $offloadstr{$sparetype};
+ } else {
+ $showoffload .= &mt('None');
+ }
+ $showoffload .= (' 'x3);
+ }
+ $resulttext .= ''.&mt('By default, Load Balancer server set to offload to: [_1]',$showoffload).' ';
+ }
+ }
+ if ((ref($changes{'rules'}) eq 'HASH') && ($balancer ne '')) {
+ if ((ref($alltypes) eq 'ARRAY') && (ref($titles) eq 'HASH')) {
+ foreach my $type (@{$alltypes}) {
+ if ($changes{'rules'}{$type}) {
+ my $rule = $defaultshash{'loadbalancing'}{'rules'}{$type};
+ my $balancetext;
+ if ($rule eq '') {
+ $balancetext = $ruletitles{'default'};
+ } elsif (($rule eq 'homeserver') || ($rule eq 'externalbalancer')) {
+ $balancetext = $ruletitles{$rule};
+ } else {
+ $balancetext = &mt('offload to [_1]',$defaultshash{'loadbalancing'}{'rules'}{$type});
+ }
+ $resulttext .= ''.&mt('Load Balancing for [_1] set to: [_2]',$titles->{$type},$balancetext).' ';
+ }
+ }
+ }
+ }
+ if ($resulttext ne '') {
+ $resulttext = &mt('Changes made:').'';
+ } else {
+ $resulttext = $nochgmsg;
+ }
+ } else {
+ $resulttext = $nochgmsg;
+ if ($balancer ne '') {
+ &Apache::lonnet::remote_devalidate_cache($balancer,'loadbalancing',$dom);
+ }
+ }
+ } else {
+ $resulttext = ''.
+ &mt('An error occurred: [_1]',$putresult).' ';
+ }
+ } else {
+ $resulttext = $nochgmsg;
+ }
+ } else {
+ $resulttext = &mt('Load Balancing unavailable as this domain only has one server.');
+ }
+ return $resulttext;
+}
+
sub recurse_check {
my ($chkcats,$categories,$depth,$name) = @_;
if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
@@ -5189,4 +8110,476 @@ sub recurse_cat_deletes {
return;
}
+sub get_active_dcs {
+ my ($dom) = @_;
+ my %dompersonnel = &Apache::lonnet::get_domain_roles($dom,['dc']);
+ my %domcoords;
+ my $numdcs = 0;
+ my $now = time;
+ foreach my $server (keys(%dompersonnel)) {
+ foreach my $user (sort(keys(%{$dompersonnel{$server}}))) {
+ my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
+ my ($end,$start) = split(':',$dompersonnel{$server}{$user});
+ if (($end eq '') || ($end == 0) || ($end > $now)) {
+ if ($start <= $now) {
+ $domcoords{$uname.':'.$udom} = $dompersonnel{$server}{$user};
+ }
+ }
+ }
+ }
+ return %domcoords;
+}
+
+sub active_dc_picker {
+ my ($dom,$curr_dc) = @_;
+ my %domcoords = &get_active_dcs($dom);
+ my @dcs = sort(keys(%domcoords));
+ my $numdcs = scalar(@dcs);
+ my $datatable;
+ my $numinrow = 2;
+ if ($numdcs > 1) {
+ $datatable = '';
+ } elsif (@dcs) {
+ $datatable .= ' ';
+ }
+ return ($numdcs,$datatable);
+}
+
+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) = @_;
+ 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);
+ 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 captcha_phrases {
+ return &Apache::lonlocal::texthash (
+ priv => 'Private key',
+ pub => 'Public key',
+ original => 'original (CAPTCHA)',
+ recaptcha => 'successor (ReCAPTCHA)',
+ notused => 'unused',
+ );
+}
+
1;