VPF::Apache::Admin::Config - Форум программистов

gcc

Дата 8.9.2008, 05:31 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

нашел мод для работы с файлами конфигов просмотра, редактирование и добавление директив

http://search.cpan.org/~rsoliv/Apache-Admi...ig.pm#set_value

но вот это ткод не выполняеться:

Код


#!/usr/bin/perl
  use Apache::Admin::Config;
   # Parse an apache configuration file
  my $conf = new Apache::Admin::Config "/usr/local/etc/apache22.conf";
  my $vhost;
  foreach my $vh (@{$conf->section('VirtualHost')})
  {
      if($vh->directive('ServerName')->value eq 'xxx.com')
      {
          $vhost = $vh;
          last;
      }
  }
    print $vhost;

Код


Not an ARRAY reference at ./ac.pl line 6.

как исправить?

вот это работает:

Код



     use Apache::Admin::Config;

    # Parse an apache configuration file

  my $conf = new Apache::Admin::Config "/usr/local/etc/apache22.conf";


  # adding a new virtual-host:
  my $vhost = $conf->add_section(VirtualHost=>'127.0.0.1');
  $vhost->add_directive(ServerAdmin=>'[email protected]');
  $vhost->add_directive(DocumentRoot=>'/usr/share/www');
  $vhost->add_directive(ServerName=>'www.localhost.localdomain');
  $vhost->add_directive(ErrorLog=>'/var/log/apache/www-error.log');
  my $location = $vhost->add_section(Location=>'/admin');
  $location->add_directive(AuthType=>'basic');
  $location->add_directive(Require=>'group admin');
  $conf->save;

Это сообщение отредактировал(а) gcc - 8.9.2008, 05:57

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 8.9.2008, 09:32 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

Цитата(gcc @ 8.9.2008, 05:31

)

Not an ARRAY reference at ./ac.pl line 6.

как исправить?

вот так:

Код


foreach my $vh ($conf->section('VirtualHost')) {
   ....
}

У вас метод section возвращает уже готовый список, а не ARRAYREF.

--------------------

gcc

Дата 9.9.2008, 00:08 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Код


У вас метод section возвращает уже готовый список

не хочет он возвращать никакой список

Код

:80

работает, но он не возвращает список директив:

Код


    # print the directive list

    foreach($conf->directive())
    {
        print $_->name, "\n";
    }

если я хочу значение одной директивы заменить, в этом модуле не реализуемо это?

в примере написано, что он должен возваратить список, так как я писал в первом посте, но не работает, почему-то (зачем тогда так было написано в документации модуля?)

тоесть мне нужно возвратить директивы, но это не работает...

модуль не правильно сделан, или я не так делаю... smile

исходними модуля наверное надо проанализировать... то что автор модуля имел ввиду (но не работает)

или самому парсер нормальный сделать... smile

Это сообщение отредактировал(а) gcc - 9.9.2008, 01:04

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 9.9.2008, 02:04 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

наверное я плохо знаю мощность языка программирования perl

можите подсказать как заменить некоторые значение директив и как список всех директив возвратить?

(если бы сделать на php, то там наверное надо просто было перезаписать весь файл с новой директивой...)

Это сообщение отредактировал(а) gcc - 9.9.2008, 03:37

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 9.9.2008, 10:49 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

gcc, при чем тут perl ?
вам нужно очень внимательно изучить документацию по модулю, а не только синопсис просмотреть.
если документация прочитана, что то сделано по документации и все равно не работает - совет:
посмотрите и исходники и ТЕСТЫ к модулю, документация могла устареть.

P.S. set_value позволяет менять значение директивы

--------------------

gcc

Дата 9.9.2008, 15:29 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

вот есть set_write_directive

Код


  $conf->set_write_directive($code);

а что такое $code это ссылка на анонимную подпрограмму или на метод?

не могу понять как передать значения сюда:

