--- loncom/interface/domainprefs.pm	2008/09/19 03:27:04	1.68
+++ loncom/interface/domainprefs.pm	2008/11/28 21:02:35	1.69
@@ -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::loncommon();
 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 @@ sub handler {
       &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 @@ sub handler {
                                {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 @@ sub handler {
                                {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 @@ sub process_changes {
         $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 @@ sub print_config_box {
               <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 @@ sub print_config_box {
            <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 @@ sub print_config_box {
         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 @@ sub print_config_box {
             $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 @@ sub print_contacts {
     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 @@ sub print_contacts {
                       '<input type="text" name="'.$type.'_others" '.
                       'value="'.$otheremails{$type}.'"  />'.
                       '</td></tr>'."\n";
-        $rownum ++;
     }
     $$rowtotal += $rownum;
     return $datatable;
@@ -1509,7 +1536,7 @@ sub print_contacts {
 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 @@ sub print_coursecategories {
     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);
@@ -4617,6 +4696,132 @@ sub modify_coursecategories {
     }
     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) = @_;