Perl a Apache (dlouhe)

Tomas Kouba tomas na neo.cz
Pátek Červenec 16 20:47:56 MEST 1999


Zdravim a preji pekny den, ci vecer,

potreboval bych jednoduchy a predevsim funkcni modul, ktery dokaze polozit
HTTP dotaz serveru.

Pouzivam server Apache a ten poskytuje:

A machine-readable version of the status file is available by accessing the
page http://your.server.name/server-status?auto. This is useful when
automatically run, see the Perl program in the /support directory of Apache,
log_server_status.

Coz jsem vyzkousel a pouzil od apache jednoduchy program
log_server_status.pl, ktery mel vystup zpracovavat:

require 'sys/socket.ph';

[zde nastaveni promenych, neuvadim, aby to nebylo moc dlouhe]

sub tcp_connect
{
        local($host,$port) =@_;
        $sockaddr='S n a4 x8';
        chop($hostname=`hostname`);
        $port=(getservbyname($port, 'tcp'))[2]  unless $port =~ /^\d+$/;
        $me=pack($sockaddr,&AF_INET,0,(gethostbyname($hostname))[4]);
        $them=pack($sockaddr,&AF_INET,$port,(gethostbyname($host))[4]);
        socket(S,&PF_INET,&SOCK_STREAM,(getprotobyname('tcp'))[2]) ||
                die "socket: $!";
        bind(S,$me) || return "bind: $!";
        connect(S,$them) || return "connect: $!";
        select(S);
        $| = 1;
        select(stdout);
        return "";
}

### Main

{
        $date=`date +%y%m%d:%H%M%S`;
        chop($date);
        ($day,$time)=split(/:/,$date);
        $res=&tcp_connect($server,$port);
        open(OUT,">>$wherelog$day");
        if ($res) {
                print OUT "$time:-1:-1:-1:-1:$res\n";
                exit 1;
        }
        print S "GET $request\n";
        while (<S>) {
                $requests=$1 if ( m|^BusyServers:\ (\S+)|);
                $idle=$1 if ( m|^IdleServers:\ (\S+)|);
                $number=$1 if ( m|sses:\ (\S+)|);
                $cpu=$1 if (m|^CPULoad:\ (\S+)|);
        }
        print OUT "$time:$requests:$idle:$number:$cpu\n";
}

Bohuzel se mi podarilo tim (poprve v zivote) shodit cely Linux (pred
zabranim cele pameti to zahlasilo spoustu varovani, ktere se mi nepodarilo
zachytit). POsledni co vim, ze dosel i swap soubor, takze to zabralo cca 150
MB.

Pak uz jsem musel resetovat a opravovat disk. Chyba je zrejme v TCP
komunikaci. Nemate nekdo neco funkcniho, cim bych mohl HTTP serveru polozit
HTTP dotaz a neshodi to celou masinu?

Predem diky.

------------------------------
Tomas Kouba
mailto:tomas na neo.cz





Další informace o konferenci Perl