Код


  $conf->set_write_directive(sub
  {
      my($self, $name, $value) = @_;
      return $self->indent . "$name $value\n";
  }

никогда такого не видел, в книжке нету... smile

Это сообщение отредактировал(а) gcc - 9.9.2008, 15:34

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 9.9.2008, 15:50 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

почитали доку на CPAN ?
set_write_directive позволяет вам подменить функцию вывода директив.
Ну если вам не нравится как работает стандартная.

set_value попробуйте. Она позволяет изменить занчение существующей директивы

Это сообщение отредактировал(а) sir_nuf_nuf - 9.9.2008, 15:51

--------------------

gcc

Дата 9.9.2008, 15:56 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Цитата(sir_nuf_nuf @ 9.9.2008, 15:50)

почитали доку на CPAN ?

конечно прочитал, там идет сложная стратура методов и объектов

а как выбрать параметр, тоесть директиву, чтобы изменить ее значение

Код


    $obj->set_value($newvalue)

значение чего мы будет менять?
не понял, сори smile

Это сообщение отредактировал(а) gcc - 9.9.2008, 15:59

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 9.9.2008, 16:30 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Сори, сделал!!

я не посомтрел на то как модуль пострен из самого начала...

Это сообщение отредактировал(а) gcc - 11.9.2008, 07:13

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 11.9.2008, 21:29 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Код

ErrorDocument 403 http://
ErrorDocument 404 http://

как сделать если есть такое?

Код

print $vh->directive('ErrorDocument 403');

так не работает, это из-за регулярного выражение? не могу найти его... с помощю вот этого

Код

$conf->set_write_directive(sub{});

можно как-то переопределить?

Это сообщение отредактировал(а) gcc - 11.9.2008, 21:35

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 12.9.2008, 00:10 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

gcc, перепишите вопрос.. ну мы же не экстрасенсы =) ничего не ясно.
скажите словами(без цитат) что вы хотите ?

--------------------

gcc

Дата 12.9.2008, 00:19 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

вывести это значние от этого параметра "ErrorDocument 403" (с пробелом)

щас попробу еще раз пересмотреть модуль, но там проверка идеи только на value... другую я не нашел...

Это сообщение отредактировал(а) gcc - 12.9.2008, 00:21

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 12.9.2008, 00:26 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

куда вывести ? просто напечатать ?
давайте по шагам.
$vh; # какой-то объект (узел конфигурации надо полагать)
@drtvs = $vh->directive('aaa'); # возвращает МАССИВ объектов представляющих собой директивы
my $drtv = pop @drtvs # одна из директив. Объект
$drtv->value() #значение директивы. его вам надо вывести

--------------------

gcc

Дата 12.9.2008, 03:50 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Цитата(sir_nuf_nuf @ 12.9.2008, 00:26)

@drtvs = $vh->directive('aaa'); # возвращает

да работает, все...

но не возвращает вот это

Код


             print $vh->directive('ErrorDocument 403');

тоесть с пробелом параметр не возвращает, не удаляет и не изменяет
пишет ошибку:

Код


Can't call method "delete" on an undefined value at ./a.pl line 41.

это где регулярное выражение запрещает пробел ставить?

если так по возвращает и работает!

Код


             print $vh->directive('ErrorDocument');

Это сообщение отредактировал(а) gcc - 12.9.2008, 03:51

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 13.9.2008, 10:00 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Цитата(sir_nuf_nuf @ 12.9.2008, 00:26)

my $drtv = pop @drtvs # одна из директив. Объект
$drtv->value() #значение директивы. его вам надо вывести

это понятно, оно выведит что-то все равно по любому (массив)

я имелл виду как использовать это с пробелом, а как теперь перезаписать нормально значение парамтера ErrorDocument 403 ?

я нашел вариант удалить все ErrorDocument и записать их заново, но а есть смысл этого модуля вообще, не легче файл (кажого виртуального хоста) удалить и перезаписать его с новой директивой?

или есть смысл использовать этот модуль? smile

Код


print $drtv->value();

Код


Can't call method "value" on an undefined

Код


 print  @drtvs[0]; # работает

Это сообщение отредактировал(а) gcc - 13.9.2008, 10:13

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

sir_nuf_nuf

Дата 13.9.2008, 11:25 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 920
Регистрация: 6.1.2008

Репутация: 14
Всего: 31

может деректива называется не так как ты ожидаешь ?
ну не пиши 403 в названии - получи директивы так:

Код


$vh->directive('ErrorDocument');

а потом Data::Dumper посмотри че у них внутри и как добраться до числа 403.

Код


