--- loncom/interface/domainprefs.pm 2016/09/11 14:51:42 1.278 +++ loncom/interface/domainprefs.pm 2016/09/16 23:42:58 1.280 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Handler to set domain-wide configuration settings # -# $Id: domainprefs.pm,v 1.278 2016/09/11 14:51:42 raeburn Exp $ +# $Id: domainprefs.pm,v 1.280 2016/09/16 23:42:58 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -218,13 +218,13 @@ sub handler { 'serverstatuses','requestcourses','helpsettings', 'coursedefaults','usersessions','loadbalancing', 'requestauthor','selfenrollment','inststatus', - 'ltitools','ssl'],$dom); + 'ltitools','ssl','trust'],$dom); my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll', 'autoupdate','autocreate','directorysrch','contacts', 'usercreation','selfcreation','usermodification','scantron', 'requestcourses','requestauthor','coursecategories', 'serverstatuses','helpsettings','coursedefaults', - 'ltitools','selfenrollment','usersessions','ssl'); + 'ltitools','selfenrollment','usersessions','ssl','trust'); my %existing; if (ref($domconfig{'loadbalancing'}) eq 'HASH') { %existing = %{$domconfig{'loadbalancing'}}; @@ -466,7 +466,7 @@ sub handler { print => \&print_usersessions, modify => \&modify_usersessions, }, - 'loadbalancing' => + 'loadbalancing' => {text => 'Dedicated Load Balancer(s)', help => 'Domain_Configuration_Load_Balancing', header => [{col1 => 'Balancers', @@ -477,7 +477,7 @@ sub handler { print => \&print_loadbalancing, modify => \&modify_loadbalancing, }, - 'ltitools' => + 'ltitools' => {text => 'External Tools (LTI)', help => 'Domain_configuration_LTI_Tools', header => [{col1 => 'Setting', @@ -485,7 +485,7 @@ sub handler { print => \&print_ltitools, modify => \&modify_ltitools, }, - 'ssl' => + 'ssl' => {text => 'LON-CAPA Network (SSL)', help => 'Domain_Configuration_Network_SSL', header => [{col1 => 'Server', @@ -497,6 +497,30 @@ sub handler { print => \&print_ssl, modify => \&modify_ssl, }, + 'trust' => + {text => 'Trust Settings', + help => 'Domain_Configuration_Trust', + header => [{col1 => "Access to this domain's content by others", + col2 => 'Rules'}, + {col1 => "Access to other domain's content by this domain", + col2 => 'Rules'}, + {col1 => "Enrollment in this domain's courses by others", + col2 => 'Rules',}, + {col1 => "Co-author roles in this domain for others", + col2 => 'Rules',}, + {col1 => "Co-author roles for this domain's users elsewhere", + col2 => 'Rules',}, + {col1 => "Domain roles in this domain assignable to others", + col2 => 'Rules'}, + {col1 => "Course catalog for this domain displayed elsewhere", + col2 => 'Rules'}, + {col1 => "Requests for creation of courses in this domain by others", + col2 => 'Rules'}, + {col1 => "Users in other domains can send messages to this domain", + col2 => 'Rules'},], + print => \&print_trust, + modify => \&modify_trust, + }, ); if (keys(%servers) > 1) { $prefs{'login'} = { text => 'Log-in page options', @@ -674,6 +698,8 @@ sub process_changes { $output = &modify_ltitools($r,$dom,$action,$lastactref,%domconfig); } elsif ($action eq 'ssl') { $output = &modify_ssl($dom,$lastactref,%domconfig); + } elsif ($action eq 'trust') { + $output = &modify_trust($dom,$lastactref,%domconfig); } return $output; } @@ -722,7 +748,7 @@ sub print_config_box { if (($action eq 'autoupdate') || ($action eq 'usercreation') || ($action eq 'selfcreation') || ($action eq 'usermodification') || ($action eq 'defaults') || ($action eq 'coursedefaults') || ($action eq 'selfenrollment') || ($action eq 'usersessions') || ($action eq 'ssl') || - ($action eq 'directorysrch')) { + ($action eq 'directorysrch') || ($action eq 'trust')) { $output .= $item->{'print'}->('top',$dom,$settings,\$rowtotal); } elsif ($action eq 'coursecategories') { $output .= $item->{'print'}->('top',$dom,$item,$settings,\$rowtotal); @@ -753,14 +779,45 @@ sub print_config_box { if (($action eq 'autoupdate') || ($action eq 'usercreation') || ($action eq 'selfcreation') || ($action eq 'selfenrollment') || ($action eq 'usersessions') || ($action eq 'coursecategories') || - ($action eq 'ssl')) { + ($action eq 'ssl') || ($action eq 'trust')) { if ($action eq 'coursecategories') { $output .= &print_coursecategories('middle',$dom,$item,$settings,\$rowtotal); $colspan = ' colspan="2"'; + } elsif ($action eq 'trust') { + $output .= $item->{'print'}->('shared',$dom,$settings,\$rowtotal); } else { $output .= $item->{'print'}->('middle',$dom,$settings,\$rowtotal); } - $output .= ' + if ($action eq 'trust') { + $output .= ' + + + '; + my @trusthdrs = qw(2 3 4 5 6 7); + my @prefixes = qw(enroll othcoau coaurem domroles catalog reqcrs); + for (my $i=0; $i<@trusthdrs; $i++) { + $output .= ' + + + + + + '. + $item->{'print'}->($prefixes[$i],$dom,$settings,\$rowtotal).' +
'.&mt($item->{'header'}->[$trusthdrs[$i]]->{'col1'}).''.&mt($item->{'header'}->[$trusthdrs[$i]]->{'col2'}).'
+ + '; + } + $output .= ' + + + + + + '. + $item->{'print'}->('bottom',$dom,$settings,\$rowtotal); + } else { + $output .= '
'.&mt($item->{'header'}->[8]->{'col1'}).''.&mt($item->{'header'}->[8]->{'col2'}).'
@@ -771,10 +828,11 @@ sub print_config_box { '.&mt($item->{'header'}->[2]->{'col1'}).' '.&mt($item->{'header'}->[2]->{'col2'}).' '."\n"; - if ($action eq 'coursecategories') { - $output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal); - } else { - $output .= $item->{'print'}->('bottom',$dom,$settings,\$rowtotal); + if ($action eq 'coursecategories') { + $output .= &print_coursecategories('bottom',$dom,$item,$settings,\$rowtotal); + } else { + $output .= $item->{'print'}->('bottom',$dom,$settings,\$rowtotal); + } } $rowtotal ++; } elsif (($action eq 'usermodification') || ($action eq 'coursedefaults') || @@ -3619,9 +3677,9 @@ sub print_coursedefaults { $additional .= ''."\n"; %defaultchecked = ('postsubmit' => 'on'); @toggles = ('postsubmit'); - my $current = { - 'postsubmit' => $postsubmitclient, - }; + $current = { + 'postsubmit' => $postsubmitclient, + }; ($table,$itemcount) = &radiobutton_prefs($current,\@toggles,\%defaultchecked, \%choices,$itemcount,$onclick,$additional,'left'); @@ -3872,7 +3930,7 @@ sub print_validation_rows { sub print_usersessions { my ($position,$dom,$settings,$rowtotal) = @_; - my ($css_class,$datatable,%checked,%choices); + my ($css_class,$datatable,$itemcount,%checked,%choices); my (%by_ip,%by_location,@intdoms,@instdoms); &build_location_hashes(\@intdoms,\%by_ip,\%by_location,\@instdoms); @@ -3880,7 +3938,6 @@ sub print_usersessions { 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); @@ -3893,123 +3950,134 @@ sub print_usersessions { $datatable .= &spares_row($dom,\%servers,\%spareid,\%serverhomes,\%altids,$curroffloadnow,$rowtotal); } else { $datatable .= ''. - &mt('Nothing to set here, as the cluster to which this domain belongs only contains one server.'); + &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.'); + my %titles = &usersession_titles(); + my ($prefix,@types); + if ($position eq 'bottom') { + $prefix = 'remote'; + @types = ('version','excludedomain','includedomain'); } 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') { + $prefix = 'hosted'; + @types = ('excludedomain','includedomain'); + } + ($datatable,$itemcount) = &rules_by_location($settings,$prefix,\%by_location,\%by_ip,\@types,\%titles); + } + $$rowtotal += $itemcount; + return $datatable; +} + +sub rules_by_location { + my ($settings,$prefix,$by_location,$by_ip,$types,$titles) = @_; + my ($datatable,$itemcount,$css_class); + if (keys(%{$by_location}) == 0) { + $css_class = $itemcount%2 ? ' class="LC_odd_row"' : ''; + $datatable = ''. + &mt('Nothing to set here, as the cluster to which this domain belongs only contains one institution.'). + ''; + $itemcount = 1; + } else { + $itemcount = 0; + my $numinrow = 5; + my (%current,%checkedon,%checkedoff); + 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 = ''.&mt('Not in use').'  + '; + if ($type eq 'version') { + my @lcversions = &Apache::lonnet::all_loncaparevs(); + 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; - } + $selector .= ' '; + } + $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 .= ''; - } - $datatable .= ''; } - $rem = @locations%($numinrow); - my $colsleft = $numinrow - $rem; - if ($colsleft > 1 ) { - $datatable .= ''; - } elsif ($colsleft == 1) { - $datatable .= ''; - } - $datatable .= '
'. - ''. - '  
'; + $rem = $i%($numinrow); + if ($rem == 0) { + if ($i > 0) { + $datatable .= ''; + } + $datatable .= ''; + } + $datatable .= ''. + ''; } - $datatable .= ''; - $itemcount ++; + $rem = @locations%($numinrow); + my $colsleft = $numinrow - $rem; + if ($colsleft > 1 ) { + $datatable .= ''. + ' '; + } elsif ($colsleft == 1) { + $datatable .= ' '; + } + $datatable .= ''; } + $datatable .= ''; + $itemcount ++; } } - $$rowtotal += $itemcount; - return $datatable; + return ($datatable,$itemcount); } sub print_ssl { @@ -4020,9 +4088,9 @@ sub print_ssl { if ($position eq 'top') { my %domservers = &Apache::lonnet::get_servers($dom); $css_class = $itemcount%2?' class="LC_odd_row"':''; - $datatable .= ''. - &LONCAPA::SSL::print_certstatus(\%domservers,'web','domprefs'). - ''; + $datatable = ''. + &LONCAPA::SSL::print_certstatus(\%domservers,'web','domprefs'). + ''; $itemcount ++; } else { my %titles = &ssl_titles(); @@ -4078,86 +4146,16 @@ sub print_ssl { $itemcount ++; } } else { - my $numinrow = 5; my $prefix = 'replication'; my @types = ('certreq','nocertreq'); - my (%current,%checkedon,%checkedoff); - 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 (ref($current{$key}) eq 'ARRAY') { - $checkedon{$key} = ' checked="checked"'; - $checkedoff{$key} = ''; - } - } - } - } - if (@locations > 0) { - foreach my $type (@types) { - $css_class = $itemcount%2?' class="LC_odd_row"':''; - $datatable .= ' - '.$titles{$type}.'
-   -   - -
'.(' 'x2)."\n". - ''. - "\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 .= ''; - } - $datatable .= ''; - } - $rem = @locations%($numinrow); - my $colsleft = $numinrow - $rem; - if ($colsleft > 1 ) { - $datatable .= ''; - } elsif ($colsleft == 1) { - $datatable .= ''; - } - $datatable .= '
'. - ''. - '  
'; - $itemcount ++; - } - } else { - $datatable .= ''.&mt('Nothing to set here, as there are no other institutions').''; + if (keys(%by_location) == 0) { + $datatable .= ''. + &mt('Nothing to set here, as there are no other institutions'). + ''; $itemcount ++; + } else { + ($datatable,$itemcount) = + &rules_by_location($settings,$prefix,\%by_location,\%by_ip,\@types,\%titles); } } } @@ -4178,6 +4176,40 @@ sub ssl_titles { yes => 'SSL Optional (used if available)', req => 'SSL Required', ); +} + +sub print_trust { + my ($prefix,$dom,$settings,$rowtotal) = @_; + my ($css_class,$datatable,%checked,%choices); + my (%by_ip,%by_location,@intdoms,@instdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location,\@instdoms); + my $itemcount = 1; + my %titles = &trust_titles(); + my @types = ('exc','inc'); + if ($prefix eq 'top') { + $prefix = 'content'; + } elsif ($prefix eq 'bottom') { + $prefix = 'msg'; + } + ($datatable,$itemcount) = &rules_by_location($settings,$prefix,\%by_location,\%by_ip,\@types,\%titles); + $$rowtotal += $itemcount; + return $datatable; +} + +sub trust_titles { + return &Apache::lonlocal::texthash( + content => "Access to this domain's content by others", + shared => "Access to other domain's content by this domain", + enroll => "Enrollment in this domain's courses by others", + othcoau => "Co-author roles in this domain for others", + coaurem => "Co-author roles for this domain's users elsewhere", + domroles => "Domain roles in this domain assignable to others", + catalog => "Course Catalog for this domain displayed elsewhere", + reqcrs => "Requests for creation of courses in this domain by others", + msg => "Users in other domains can send messages to this domain", + exc => "Allow all, but exclude specific domains", + inc => "Deny all, but include specific domains", + ); } sub build_location_hashes { @@ -12672,7 +12704,6 @@ sub modify_ssl { connect => \@connecttypes, replication => \@reptypes, ); - my $action = 'ssl'; foreach my $prefix (sort(keys(%types))) { foreach my $type (@{$types{$prefix}}) { if ($prefix eq 'connect') { @@ -12806,6 +12837,130 @@ sub modify_ssl { } else { $resulttext = $nochgmsg; } + } else { + $resulttext = ''. + &mt('An error occurred: [_1]',$putresult).''; + } + } else { + $resulttext = $nochgmsg; + } + return $resulttext; +} + +sub modify_trust { + my ($dom,$lastactref,%domconfig) = @_; + my (%by_ip,%by_location,@intdoms,@instdoms); + &build_location_hashes(\@intdoms,\%by_ip,\%by_location,\@instdoms); + my @locations = sort(keys(%by_location)); + my @prefixes = qw(content shared enroll othcoau coaurem domroles catalog reqcrs msg); + my @types = ('exc','inc'); + my (%defaultshash,%changes); + foreach my $prefix (@prefixes) { + $defaultshash{'trust'}{$prefix} = {}; + } + my %domdefaults = &Apache::lonnet::get_domain_defaults($dom,1); + my $resulttext; + foreach my $prefix (@prefixes) { + foreach my $type (@types) { + my $inuse = $env{'form.'.$prefix.'_'.$type.'_inuse'}; + 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{'trust'}) eq 'HASH') { + if (ref($domconfig{'trust'}{$prefix}) eq 'HASH') { + if (ref($domconfig{'trust'}{$prefix}{$type}) eq 'ARRAY') { + if ($inuse == 0) { + $changes{$prefix}{$type} = 1; + } else { + $defaultshash{'trust'}{$prefix}{$type} = \@okvals; + my @changed = &Apache::loncommon::compare_arrays($domconfig{'trust'}{$prefix}{$type},$defaultshash{'trust'}{$prefix}{$type}); + if (@changed > 0) { + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'trust'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'trust'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } else { + if ($inuse == 1) { + $defaultshash{'trust'}{$prefix}{$type} = \@okvals; + $changes{$prefix}{$type} = 1; + } + } + } + } + my $nochgmsg = &mt('No changes made to trust settings.'); + if (keys(%changes) > 0) { + my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash, + $dom); + if ($putresult eq 'ok') { + if (ref($defaultshash{'trust'}) eq 'HASH') { + foreach my $prefix (@prefixes) { + if (ref($defaultshash{'trust'}{$prefix}) eq 'HASH') { + $domdefaults{'trust'.$prefix} = $defaultshash{'trust'}{$prefix}; + } + } + } + my $cachetime = 24*60*60; + &Apache::lonnet::do_cache_new('domdefaults',$dom,\%domdefaults,$cachetime); + if (ref($lastactref) eq 'HASH') { + $lastactref->{'domdefaults'} = 1; + } + if (keys(%changes) > 0) { + my %lt = &trust_titles(); + $resulttext = &mt('Changes made:').'
    '; + foreach my $prefix (@prefixes) { + if (ref($changes{$prefix}) eq 'HASH') { + $resulttext .= '
  • '.$lt{$prefix}.'
      '; + foreach my $type (@types) { + if (defined($changes{$prefix}{$type})) { + my $newvalue; + if (ref($defaultshash{'trust'}) eq 'HASH') { + if (ref($defaultshash{'trust'}{$prefix})) { + if (ref($defaultshash{'trust'}{$prefix}{$type}) eq 'ARRAY') { + if (@{$defaultshash{'trust'}{$prefix}{$type}} > 0) { + $newvalue = join(', ',@{$defaultshash{'trust'}{$prefix}{$type}}); + } + } + } + } + if ($newvalue eq '') { + $resulttext .= '
    • '.&mt('[_1] set to: none',$lt{$type}).'
      • '; + } else { + $resulttext .= '
    • '.&mt('[_1] set to: [_2].',$lt{$type},$newvalue).'
      • '; + } + } + } + $resulttext .= '
    '; + } + } + $resulttext .= '
'; + } else { + $resulttext = $nochgmsg; + } } else { $resulttext = ''. &mt('An error occurred: [_1]',$putresult).'';