Diff for /loncom/interface/domainprefs.pm between versions 1.393 and 1.394

version 1.393, 2021/11/28 18:43:37 version 1.394, 2021/11/28 19:17:59
Line 221  sub handler { Line 221  sub handler {
                 'coursedefaults','usersessions','loadbalancing',                  'coursedefaults','usersessions','loadbalancing',
                 'requestauthor','selfenrollment','inststatus',                  'requestauthor','selfenrollment','inststatus',
                 'ltitools','ssl','trust','lti','privacy','passwords',                  'ltitools','ssl','trust','lti','privacy','passwords',
                 'proctoring','wafproxy'],$dom);                  'proctoring','wafproxy','ipaccess'],$dom);
     my %encconfig =      my %encconfig =
         &Apache::lonnet::get_dom('encconfig',['ltitools','lti','proctoring'],$dom,undef,1);          &Apache::lonnet::get_dom('encconfig',['ltitools','lti','proctoring'],$dom,undef,1);
     if (ref($domconfig{'ltitools'}) eq 'HASH') {      if (ref($domconfig{'ltitools'}) eq 'HASH') {
Line 260  sub handler { Line 260  sub handler {
             }              }
         }          }
     }      }
     my @prefs_order = ('rolecolors','login','defaults','wafproxy','passwords','quotas',      my @prefs_order = ('rolecolors','login','ipaccess','defaults','wafproxy','passwords',
                        'autoenroll','autoupdate','autocreate','directorysrch',                         'quotas','autoenroll','autoupdate','autocreate','directorysrch',
                        'contacts','privacy','usercreation','selfcreation',                         'contacts','privacy','usercreation','selfcreation',
                        'usermodification','scantron','requestcourses','requestauthor',                         'usermodification','scantron','requestcourses','requestauthor',
                        'coursecategories','serverstatuses','helpsettings','coursedefaults',                         'coursecategories','serverstatuses','helpsettings','coursedefaults',
Line 624  sub handler { Line 624  sub handler {
                   print => \&print_lti,                    print => \&print_lti,
                   modify => \&modify_lti,                    modify => \&modify_lti,
                  },                   },
              'ipaccess' =>
                          {text => 'IP-based access control',
                           help => 'Domain_Configuration_IP_Access',
                           header => [{col1 => 'Setting',
                                       col2 => 'Value'},],
                           print  => \&print_ipaccess,
                           modify => \&modify_ipaccess,
                          },
     );      );
     if (keys(%servers) > 1) {      if (keys(%servers) > 1) {
         $prefs{'login'}  = { text   => 'Log-in page options',          $prefs{'login'}  = { text   => 'Log-in page options',
Line 679  $javascript_validations Line 687  $javascript_validations
 </script>  </script>
 $coursebrowserjs  $coursebrowserjs
 END  END
           } elsif (grep(/^ipaccess$/,@actions)) {
               $js .= &Apache::loncommon::coursebrowser_javascript($env{'request.role.domain'});
         }          }
         if (grep(/^selfcreation$/,@actions)) {          if (grep(/^selfcreation$/,@actions)) {
             $js .= &selfcreate_javascript();              $js .= &selfcreate_javascript();
Line 825  sub process_changes { Line 835  sub process_changes {
         $output = &modify_passwords($r,$dom,$confname,$lastactref,%domconfig);          $output = &modify_passwords($r,$dom,$confname,$lastactref,%domconfig);
     } elsif ($action eq 'wafproxy') {      } elsif ($action eq 'wafproxy') {
         $output = &modify_wafproxy($dom,$action,$lastactref,%domconfig);          $output = &modify_wafproxy($dom,$action,$lastactref,%domconfig);
       } elsif ($action eq 'ipaccess') {
           $output = &modify_ipaccess($dom,$lastactref,%domconfig);
     }      }
     return $output;      return $output;
 }  }
Line 867  sub print_config_box { Line 879  sub print_config_box {
         $output .= &autoupdate_javascript();          $output .= &autoupdate_javascript();
     } elsif ($action eq 'login') {      } elsif ($action eq 'login') {
         $output .= &saml_javascript();          $output .= &saml_javascript();
       } elsif ($action eq 'ipaccess') {
           $output .= &ipaccess_javascript($settings);
     }      }
     $output .=      $output .=
          '<table class="LC_nested_outer">           '<table class="LC_nested_outer">
Line 1235  sub print_config_box { Line 1249  sub print_config_box {
         } elsif (($action eq 'autoenroll') || ($action eq 'autocreate') ||           } elsif (($action eq 'autoenroll') || ($action eq 'autocreate') || 
                  ($action eq 'serverstatuses') || ($action eq 'loadbalancing') ||                    ($action eq 'serverstatuses') || ($action eq 'loadbalancing') || 
                  ($action eq 'ltitools') || ($action eq 'lti') ||                   ($action eq 'ltitools') || ($action eq 'lti') ||
                  ($action eq 'proctoring')) {                   ($action eq 'proctoring') || ($action eq 'ipaccess')) {
             $output .= $item->{'print'}->($dom,$settings,\$rowtotal);              $output .= $item->{'print'}->($dom,$settings,\$rowtotal);
         }          }
     }      }