use Data::Dumper;
print Dumper([$vh->directive('ErrorDocument')]);

--------------------

gcc

Дата 13.9.2008, 11:40 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

не много сделал, времени не хватило делать, не доделал - доделаю, на страницу сразу может вывести очень много информации, правильно ли делать если шаблон в хєш и вывести его отдельно от кода логики?

тот модуль apache::admin::config с ООП не понял как правильно и лучше сделать решил просто отдельно... (реально тот модуль переделать чтобы html прикрутить или это не нужно?)

Код


 use Apache::Admin::Config;
   my $conf = new Apache::Admin::Config 'hhh.conf', 
      or die $Apache::Admin::Config::ERROR;
     my $vhost;
     my $templ_value;
       my ($serveradmin, $serveralis, $costomlog, $errorlog, @drtvs4 );
     foreach my $vh ($conf->section('VirtualHost'))    {
           if($vh->directive('ServerName')->value eq 'hhh.org')   {
        
           $serveradmin=$vh->directive('ServerAdmin');
           $serveralis=$vh->directive('ServerAlias');
           $costomlog=$vh->directive('CustomLog');
           $errorlog=$vh->directive('ErrorLog');
           @drtvs4 = $vh->directive('ErrorDocument');

           }
           } 
           
       
         my $template = HTML::Template->new(filename => $dir.'tempele-apache22-aid.html' ,die_on_bad_params => '0');
         
             my $url = $query ->url(-relative => 1);
             
             $template->param(URL => $url);
             #$aid
             $template->param(AID => $aid);
         
            # $url = $query ->url(-relative => 1);
             
            # $template->param(URL => $url);
             #$aid
            # $template->param(AID => $aid);
            ##########################################################
                   
                   
                     if (defined($saa)) {
                            if ($serveradmin) {   
                            use Data::Validate::Email qw(is_email);
                                     if ( ((length($saa)) && (70 > length($saa)) && ( 5 < length($saa))) && (is_email($saa)) ) {
                                          $vh->directive('ServerAdmin')->set_value($saa);
                                          my  $okssa="ok add ServerAdmin";
                                         } else { %templ_value = ('errorsa' => 1);} 
                            } else {  $vh->add_directive(ServerAdmin => $saa) }
                      }
                      
                          if ($serveradmin) {     
                             #my ($serveradmin);     
                            # my $serveradmin=$vh->directive('ServerAdmin');
                        %templ_value = ('serveradmin' => $serveradmin);   
                      # %teplt = ('serveradmin' => $vh->directive('ServerAdmin') );    
                      
                      #%teplt = ('serveradmin2' => $vh->directive('ServerAdmin'));
#my $teplt;                         
                       #print $teplt{'serveradmin2'}; 
                       #  print $serveradmin;
                       } else { %templ_value = ('noserverserveradmin' => '1');
                       }
                       
             $template->param(NOSERVERADMIN => $templ_value{'noserverserveradmin'});
             $template->param(SERVERADMIN => $templ_value{'serveradmin'});
             $template->param(ERRORSA => $templ_value{'errorsa'}); 

                          
                       my $addsa=$query->param("addsa");
                       if (defined($addsa))  {
                       use Data::Validate::Domain qw(is_domain);
                       
                       if (((70 > length($addsa)) && ( 4 < length($addsa))) && (is_domain($addsa))) {                      
 
                            if ( $serveralis) {                         
                            #my $serveralis=$vh->directive('ServerAlias');
                            my @serv_array = split(/ /,$serveralis );
                            my $n=scalar(@serv_array);
                            my ($match, $found, $item);
                              foreach $item (@serv_array){
                              if ($item eq $addsa) {$match=$item; $found=1; last;}
                              }
                            
                            if (!$found) { 
                               $serv_array[$n]=$addsa;
                               my $addsa2 = join(' ',@serv_array);
                               $vh->directive('ServerAlias')->set_value($addsa2);
                            } else {%templ_value = ('addsa_found' => '1'); }
                            }
                           }  else {%templ_value = ('addsa_noval' => '1'); }
                       } 
                       
                       
                       
                       my $sadelete=$query->param("sadelete");
                       
                       if (defined($sadelete)) {
                       
                       if ($serveralis) {  
                            my @serv_array;                  
                           # my $serveralis=$vh->directive('ServerAlias');
                            @serv_array = split(/ /,$serveralis );
                            my $n=scalar(@serv_array);
                            
                           # if ($n > $sadelete) {
                           # my $sadelete_ar=1;
                           #  } else {
                           #   exit;
                           
                              delete(@serv_array[$sadelete]);
                            
                              my $addsa2 = join(' ', @serv_array);
                              
                              $vh->directive('ServerAlias')->set_value($addsa2);
                            
                       }
                       }

            my $allsa=$query->param("allsa");
                      if (defined($allsa)) {
                         my $satooall=$query->param("satooall");                       
                          if ($serveralis) {                         
                              $satooall=$query->param("satooall"); 
                              
                            my @serv_array;  
                            #my $serveralis=$vh->directive('ServerAlias');
                            @serv_array = split(/ /,$serveralis );
                            my $n=scalar(@serv_array);    
                            
                            my $ss="*.hhh.org";                  
                             
                              if ((defined($satooall)) && ($satooall eq "1")) {
                              
                             
                                   if (($n eq '2') && ($serv_array[1] eq $ss)) {%templ_value = ('satooall_in_use' => '1'); }
                                   else {
                                   my $allsa2="$nameserver2 $ss";
                                   
                                   $vh->directive('ServerAlias')->set_value($allsa2);
                                   #my $satooal_added="1"; 
                                   }
                              
 
                              } elsif ((defined($satooall)) && ($satooall eq "2")) {
                              
                              
                                   if (($n > 0) && ($serv_array[1] ne $ss)) { %templ_value = ('nosatooall_in_use' => '1') ; }
                                   else {
                                   my $allsa2=$nameserver2;
                                   
                                   $vh->directive('ServerAlias')->set_value($allsa2);
                                   #my $one_satooal_added="1";
                                   }
                                                     
                              } else { %templ_value = ('no_satooall_param' => '1'); }
                           }
                       } 

                         
                         my (@serv_array, @array_for_template) ;
                       
                        if ( $serveralis) {                         
                        #my $serveralis=$vh->directive('ServerAlias');
                                               
                                                              
                            @serv_array = split(/ /,$serveralis );
                           
                          my $n=scalar(@serv_array);
                           
                           my  $ss="*hhh.org";  
                           
                  shift (@serv_array);
                 $ns=1;
                  @array_for_template;
                 @array_for_template = map +{ savalue => $_, savalue2 => $aid, savalue3 => $ns++ }, @serv_array;


                                
                                if (($n eq 2) && ($serv_array[1] eq $ss)) { %templ_value = ('temlp_serveralis_all' => '1'); } 
                                else {  %templ_value = ('notemlp_serveralis_all' => '1'); } 

                         } else {  %templ_value = ('noserveralis' => '1');}
                         
                         
                         # if ($templ_value{'notemlp_serveralis_all'}) {exit;}     
                                          



             $template->param(TEMP_SERVERALIAS_ALL => $templ_value{'temlp_serveralis_all'}); #:
             $template->param(NOTEMP_SERVERALIAS_ALL => $templ_value{'notemlp_serveralis_all'});
             
             if ($templ_value{'addsa_found'}) { $template->param(ADDSA_FOUND => 'ServerAlias found, not added')}
             
             $template->param(ADDSA_NOVAL => $templ_value{'addsa_noval'});
             
             $template->param(SATOOALL_IN_USE => $templ_value{'satooall_in_use'});
             $template->param(NOSATOOALL_IN_USE => $templ_value{'nosatooall_in_use'});
             $template->param(NO_SATOOALL_IN_USE => $templ_value{'no_satooall_param'});
             
             #%templ_value = ('notemlp_serveralis_all' => '1')
             

             
             if ($templ_value{'notemlp_serveralis_all'}) {  $template->param(SA8 => \@array_for_template); }
      my $oneoffcl=$query->param("oneoffcl");
                        
                        if (defined($oneoffcl)) {
                        my $clvalue=$query->param("clvalue");
                        
                             if ($clvalue eq '1') {
                        
                                    if ($costomlog) { %templ_value = ('customlog_in_use' => '1'); }
                                    else { 
                                    my $dircl="/home/$qhost/log/httpd-access.log combined";
                                    $vh->add_directive(CustomLog=>$dircl);
                                    }
                        
                             } elsif ($clvalue eq '2') {
                                    if ($costomlog) { 
                                    $vh->directive('CustomLog')->delete;                                    
                                    }
                                    else { %templ_value = ('no_customlog_in_use' => '1'); }
                                    
                        
                             } else { %templ_value = ('no_clvalue' => '1'); }
                        }
                                            
                     
                        my $type_cl=$query->param("type_cl");
                        if (defined($type_cl)) {
                        
                        my $typecls=$query->param("typecls");
                                                
                              if ($costomlog) { 
                              
                              my $customl_type=$costomlog;
                              my ($file, $typelog) = split(/ /,$customl_type );
                              
                                     if (($typecls eq '0') && ($typelog eq 'combined')) {
                                                                          
                                     %templ_value = ('typecls_in_use_combined' => '1') ;
                              
                                     } elsif (($typecls eq '0') && ($typelog ne 'combined')) {
                                     my $typecls_value="$file combined";
                                     
                                     $vh->directive('CustomLog')->set_value($typecls_value);
                                     
                                     } elsif (($typecls eq '1') && ($typelog eq 'common')) {
                                     
                                      %templ_value = ('typecls_in_use_common' => '1');
                                     
                                     } elsif (($typecls eq '1') && ($typelog ne 'common')) {
                                     $typecls_value="$file common";
                                     
                                     $vh->directive('CustomLog')->set_value($typecls_value);
                                     
                                     } else { %templ_value = ('no_typecls' => '1');}
                      
                              } else { %templ_value = ('no_cl' => '1'); }
                        }
                        
      if ($costomlog) { 
                        
             %templ_value = ('customlogtrue' => '1');
             
             #$template->param(CLTRUE => $templ_value{'customlogtrue'} );
             
             #my $customlog=$vh->directive('CustomLog');
                        my ($file, $typelog) = split(/ /,$customlog );

                                 if ($typelog eq 'combined') {
                                 %templ_value = ('customlogtype_cd' => '1');
                                 } elsif ($typelog eq 'common') {                     
                                 %templ_value = ('customlogtype_cn' => '1');
                                 } else {%templ_value = ('nocustomlogtype' => '1') ;}
                        
                         } else {%templ_value = ('nocustomlog' => '1');}
                         
                  if ($templ_value{'customlogtrue'}) {exit;}       
                         
             #$template->param(CLTRUE => $templ_value{'customlogtrue'} );
             $template->param(CLT_CD => $templ_value{'customlogtype_cd'} );
             $template->param(CLT_CN => $templ_value{'customlogtype_cn'} );  
             $template->param(NOCLT => $templ_value{'nocustomlogtype'} );
             $template->param(NOCLTRUE => $templ_value{'nocustomlog'});
             
             $template->param(CL_IN_USE => $templ_value{'customlog_in_use'} );
             $template->param(NO_CL_IN_USE => $templ_value{'no_customlog_in_use'});             
             $template->param(NO_CLVALUE => $templ_value{'no_clvalue'});
                          
             $template->param(TYPE_CL_IN_USE_D => $templ_value{'typecls_in_use_combined'});
             $template->param(TYPE_CL_IN_USE_C => $templ_value{'typecls_in_use_common'});
             $template->param(NOTYPE_CL => $templ_value{'no_typecls'});
             $template->param(NO_CL_IN_USE => $templ_value{'no_cl'});

