[LON-CAPA-cvs] cvs: loncom /interface domainprefs.pm
raeburn
raeburn@source.lon-capa.org
Fri, 28 Nov 2008 21:02:35 -0000
This is a MIME encoded message
--raeburn1227906155
Content-Type: text/plain
raeburn Fri Nov 28 21:02:35 2008 EDT
Modified files:
/loncom/interface domainprefs.pm
Log:
- Add new domain configuration to control access to server status pages.
--raeburn1227906155
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20081128210235.txt"
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.68 loncom/interface/domainprefs.pm:1.69
--- loncom/interface/domainprefs.pm:1.68 Fri Sep 19 03:27:04 2008
+++ loncom/interface/domainprefs.pm Fri Nov 28 21:02:35 2008
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Handler to set domain-wide configuration settings
#
-# $Id: domainprefs.pm,v 1.68 2008/09/19 03:27:04 raeburn Exp $
+# $Id: domainprefs.pm,v 1.69 2008/11/28 21:02:35 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -37,8 +37,9 @@
use Apache::lonhtmlcommon();
use Apache::lonlocal;
use Apache::lonmsg();
-use LONCAPA;
+use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Enrollment;
+use LONCAPA::loncgi();
use File::Copy;
use Locale::Language;
use DateTime::TimeZone;
@@ -73,11 +74,11 @@
&Apache::lonnet::get_dom('configuration',['login','rolecolors',
'quotas','autoenroll','autoupdate','directorysrch',
'usercreation','usermodification','contacts','defaults',
- 'scantron','coursecategories'],$dom);
+ 'scantron','coursecategories','serverstatuses'],$dom);
my @prefs_order = ('rolecolors','login','defaults','quotas','autoenroll',
'autoupdate','directorysrch','contacts',
'usercreation','usermodification','scantron',
- 'coursecategories');
+ 'coursecategories','serverstatuses');
my %prefs = (
'rolecolors' =>
{ text => 'Default color schemes',
@@ -146,7 +147,7 @@
{col1 => 'Context',
col2 => 'Assignable authentication types'}],
},
- 'usermodification' =>
+ 'usermodification' =>
{ text => 'User modification',
help => 'Domain_Configuration_User_Modification',
header => [{col1 => 'Target user has role',
@@ -156,22 +157,30 @@
{col1 => "Status of user",
col2 => 'Information settable when self-creating account (if directory data blank)'}],
},
- 'scantron' =>
+ 'scantron' =>
{ text => 'Scantron format file',
help => 'Domain_Configuration_Scantron_Format',
header => [ {col1 => 'Item',
col2 => '',
}],
},
- 'coursecategories' =>
+ 'coursecategories' =>
{ text => 'Cataloging of courses',
help => 'Domain_Configuration_Cataloging_Courses',
- header => [{col1 => 'Category settings',
+ header => [{col1 => 'Category settings',
col2 => '',},
{col1 => 'Categories',
col2 => '',
}],
- }
+ },
+ 'serverstatuses' =>
+ {text => 'Access to Server Status Pages',
+ help => 'Domain_Configuration_Server_Status',
+ header => [{col1 => 'Status Page',
+ col2 => 'Other named users',
+ col3 => 'Specific IPs',
+ }],
+ },
);
my @roles = ('student','coordinator','author','admin');
my @actions = &Apache::loncommon::get_env_multiple('form.actions');
@@ -372,6 +381,8 @@
$output = &modify_scantron($r,$dom,$confname,%domconfig);
} elsif ($action eq 'coursecategories') {
$output = &modify_coursecategories($dom,%domconfig);
+ } elsif ($action eq 'serverstatuses') {
+ $output = &modify_serverstatuses($dom,%domconfig);
}
return $output;
}
@@ -406,7 +417,7 @@
<td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[0]->{'col1'}).'</td>
<td class="LC_right_item">'.&mt($item->{'header'}->[0]->{'col2'}).'</td>
</tr>';
- $rowtotal ++;
+ $rowtotal ++;
if ($action eq 'autoupdate') {
$output .= &print_autoupdate('top',$dom,$settings,\$rowtotal);
} elsif ($action eq 'usercreation') {
@@ -471,8 +482,10 @@
<td>
<table class="LC_nested">
<tr class="LC_info_row">
- <td class="LC_left_item"'.$colspan.'>'.&mt($item->{'header'}->[2]->{'col1'}).'</td>
- <td class="LC_right_item">'.&mt($item->{'header'}->[2]->{'col2'}).'</td>
+ <td class="LC_left_item"'.$colspan.' valign="top">'.
+ &mt($item->{'header'}->[2]->{'col1'}).'</td>
+ <td class="LC_right_item" valign="top">'.
+ &mt($item->{'header'}->[2]->{'col2'}).'</td>
</tr>'.
&print_rolecolors($phase,'author',$dom,$confname,$settings,\$rowtotal).'
</table>
@@ -497,13 +510,33 @@
if (($action eq 'login') || ($action eq 'directorysrch')) {
$output .= '
<td class="LC_left_item" colspan="2">'.&mt($item->{'header'}->[0]->{'col1'}).'</td>';
+ } elsif ($action eq 'serverstatuses') {
+ $output .= '
+ <td class="LC_left_item" valign="top">'.&mt($item->{'header'}->[0]->{'col1'}).
+ '<br />('.&mt('Automatic access for Dom. Coords.').')</td>';
+
} else {
$output .= '
- <td class="LC_left_item">'.&mt($item->{'header'}->[0]->{'col1'}).'</td>';
+ <td class="LC_left_item" valign="top">'.&mt($item->{'header'}->[0]->{'col1'}).'</td>';
}
- $output .= '
- <td class="LC_right_item">'.&mt($item->{'header'}->[0]->{'col2'}).'</td>
- </tr>';
+ if ($action eq 'serverstatuses') {
+ $output .= '<td class="LC_left_item" valign="top">'.
+ &mt($item->{'header'}->[0]->{'col2'}).
+ '<br />(<tt>'.&mt('user1:domain1,user2:domain2 etc.').'</tt>)';
+ } else {
+ $output .= '<td class="LC_right_item" valign="top">'.
+ &mt($item->{'header'}->[0]->{'col2'});
+ }
+ $output .= '</td>';
+ if ($item->{'header'}->[0]->{'col3'}) {
+ $output .= '<td class="LC_right_item" valign="top">'.
+ &mt($item->{'header'}->[0]->{'col3'});
+ if ($action eq 'serverstatuses') {
+ $output .= '<br />(<tt>'.&mt('IP1,IP2 etc.').'</tt>)';
+ }
+ $output .= '</td>';
+ }
+ $output .= '</tr>';
$rowtotal ++;
if ($action eq 'login') {
$output .= &print_login($dom,$confname,$phase,$settings,\$rowtotal);
@@ -519,6 +552,8 @@
$output .= &print_defaults($dom,\$rowtotal);
} elsif ($action eq 'scantron') {
$output .= &print_scantronformat($r,$dom,$confname,$settings,\$rowtotal);
+ } elsif ($action eq 'serverstatuses') {
+ $output .= &print_serverstatuses($dom,$settings,\$rowtotal);
}
}
$output .= '
@@ -1466,24 +1501,17 @@
my $rownum = 0;
my $css_class;
foreach my $item (@contacts) {
- if ($rownum%2) {
- $css_class = '';
- } else {
- $css_class = ' class="LC_odd_row" ';
- }
+ $rownum ++;
+ $css_class = $rownum%2?' class="LC_odd_row"':'';
$datatable .= '<tr'.$css_class.'>'.
'<td><span class="LC_nobreak">'.$titles->{$item}.
'</span></td><td class="LC_right_item">'.
'<input type="text" name="'.$item.'" value="'.
$to{$item}.'" /></td></tr>';
- $rownum ++;
}
foreach my $type (@mailings) {
- if ($rownum%2) {
- $css_class = '';
- } else {
- $css_class = ' class="LC_odd_row" ';
- }
+ $rownum ++;
+ $css_class = $rownum%2?' class="LC_odd_row"':'';
$datatable .= '<tr'.$css_class.'>'.
'<td><span class="LC_nobreak">'.
$titles->{$type}.': </span></td>'.
@@ -1500,7 +1528,6 @@
'<input type="text" name="'.$type.'_others" '.
'value="'.$otheremails{$type}.'" />'.
'</td></tr>'."\n";
- $rownum ++;
}
$$rowtotal += $rownum;
return $datatable;
@@ -1509,7 +1536,7 @@
sub contact_titles {
my %titles = &Apache::lonlocal::texthash (
'supportemail' => 'Support E-mail address',
- 'adminemail' => 'Default Server Admin E-mail address',
+ 'adminemail' => 'Default Server Admin E-mail address',
'errormail' => 'Error reports to be e-mailed to',
'packagesmail' => 'Package update alerts to be e-mailed to',
'helpdeskmail' => 'Helpdesk requests to be e-mailed to'
@@ -2210,6 +2237,58 @@
return $datatable;
}
+sub print_serverstatuses {
+ my ($dom,$settings,$rowtotal) = @_;
+ my $datatable;
+ my @pages = &serverstatus_pages();
+ my (%namedaccess,%machineaccess);
+ foreach my $type (@pages) {
+ $namedaccess{$type} = '';
+ $machineaccess{$type}= '';
+ }
+ if (ref($settings) eq 'HASH') {
+ foreach my $type (@pages) {
+ if (exists($settings->{$type})) {
+ if (ref($settings->{$type}) eq 'HASH') {
+ foreach my $key (keys(%{$settings->{$type}})) {
+ if ($key eq 'namedusers') {
+ $namedaccess{$type} = $settings->{$type}->{$key};
+ } elsif ($key eq 'machines') {
+ $machineaccess{$type} = $settings->{$type}->{$key};
+ }
+ }
+ }
+ }
+ }
+ }
+ my $titles= &LONCAPA::loncgi::serverstatus_titles();
+ my $rownum = 0;
+ my $css_class;
+ foreach my $type (@pages) {
+ $rownum ++;
+ $css_class = $rownum%2?' class="LC_odd_row"':'';
+ $datatable .= '<tr'.$css_class.'>'.
+ '<td><span class="LC_nobreak">'.
+ $titles->{$type}.'</span></td>'.
+ '<td class="LC_left_item">'.
+ '<input type="text" name="'.$type.'_namedusers" '.
+ 'value="'.$namedaccess{$type}.'" size="30" /></td>'.
+ '<td class="LC_right_item">'.
+ '<span class="LC_nobreak">'.
+ '<input type="text" name="'.$type.'_machines" '.
+ 'value="'.$machineaccess{$type}.'" size="10" />'.
+ '</td></tr>'."\n";
+ }
+ $$rowtotal += $rownum;
+ return $datatable;
+}
+
+sub serverstatus_pages {
+ return ('userstatus','lonstatus','loncron','server-status','codeversions',
+ 'clusterstatus','metadata_keywords','metadata_harvest',
+ 'takeoffline','takeonline','showenv');
+}
+
sub coursecategories_javascript {
my ($settings) = @_;
my ($output,$jstext,$cathash);
@@ -4618,6 +4697,132 @@
return $resulttext;
}
+sub modify_serverstatuses {
+ my ($dom,%domconfig) = @_;
+ my ($resulttext,%changes,%currserverstatus,%newserverstatus);
+ if (ref($domconfig{'serverstatuses'}) eq 'HASH') {
+ %currserverstatus = %{$domconfig{'serverstatuses'}};
+ }
+ my @pages = &serverstatus_pages();
+ foreach my $type (@pages) {
+ $newserverstatus{$type}{'namedusers'} = '';
+ $newserverstatus{$type}{'machines'} = '';
+ if (defined($env{'form.'.$type.'_namedusers'})) {
+ my @users = split(/,/,$env{'form.'.$type.'_namedusers'});
+ my @okusers;
+ foreach my $user (@users) {
+ my ($uname,$udom) = split(/:/,$user);
+ if (($udom =~ /^$match_domain$/) &&
+ (&Apache::lonnet::domain($udom)) &&
+ ($uname =~ /^$match_username$/)) {
+ if (!grep(/^\Q$user\E/,@okusers)) {
+ push(@okusers,$user);
+ }
+ }
+ }
+ if (@okusers > 0) {
+ @okusers = sort(@okusers);
+ $newserverstatus{$type}{'namedusers'} = join(',',@okusers);
+ }
+ }
+ if (defined($env{'form.'.$type.'_machines'})) {
+ my @machines = split(/,/,$env{'form.'.$type.'_machines'});
+ my @okmachines;
+ foreach my $ip (@machines) {
+ my @parts = split(/\./,$ip);
+ next if (@parts < 4);
+ my $badip = 0;
+ for (my $i=0; $i<4; $i++) {
+ if (!(($parts[$i] >= 0) && ($parts[$i] <= 255))) {
+ $badip = 1;
+ last;
+ }
+ }
+ if (!$badip) {
+ push(@okmachines,$ip);
+ }
+ }
+ @okmachines = sort(@okmachines);
+ $newserverstatus{$type}{'machines'} = join(',',@okmachines);
+ }
+ }
+ my %serverstatushash = (
+ serverstatuses => \%newserverstatus,
+ );
+ my $putresult = &Apache::lonnet::put_dom('configuration',\%serverstatushash,
+ $dom);
+ my %changes;
+ foreach my $type (@pages) {
+ if (ref($currserverstatus{$type}) eq 'HASH') {
+ my @currnamed = split(/,/,$currserverstatus{$type}{'namedusers'});
+ my @newusers = split(/,/,$newserverstatus{$type}{'namedusers'});
+ foreach my $item (@currnamed) {
+ if (!grep(/^\Q$item\E$/,@newusers)) {
+ $changes{$type}{'namedusers'} = 1;
+ last;
+ }
+ }
+ foreach my $item (@newusers) {
+ if (!grep(/^\Q$item\E$/,@currnamed)) {
+ $changes{$type}{'namedusers'} = 1;
+ last;
+ }
+ }
+ my @currmachines = split(/,/,$currserverstatus{$type}{'machines'});
+ my @newmachines = split(/,/,$newserverstatus{$type}{'machines'});
+ foreach my $item (@currmachines) {
+ if (!grep(/^\Q$item\E$/,@newmachines)) {
+ $changes{$type}{'machines'} = 1;
+ last;
+ }
+ }
+ foreach my $item (@newmachines) {
+ if (!grep(/^\Q$item\E$/,@currmachines)) {
+ $changes{$type}{'machines'} = 1;
+ last;
+ }
+ }
+
+ }
+ }
+ if (keys(%changes) > 0) {
+ my $titles= &LONCAPA::loncgi::serverstatus_titles();
+ my $putresult = &Apache::lonnet::put_dom('configuration',
+ \%serverstatushash,$dom);
+ if ($putresult eq 'ok') {
+ $resulttext .= &mt('Changes made:').'<ul>';
+ foreach my $type (@pages) {
+ if (defined($changes{$type})) {
+ $resulttext .= '<li>'.$titles->{$type}.'<ul>';
+ if (defined($changes{$type}{'namedusers'})) {
+ if ($newserverstatus{$type}{'namedusers'} eq '') {
+ $resulttext .= '<li>'.&mt("Access terminated for all specific (named) users").'</li>'."\n";
+ } else {
+ $resulttext .= '<li>'.&mt("Access available for the following specified users: ").$newserverstatus{$type}{'namedusers'}.'</li>'."\n";
+ }
+ } elsif (defined($changes{$type}{'machines'})) {
+ if ($newserverstatus{$type}{'machines'} eq '') {
+ $resulttext .= '<li>'.&mt("Access terminated for all specific IP addresses").'</li>'."\n";
+ } else {
+ $resulttext .= '<li>'.&mt("Access available for the following specified IP addresses: ").$newserverstatus{$type}{'machines'}.'</li>'."\n";
+ }
+
+ }
+ $resulttext .= '</ul></li>';
+ }
+ }
+ $resulttext .= '</ul>';
+ } else {
+ $resulttext = '<span class="LC_error">'.
+ &mt('An error occurred saving access settings for server status pages: [_1].',$putresult).'</span>';
+
+ }
+ } else {
+ $resulttext = &mt('No changes made to access to server status pages');
+ }
+ return $resulttext;
+}
+
sub recurse_check {
my ($chkcats,$categories,$depth,$name) = @_;
if (ref($chkcats->[$depth]{$name}) eq 'ARRAY') {
--raeburn1227906155--