Re: [apache-talk] Безопасная автогенерация конфига для Apache

["Dmitriy A. Kuvshinov" <dmitriy@genphys.phys.msu.su>]

В сообщении от 10 Июль 2003 09:01 вы написали:
> Hello Dmitry,
>
> DB> Вопрос: как в скрипте (желательно перловом) проверить, что Apache может
> DB> начать слушать на данной паре IP/порт?
>
> use IO::Socket ?

имхо, лучше perldoc perlipc, там готовых примеров просто тьма...

Короче, вот пример, который генерит чайлдов, которые через сокет долбятся на 
определенный хост:порт через две секунды. Если чайлд не подсоединяется на 
хост:порт(хост:порт неработает), то он умирает и перезапускается заново... 
Если хост:порт ответил, то генерится еще один чайлд, в котором поднимается 
сервер, в который копируется то, что сыпется в исходный хост:порт, то есть 
что-то типа point to point... Только там в apache надо GET писать, а то он 
подконнктится, но ниче не отдаст...

Если будут вопросы - пишите.

#!/usr/bin/perl -w

use strict;
use IO::Socket;
use IO::Handle;
use Socket;
use Symbol;
use POSIX;
use Net::hostent;

my $port=6001; 
my $host="127.0.0.1"; 
my $PREFORK="1"; 
my $MAX_CLIENTS_PER_CHILD="1";
my %children=(); 
my $children=0;
make_new_child() for(1 .. $PREFORK);

$SIG{CHLD}=\&REAPER; 
$SIG{INT}=\&HUNTSMAN;

while(1){ 
  sleep; 
  for(my $i=$children; $i<$PREFORK; $i++){
    make_new_child()
  }
}

sub make_new_child{ 
  my($pid, $sigset, $kidpid, $server, $client);

  $sigset=POSIX::SigSet->new(SIGINT);
  sigprocmask(SIG_BLOCK, $sigset) or die "can't block SIGINT for fork: $!\n";
  die "fork: $!" unless defined do{$pid = fork};

  if($pid){

    sigprocmask(SIG_UNBLOCK, $sigset) 
      or die "can't unblock SIGINT for fork: $!\n";

    $children{$pid}=1; 
    $children++; 
    return;
  } else {
    $SIG{INT} = 'DEFAULT'; 
    $SIG{CHLD}='IGNORE';

    sigprocmask(SIG_UNBLOCK, $sigset) 
      or die "can't unblock SIGINT for fork: $!\n";

    for(my $i=0;  $i<$MAX_CLIENTS_PER_CHILD; $i++){ 
      sleep 2;

      socketpair(CHILD, PARENT, AF_UNIX, SOCK_STREAM, PF_UNSPEC) 
        or die "socketpair: $!";
      CHILD->autoflush(1); 
      PARENT->autoflush(1);

      my $handle = IO::Socket::INET->new( Proto    => 'tcp',
                                          PeerAddr => $host,
                                          PeerPort => $port) 
        or die "can't connect to port $port on $host: $!";

      print STDERR "[Connected to $host:$port]\n";
      die "can't fork: $!" unless defined do{$kidpid = fork()};

      if ($kidpid) { 
        my ($byte, $tmp); 
        close PARENT;
        while(sysread($handle, $byte, 1) eq 1){ 
          $tmp.=$byte;
          do{print CHILD "$tmp\n"; 
            $tmp=''
          } if $tmp eq 'ok';
        } 
        close CHILD;
        kill "TERM" => $kidpid;
        waitpid($kidpid,0);
      } else { 
        close CHILD; 
        $server = IO::Socket::INET->new( LocalPort => 2003,
                                         Type      => SOCK_STREAM, 
                                         Proto     => 'tcp',
                                         Reuse     => 1,
                                         Listen    => 10); 
        die "making socket: $@" unless $server;

        while($client=$server->accept()){
          $client->autoflush(1);
          my ($line, $line1);
          while (defined ($line = <$client>)){
            print $handle $line;
            chomp($line1=<PARENT>);
            print $client "$line1\n";
          } 
          close $client;
        } 
        close PARENT;
      } 
    } exit;
  }
}

sub HUNTSMAN{
  local($SIG{CHLD})='IGNORE';
  kill 'INT' => keys %children;
  exit;
}

sub REAPER{
  $SIG{CHLD}=\&REAPER;
  my $pid = wait;
  $children--;
  delete $children{$pid};
}

Дима