Line 1707  sub login_file_options { Line 1721  sub login_file_options {
       );        );
 }  }
   
   sub print_ipaccess {
       my ($dom,$settings,$rowtotal) = @_;
       my $css_class;
       my $itemcount = 0;
       my $datatable;
       my %ordered;
       if (ref($settings) eq 'HASH') {
           foreach my $item (keys(%{$settings})) {
               if (ref($settings->{$item}) eq 'HASH') {
                   my $num = $settings->{$item}{'order'};
                   if ($num eq '') {
                       $num = scalar(keys(%{$settings}));
                   }
                   $ordered{$num} = $item;
               }
           }
       }
       my $maxnum = scalar(keys(%ordered));
       if (keys(%ordered)) {
           my @items = sort { $a <=> $b } keys(%ordered);
           for (my $i=0; $i<@items; $i++) {
               $css_class = $itemcount%2?' class="LC_odd_row"':'';
               my $item = $ordered{$items[$i]};
               my ($name,$ipranges,%commblocks,%courses);
               if (ref($settings->{$item}) eq 'HASH') {
                   $name = $settings->{$item}->{'name'};
                   $ipranges = $settings->{$item}->{'ip'};
                   if (ref($settings->{$item}->{'commblocks'}) eq 'HASH') {
                       %commblocks = %{$settings->{$item}->{'commblocks'}};
                   }
                   if (ref($settings->{$item}->{'courses'}) eq 'HASH') {
                       %courses = %{$settings->{$item}->{'courses'}};
                   }
               }
               my $chgstr = ' onchange="javascript:reorderIPaccess(this.form,'."'ipaccess_pos_".$item."'".');"';
               $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'
                            .'<select name="ipaccess_pos_'.$item.'"'.$chgstr.'>';
               for (my $k=0; $k<=$maxnum; $k++) {
                   my $vpos = $k+1;
                   my $selstr;
                   if ($k == $i) {
                       $selstr = ' selected="selected" ';
                   }
                   $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
               }
               $datatable .= '</select>'.('&nbsp;'x2).
                   '<label><input type="checkbox" name="ipaccess_del" value="'.$item.'" />'.
                   &mt('Delete?').'</label></span></td>'.
                   '<td colspan="2"><input type="hidden" name="ipaccess_id_'.$i.'" value="'.$item.'" />'.
                   &ipaccess_options($i,$itemcount,$dom,$name,$ipranges,\%commblocks,\%courses).
                   '</td></tr>';
               $itemcount ++;
           }
       }
       $css_class = $itemcount%2?' class="LC_odd_row"':'';
       my $chgstr = ' onchange="javascript:reorderIPaccess(this.form,'."'ipaccess_pos_add'".');"';
       $datatable .= '<tr '.$css_class.'><td><span class="LC_nobreak">'."\n".
                     '<input type="hidden" name="ipaccess_maxnum" value="'.$maxnum.'" />'."\n".
                     '<select name="ipaccess_pos_add"'.$chgstr.'>';
       for (my $k=0; $k<$maxnum+1; $k++) {
           my $vpos = $k+1;
           my $selstr;
           if ($k == $maxnum) {
               $selstr = ' selected="selected" ';
           }
           $datatable .= '<option value="'.$k.'"'.$selstr.'>'.$vpos.'</option>';
       }
       $datatable .= '</select>&nbsp;'."\n".
                     '<input type="checkbox" name="ipaccess_add" value="1" />'.&mt('Add').'</span></td>'."\n".
                     '<td colspan="2">'.
                     &ipaccess_options('add',$itemcount,$dom).
                     '</td>'."\n".
                     '</tr>'."\n";
       $$rowtotal ++;
       return $datatable;
   }
   
   sub ipaccess_options {
       my ($num,$itemcount,$dom,$name,$ipranges,$blocksref,$coursesref) = @_;
       my (%currblocks,%currcourses,$output);
       if (ref($blocksref) eq 'HASH') {
           %currblocks = %{$blocksref};
       }
       if (ref($coursesref) eq 'HASH') {
           %currcourses = %{$coursesref};
       }
       $output = '<fieldset><legend>'.&mt('Location(s)').'</legend>'.
                 '<span class="LC_nobreak">'.&mt('Name').':&nbsp;'.
                 '<input type="text" name="ipaccess_name_'.$num.'" value="'.$name.'" />'.
                 '</span></fieldset>'.
                 '<fieldset><legend>'.&mt('IP Range(s)').'</legend>'.
                 &mt('Format for each IP range').': '.&mt('A.B.C.D/N or A.B.C.D-E.F.G.H').'<br />'.
                 &mt('Range(s) will be stored as IP netblock(s) in CIDR notation (comma separated)').'<br />'.
                 '<textarea name="ipaccess_range_'.$num.'" rows="3" cols="80">'.
                 $ipranges.'</textarea></fieldset>'.
                 '<fieldset><legend>'.&mt('Functionality Blocked?').'</legend>'.
                 &blocker_checkboxes($num,$blocksref).'</fieldset>'.
                 '<fieldset><legend>'.&mt('Courses/Communities allowed').'</legend>'.
                 '<table>';
       foreach my $cid (sort(keys(%currcourses))) {
           my %courseinfo = &Apache::lonnet::coursedescription($cid,{'one_time' => 1});
           $output .= '<tr><td><span class="LC_nobreak">'.
                      '<label><input type="checkbox" name="ipaccess_course_delete_'.$num.'" value="'.$cid.'" />'.
                      &mt('Delete?').'&nbsp;<span class="LC_cusr_emph">'.$courseinfo{'description'}.'</span></label></span>'.
                      ' <span class="LC_fontsize_medium">('.$cid.')</span></td></tr>';
       }
       $output .= '<tr><td><span class="LC_nobreak">'.&mt('Add').':&nbsp;'.
                  '<input type="text" name="ipaccess_cdesc_'.$num.'" value="" onfocus="this.blur();opencrsbrowser('."'display','ipaccess_cnum_$num','ipaccess_cdom_$num','ipaccess_cdesc_$num'".');" />'.
                   &Apache::loncommon::selectcourse_link('display','ipaccess_cnum_'.$num,'ipaccess_cdom_'.$num,'ipaccess_cdesc_'.$num,$dom,undef,'Course/Community').
                  '<input type="hidden" name="ipaccess_cnum_'.$num.'" value="" />'.
                  '<input type="hidden" name="ipaccess_cdom_'.$num.'" value="" />'.
                  '</span></td></tr></table>'."\n".
                  '</fieldset>';
       return $output;
   }
   
   sub blocker_checkboxes {
       my ($num,$blocks) = @_;
       my ($typeorder,$types) = &commblocktype_text();
       my $numinrow = 6;
       my $output = '<table>';
       for (my $i=0; $i<@{$typeorder}; $i++) {
           my $block = $typeorder->[$i];
           my $blockstatus;
           if (ref($blocks) eq 'HASH') {
               if ($blocks->{$block} eq 'on') {
                   $blockstatus = 'checked="checked"';
               }
           }
           my $rem = $i%($numinrow);
           if ($rem == 0) {
               if ($i > 0) {
                   $output .= '</tr>';
               }
               $output .= '<tr>';
           }
           if ($i == scalar(@{$typeorder})-1) {
               my $colsleft = $numinrow-$rem;
               if ($colsleft > 1) {
                   $output .= '<td colspan="'.$colsleft.'">';
               } else {
                   $output .= '<td>';
               }
           } else {
               $output .= '<td>';
           }
           my $item = 'ipaccess_block_'.$num;
           if ($blockstatus) {
               $blockstatus = ' '.$blockstatus;
           }
           $output .= '<span class="LC_nobreak"><label>'."\n".
                      '<input type="checkbox" name="'.$item.'"'.
                      $blockstatus.' value="'.$block.'"'.' />'.
                      $types->{$block}.'</label></span>'."\n".
                      '<br /></td>';
       }
       $output .= '</tr></table>';
       return $output;
   }
   
   sub commblocktype_text {
       my %types = &Apache::lonlocal::texthash(
           'com' => 'Messaging',
           'chat' => 'Chat Room',
           'boards' => 'Discussion',
           'port' => 'Portfolio',
           'groups' => 'Groups',
           'blogs' => 'Blogs',
           'about' => 'User Information',
           'printout' => 'Printouts',
           'passwd' => 'Change Password',
           'grades' => 'Gradebook',
       );
       my $typeorder = ['com','chat','boards','port','groups','blogs','about','printout','grades','passwd'];
       return ($typeorder,\%types);
   }
   
 sub print_rolecolors {  sub print_rolecolors {
     my ($phase,$role,$dom,$confname,$settings,$rowtotal) = @_;      my ($phase,$role,$dom,$confname,$settings,$rowtotal) = @_;
     my %choices = &color_font_choices();      my %choices = &color_font_choices();
Line 3536  function toggleSamlOptions(form,hostid) Line 3727  function toggleSamlOptions(form,hostid)
 ENDSCRIPT  ENDSCRIPT
 }  }
   
   sub ipaccess_javascript {
       my ($settings) = @_;
       my (%ordered,$total,%jstext);
       $total = 0;
       if (ref($settings) eq 'HASH') {
           foreach my $item (keys(%{$settings})) {
               if (ref($settings->{$item}) eq 'HASH') {
                   my $num = $settings->{$item}{'order'};
                   $ordered{$num} = $item;
               }
           }
           $total = scalar(keys(%{$settings}));
       }
       my @jsarray = ();
       foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
           push(@jsarray,$ordered{$item});
       }
       my $jstext = '    var ipaccess = Array('."'".join("','",@jsarray)."'".');'."\n";
       return <<"ENDSCRIPT";
   <script type="text/javascript">
   // <![CDATA[
   function reorderIPaccess(form,item) {
       var changedVal;
   $jstext
       var newpos = 'ipaccess_pos_add';
       var maxh = 1 + $total;
       var current = new Array;
       var newitemVal = form.elements[newpos].options[form.elements[newpos].selectedIndex].value;
       if (item == newpos) {
           changedVal = newitemVal;
       } else {
           changedVal = form.elements[item].options[form.elements[item].selectedIndex].value;
           current[newitemVal] = newpos;
       }
       for (var i=0; i<ipaccess.length; i++) {
           var elementName = 'ipaccess_pos_'+ipaccess[i];
           if (elementName != item) {
               if (form.elements[elementName]) {
                   var currVal = form.elements[elementName].options[form.elements[elementName].selectedIndex].value;
                   current[currVal] = elementName;
               }
           }
       }
       var oldVal;
       for (var j=0; j<maxh; j++) {
           if (current[j] == undefined) {
               oldVal = j;
           }
       }
       if (oldVal < changedVal) {
           for (var k=oldVal+1; k<=changedVal ; k++) {
              var elementName = current[k];
              form.elements[elementName].selectedIndex = form.elements[elementName].selectedIndex - 1;
           }
       } else {
           for (var k=changedVal; k<oldVal; k++) {
               var elementName = current[k];
               form.elements[elementName].selectedIndex = form.elements[elementName].selectedIndex + 1;
           }
       }
       return;
   }
   // ]]>
   </script>
   
   ENDSCRIPT
   }
   
 sub print_autoenroll {  sub print_autoenroll {
     my ($dom,$settings,$rowtotal) = @_;      my ($dom,$settings,$rowtotal) = @_;
     my $autorun = &Apache::lonnet::auto_run(undef,$dom),      my $autorun = &Apache::lonnet::auto_run(undef,$dom),
Line 12144  sub color_font_choices { Line 12403  sub color_font_choices {
     return %choices;      return %choices;
 }  }
   
   sub modify_ipaccess {
       my ($dom,$lastactref,%domconfig) = @_;
       my (@allpos,%changes,%confhash,$errors,$resulttext);
       my (@items,%deletions,%itemids,@warnings);
       my ($typeorder,$types) = &commblocktype_text();
       if ($env{'form.ipaccess_add'}) {
           my $name = $env{'form.ipaccess_name_add'};
           my ($newid,$error) = &get_ipaccess_id($dom,$name);
           if ($newid) {
               $itemids{'add'} = $newid;
               push(@items,'add');
               $changes{$newid} = 1;
           } else {
               $error = &mt('Failed to acquire unique ID for new IP access control item');
               $errors .= '<li><span class="LC_error">'.$error.'</span></li>';
           }
       }
       if (ref($domconfig{'ipaccess'}) eq 'HASH') {
           my @todelete = &Apache::loncommon::get_env_multiple('form.ipaccess_del');
           if (@todelete) {
               map { $deletions{$_} = 1; } @todelete;
           }
           my $maxnum = $env{'form.ipaccess_maxnum'};
           for (my $i=0; $i<$maxnum; $i++) {
               my $itemid = $env{'form.ipaccess_id_'.$i};
               $itemid =~ s/\D+//g;
               if (ref($domconfig{'ipaccess'}{$itemid}) eq 'HASH') {
                   if ($deletions{$itemid}) {
                       $changes{$itemid} = $domconfig{'ipaccess'}{$itemid}{'name'};
                   } else {
                       push(@items,$i);
                       $itemids{$i} = $itemid;
                   }
               }
           }
       }
       foreach my $idx (@items) {
           my $itemid = $itemids{$idx};
           next unless ($itemid);
           my %current;
           unless ($idx eq 'add') {
               if (ref($domconfig{'ipaccess'}{$itemid}) eq 'HASH') {
                   %current = %{$domconfig{'ipaccess'}{$itemid}};
               }
           }
           my $position = $env{'form.ipaccess_pos_'.$itemid};
           $position =~ s/\D+//g;
           if ($position ne '') {
               $allpos[$position] = $itemid;
           }
           my $name = $env{'form.ipaccess_name_'.$idx};
           $name =~ s/^\s+|\s+$//g;
           $confhash{$itemid}{'name'} = $name;
           my $possrange = $env{'form.ipaccess_range_'.$idx};
           $possrange =~ s/^\s+|\s+$//g;
           unless ($possrange eq '') {
               $possrange =~ s/[\r\n]+/\s/g;
               $possrange =~ s/\s*-\s*/-/g;
               $possrange =~ s/\s+/,/g;
               $possrange =~ s/,+/,/g;
               if ($possrange ne '') {
                   my (@ok,$count);
                   $count = 0; 
                   foreach my $poss (split(/\,/,$possrange)) {
                       $count ++;
                       $poss = &validate_ip_pattern($poss);
                       if ($poss ne '') {
                           push(@ok,$poss);
                       }
                   }
                   my $diff = $count - scalar(@ok);
                   if ($diff) {
                       $errors .= '<li><span class="LC_error">'.
                                  &mt('[quant,_1,IP] invalid and excluded from saved value for IP range(s) for [_2]',
                                      $diff,$name).
                                  '</span></li>';
                   }
                   if (@ok) {
                       my @cidr_list;
                       foreach my $item (@ok) {
                           @cidr_list = &Net::CIDR::cidradd($item,@cidr_list);
                       }
                       $confhash{$itemid}{'ip'} = join(',',@cidr_list);
                   }
               }
           }
           foreach my $field ('name','ip') {
               unless (($idx eq 'add') || ($changes{$itemid})) {
                   if ($current{$field} ne $confhash{$itemid}{$field}) {
                       $changes{$itemid} = 1;
                       last;
                   }
               }
           }
           $confhash{$itemid}{'commblocks'} = {};
            
           my %commblocks;
           map { $commblocks{$_} = 1; } &Apache::loncommon::get_env_multiple('form.ipaccess_block_'.$idx);  
           foreach my $type (@{$typeorder}) {
               if ($commblocks{$type}) {
                   $confhash{$itemid}{'commblocks'}{$type} = 'on';
               }
               unless (($idx eq 'add') || ($changes{$itemid})) {
                   if (ref($current{'commblocks'}) eq 'HASH') {
                       if ($confhash{$itemid}{'commblocks'}{$type} ne $current{'commblocks'}{$type}) {
                           $changes{$itemid} = 1;
                       }
                   } elsif ($confhash{$itemid}{'commblocks'}{$type}) {
                       $changes{$itemid} = 1;
                   }
               }
           }
           $confhash{$itemid}{'courses'} = {};
           my %crsdeletions;
           my @delcrs = &Apache::loncommon::get_env_multiple('form.ipaccess_course_delete_'.$idx);
           if (@delcrs) {
               map { $crsdeletions{$_} = 1; } @delcrs;
           }
           if (ref($current{'courses'}) eq 'HASH') {
               foreach my $cid (sort(keys(%{$current{'courses'}}))) {
                   if ($crsdeletions{$cid}) {
                       $changes{$itemid} = 1;
                   } else {
                       $confhash{$itemid}{'courses'}{$cid} = 1;
                   }
               }
           }
           $env{'form.ipaccess_cnum_'.$idx} =~ s/^\s+|\s+$//g;
           $env{'form.ipaccess_cdom_'.$idx} =~ s/^\s+|\s+$//g;
           if (($env{'form.ipaccess_cnum_'.$idx} =~ /^$match_courseid$/) && 
               ($env{'form.ipaccess_cdom_'.$idx} =~ /^$match_domain$/)) {
               if (&Apache::lonnet::homeserver($env{'form.ipaccess_cnum_'.$idx},
                                               $env{'form.ipaccess_cdom_'.$idx}) eq 'no_host') {
                   $errors .= '<li><span class="LC_error">'.
                              &mt('Invalid courseID [_1] omitted from list of allowed courses',
                                  $env{'form.ipaccess_cdom_'.$idx}.'_'.$env{'form.ipaccess_cnum_'.$idx}).
                              '</span></li>';
               } else {
                   $confhash{$itemid}{'courses'}{$env{'form.ipaccess_cdom_'.$idx}.'_'.$env{'form.ipaccess_cnum_'.$idx}} = 1;
                   $changes{$itemid} = 1;
               }
           }
       }
       if (@allpos > 0) {
           my $idx = 0;
           foreach my $itemid (@allpos) {
               if ($itemid ne '') {
                   $confhash{$itemid}{'order'} = $idx;
                   unless ($changes{$itemid}) {
                       if (ref($domconfig{'ipaccess'}) eq 'HASH') {
                           if (ref($domconfig{'ipaccess'}{$itemid}) eq 'HASH') {
                               if ($domconfig{'ipaccess'}{$itemid}{'order'} ne $idx) {
                                   $changes{$itemid} = 1;
                               }
                           }
                       }
                   }
                   $idx ++;
               }
           }
       }
       if (keys(%changes)) {
           my %defaultshash = (
                                 ipaccess => \%confhash,
                              );
           my $putresult = &Apache::lonnet::put_dom('configuration',\%defaultshash,
                                                    $dom);
           if ($putresult eq 'ok') {
               my $cachetime = 1800;
               &Apache::lonnet::do_cache_new('ipaccess',$dom,\%confhash,$cachetime);
               if (ref($lastactref) eq 'HASH') {
                   $lastactref->{'ipaccess'} = 1;
               }
               $resulttext = &mt('Changes made:').'<ul>';
               my %bynum;
               foreach my $itemid (sort(keys(%changes))) {
                   if (ref($confhash{$itemid}) eq 'HASH') {
                       my $position = $confhash{$itemid}{'order'};
                       if ($position =~ /^\d+$/) {
                           $bynum{$position} = $itemid;
                       }
                   }
               }
               if (keys(%deletions)) {
                   foreach my $itemid (sort { $a <=> $b } keys(%deletions)) {
                       $resulttext .= '<li>'.&mt('Deleted: [_1]',$changes{$itemid}).'</li>';
                   }
               }
               foreach my $pos (sort { $a <=> $b } keys(%bynum)) {
                   my $itemid = $bynum{$pos};
                   if (ref($confhash{$itemid}) eq 'HASH') {
                       $resulttext .= '<li><b>'.$confhash{$itemid}{'name'}.'</b><ul>';
                       my $position = $pos + 1;
                       $resulttext .= '<li>'.&mt('Order: [_1]',$position).'</li>';
                       if ($confhash{$itemid}{'ip'} eq '') {
                           $resulttext .= '<li>'.&mt('No IP Range(s) set').'</li>';
                       } else {
                           $resulttext .= '<li>'.&mt('IP Range(s): [_1]',$confhash{$itemid}{'ip'}).'</li>';
                       }
                       if (keys(%{$confhash{$itemid}{'commblocks'}})) {
                           $resulttext .= '<li>'.&mt('Functionality Blocked: [_1]',
                                                     join(', ', map { $types->{$_}; } sort(keys(%{$confhash{$itemid}{'commblocks'}})))).
                                          '</li>';
                       } else {
                           $resulttext .= '<li>'.&mt('No functionality blocked').'</li>';
                       }
                       if (keys(%{$confhash{$itemid}{'courses'}})) {
                           my @courses;
                           foreach my $cid (sort(keys(%{$confhash{$itemid}{'courses'}}))) {
                               my %courseinfo = &Apache::lonnet::coursedescription($cid,{'one_time' => 1}); 
                               push(@courses,$courseinfo{'description'}.' ('.$cid.')');
                           }
                           $resulttext .= '<li>'.&mt('Courses/Communities allowed').':<ul><li>'.
                                                join('</li><li>',@courses).'</li></ul>';
                       } else {
                           $resulttext .= '<li>'.&mt('No courses allowed').'</li>';
                       }
                   }
               }
           } else {
               $errors .= '<li><span class="LC_error">'.&mt('Failed to save changes').'</span></li>';
           }
       } else {
           $resulttext = &mt('No changes made');
       }
       if ($errors) {
           $resulttext .= '<p>'.&mt('The following errors occurred: ').'<ul>'.
                          $errors.'</ul></p>';
       }
       return $resulttext;
   }
   
   sub get_ipaccess_id {
       my ($domain,$location) = @_;
       # get lock on ipaccess db
       my $lockhash = {
                         lock => $env{'user.name'}.
                                 ':'.$env{'user.domain'},
                      };
       my $tries = 0;
       my $gotlock = &Apache::lonnet::newput_dom('ipaccess',$lockhash,$domain);
       my ($id,$error);
   
       while (($gotlock ne 'ok') && ($tries<10)) {
           $tries ++;
           sleep (0.1);
           $gotlock = &Apache::lonnet::newput_dom('ipaccess',$lockhash,$domain);
       }
       if ($gotlock eq 'ok') {
           my %currids = &Apache::lonnet::dump_dom('ipaccess',$domain);
           if ($currids{'lock'}) {
               delete($currids{'lock'});
               if (keys(%currids)) {
                   my @curr = sort { $a <=> $b } keys(%currids);
                   if ($curr[-1] =~ /^\d+$/) {
                       $id = 1 + $curr[-1];
                   }
               } else {
                   $id = 1;
               }
               if ($id) {
                   unless (&Apache::lonnet::newput_dom('ipaccess',{ $id => $location },$domain) eq 'ok') {
                       $error = 'nostore';
                   }
               } else {
                   $error = 'nonumber';
               }
           }
           my $dellockoutcome = &Apache::lonnet::del_dom('ipaccess',['lock'],$domain);
       } else {
           $error = 'nolock';
       }
       return ($id,$error);
   }
   
 sub modify_rolecolors {  sub modify_rolecolors {
     my ($r,$dom,$confname,$roles,$lastactref,%domconfig) = @_;      my ($r,$dom,$confname,$roles,$lastactref,%domconfig) = @_;
     my ($resulttext,%rolehash);      my ($resulttext,%rolehash);
Line 22458  sub devalidate_remote_domconfs { Line 22992  sub devalidate_remote_domconfs {
     my %thismachine;      my %thismachine;
     map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();      map { $thismachine{$_} = 1; } &Apache::lonnet::current_machine_ids();
     my @posscached = ('domainconfig','domdefaults','ltitools','usersessions',      my @posscached = ('domainconfig','domdefaults','ltitools','usersessions',
                       'directorysrch','passwdconf','cats','proxyalias','proxysaml');                        'directorysrch','passwdconf','cats','proxyalias','proxysaml',
                         'ipaccess');
     my %cache_by_lonhost;      my %cache_by_lonhost;
     if (exists($cachekeys->{'samllanding'})) {      if (exists($cachekeys->{'samllanding'})) {
         if (ref($cachekeys->{'samllanding'}) eq 'HASH') {          if (ref($cachekeys->{'samllanding'}) eq 'HASH') {

Removed from v.1.393  
changed lines
  Added in v.1.394


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>