Это сообщение отредактировал(а) gcc - 24.10.2008, 02:50

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 7.10.2008, 10:10 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Код



                           if ($errorlog) { 
                            %templ_value = ('errorlogtrue' => '1');
                           } else { %templ_value = ('noerrorlog' => '1'); }
                           
                           
            $template->param(ERRORLOG   => $templ_value{'notemlp_serveralis_all'} );
            $template->param(NOERRORLOG => $templ_value{'notemlp_serveralis_all'} );    
                           
                          sub eett1 {
                          
                           #$edtvalue=$query->param("edtvalue");
                           #$edvalue=$query->param("edvalue");
                           
                           my ($type_errord,$edvalue,$edtvalue)= @_;
      
                          if ( ( (($type_errord eq '2') || ($type_errord eq '3')) && (!length($edvalue)) || (65 < length($edvalue))  || (5 > length($edvalue)))) {
                          my $error_typedoc2='1'; 
                          my $error_typedoc=\$error_typedoc2; 
                          return $error_typedoc; 
                          }
                                                         
                                                                             
                           if (($type_errord > 0) && ((3 == length($edtvalue))) ) {
                           my ($found, $item); 
                           my @er_array = (100,101,200,201,202,203,204,205,206,300,301,302,
                                          303,304,305,400,401,402,403,404,405,406,407,408,
                                          409,410,411,412,413,414,415,500,501,502,503,504,505); 
                           
                              foreach $item (@er_array){
                              if ($item eq $edtvalue) { $found=1; last;}
                              }
                              
                            if (!$found) { 
                            my $error_type2="1"; my $error_type=\$error_type2;
                            return $error_type;
                            }

                            my $tttt2="1"; 
                            my $tttt=\$tttt2;
                            return $tttt;                                                 
                            } 
                           }
                           
                           sub eett2 {
                           #$edtvalue="404";
                           #$edtvalue2="http://jcsasha.24ua.com4";
                           
                          #$edtvalue=$query->param("edtvalue");
                          #$edvalue=$query->param("edvalue");

                           my (@drtvs4, $edtvalue)=@_;
                           
                           my @drtvs3;                        

                           for my $loopindex (0..$#drtvs4) {
                           my ($key, $value) = split(/ /,$drtvs4[$loopindex]);
                           push(@drtvs3, {$key => $value});
                           }
                           
                           my ($match_key, $match_index, $found);
                             for my $loopindex (0..$#drtvs3) {                             
                               for my $key2 (keys %{$drtvs3[$loopindex]}) { 
                                   if ($key2 eq $edtvalue) {

                                   $drtvs3[$loopindex]{$key2};
                                   $match_key=$key2; $match_index=$loopindex; $found=1; last;
                                           }
                                    }
                               }
                             print $match_index;     
                            if (!$found) {
                            my $error_typeer2="1"; my $error_typeer=\$error_typeer2;
                            return $error_typeer; 
                            }
                            
                            my $match_index2=\$match_index;
                            
                            return (@drtvs3,$match_index2);
                            }
                           
                           
                           my $eddelete=$query->param("eddelete");
                           my $edadd=$query->param("edadd");
                           my $edchange=$query->param("edchange");

                           
                           
                           if ($eddelete || $edchange) {
                          
                          @drtvs4 = $vh->directive('ErrorDocument'); 

                         
                          my $edtvalue=$query->param("edtvalue");
                          my $edvalue=$query->param("edvalue");
                          
                          
                          #if (($ttttyui="7")=eett1()) { exit;}
                          
                          #eett1();                         
                             
                          #     print $$tttt2;                   
                          
                          #if ($$tttt2) #{exit;}
                          #{
                          #eett2();
                          
                          #print $$error_typedoc2;
                          
                          my ($type_errord, $tttt, $match_index2, @drtvs3 );
                          if ((defined($eddelete)) && (@drtvs4 )) {
                          my $type_errord="1";
                          } elsif (defined($edadd)) {
                          my $type_errord="2";
                          } elsif ((defined($edchange)) && (@drtvs4)) {
                          my $type_errord="3";                          
                          } else { my $type_errord="0"; 
                          }


                                                   
                          eett1($type_errord,$edvalue,$edtvalue);
                          #if ($$tttt) { exit;}

                          if (eett1($type_errord,$edvalue,$edtvalue) && $$tttt && eett2(@drtvs4, $edtvalue) && defined($$match_index2)  ) {
                         
                          
                            
                               while ($vh->directive('ErrorDocument')) {
                                $vh->directive('ErrorDocument')->delete;   }  
                                         
                                         print $match_index2;              
                                      #if ($eddadd) {   
                                      #$match_index+=1;   
                                                
                                      $drtvs3[$$match_index2]={$edtvalue => $edvalue};
                                      
                                      #eslif ()
                                       
                            
                                       for my $loopindex2 (0..$#drtvs3) {
  
                                         for my $key4 (keys %{$drtvs3[$loopindex2]}) { 
                                          # print "$key4  $drtvs3[$loopindex2]{$key4}"; 
           
                                           my $value_er=$drtvs3[$loopindex2]{$key4};
           
                                           my $setvalue_error="$key4 $value_er";
           
                                           $vh->add_directive(ErrorDocument=> $setvalue_error);
                                         }
  
                                       }  
                              }        
                            
                            }
                         
                         
                         
                            

                             my @arrayedout;
                             if (@drtvs4) {  
                          
                           #@arrayed = $vh->directive('ErrorDocument');
                           
                           for my $loopindex9 (0..$#drtvs4) {
                           my ($key9, $value9) = split(/ /, $drtvs4[$loopindex9]);
                           push(@arrayedout,{errort => $key9, erroru => $value9, aid => $aid});
                           }
                           } 
                           
                         $template->param(SA10 => \@arrayedout); 
                    


print $query->header( -charset => "utf8");
print $template->output();

Это сообщение отредактировал(а) gcc - 7.10.2008, 10:27

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 24.10.2008, 02:41 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

код я переписал еще, если надо могу показать, но его много, смотреть долго...
есть большие модули со многими директивами, например mod_security, директив штук 100 наверное

можно как-то провериться валидность текста который будет введен в apache? сможет ли apache перегрузиться?

Это сообщение отредактировал(а) gcc - 24.10.2008, 22:05

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

ginnie

Дата 24.10.2008, 22:05 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 38
Всего: 49

Цитата(gcc @ 24.10.2008, 02:41

)

можно как провериться валидность текста который будет введен в apache? сможет ли apache перегрузиться?

Коллеги, только я не могу понять смысл предложений? smile

Код


httpd -f /path/to/httpd.conf -t

Это сообщение отредактировал(а) ginnie - 24.10.2008, 22:09

--------------------

Написать код, понятный компьютеру, может каждый, но только хорошие программисты пишут код, понятный людям. (Мартин Фаулер. Рефакторинг)

gcc

Дата 24.10.2008, 22:08 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

извените, я секунду назад откорректировал smile

что нужно сдедать:

нужно вставить допустим из формы в CGI скрипте данные в файл конфига в секцию vhost...
ну можно эти данные которые будут вставляться проверить? (этих директив штук 100 чтобы не каждую директиву проверять, как apache проверяет конфиг? или это нельзя сделать?

Это сообщение отредактировал(а) gcc - 24.10.2008, 22:22

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

gcc

Дата 24.10.2008, 22:29 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

Код


 apachectl -f /usr/local/etc/apache22/ab.conf -t
Syntax error on line 8 of /usr/local/etc/apache22/ab.conf:
Invalid command 'SuexecUserGroup', perhaps misspelled or defined by a module not included in the server configuration

как часть проверить, он хочет главный конфиг, как проверить перед тем как вставлять в рабочий конфиг...

=================================================

посмотрел исходнини одного модуля apache там проверки на валидность нету, точнее проверка идет по всему коду...
я так понял что нельзя... лучше perl'ом

Это сообщение отредактировал(а) gcc - 25.10.2008, 08:15

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

ginnie

Дата 25.10.2008, 09:46 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Комодератор
Сообщений: 1287
Регистрация: 6.1.2008
Где: Москва

Репутация: 38
Всего: 49

Цитата(gcc @ 24.10.2008, 22:29

)

как проверить перед тем как вставлять в рабочий конфиг...

Сделать копию главного конфига, добавить туда включение нового конфига и проверять при помощи httpd. Проверка модулями не даст 100% гарантии, что в apache все заработает.

--------------------

gcc

Дата 20.11.2008, 00:07 (ссылка)

(нет голосов)

Загрузка ...

Агент алкомафии

Профиль
Группа: Участник
Сообщений: 2691
Регистрация: 25.4.2008
Где: %&й

Репутация: 1
Всего: 17

вот опубликовали http://www.opennet.ru/tips/info/1842.shtml

только я до окнца не дописывал, вообще в apache директив штук 2000 всего наверное

нужна еще кому-то, кроме меня, такая большая программа? (а то писать это не хочется сильно)

Это сообщение отредактировал(а) gcc - 20.11.2008, 00:10

--------------------

Perl FAQ
freelance
perl, jquery, js, php
perl, jquery

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Perl: Общие вопросы \| Следующая тема »