On Tue, 20 Jun 2000, Joshua Chamas wrote:

> > your machine. Therefore you should configure the server, so that the
> > maximum number of possible processes will be small enough using the
> > C<MaxClients> directive. This will ensure that at the peak hours the
> > system won't swap. Remember that swap space is an emergency pool, not
> > a resource to be used routinely.  If you are low on memory and you
> > badly need it, buy it or reduce a number of processes to prevent
> > swapping.
> 
> One common mistake that people make is to not load
> test against a server to trigger the full MaxClients
> in production.  In order to prevent swapping, one must
> simulate the server at its point of greatest RAM stress, 
> and one can start to do this by running ab against
> a program so that each of the MaxClient httpd processes
> goes through its MaxRequests.  

attached is a little perl script (3.5k) that I use to "replay" a log file
as fast as it will go... the script uses Sys-5 message queues and forks
off the number of children specified by -n to read these messages and make
the given request... Since we use it for benchmarking machines hosting
lots of virtual servers, the input file format is actually 

  host uri status size

(space separated) and then it whines about responses that don't match the
status or have a vastly differing size... 

This version isn't as polished as the previous one was... but I left that
under /tmp/ for too long :-(

Anyhow, my beef with ab is that it just pounds on one page (but it's 
very good at that).

Anyhow, I haven't generally used it for testing MaxClients settings, but
that would just mean increasing the -n parameter... it is
_simple_ and doesn't deal with stuff like keep alives, and it's
not the fastest client, so it would be plain stupid to try to use
this to benchmark the number of GIFs per second a faster CPU
could serve. Basically, we generally use for correctness testing rather
than all out performance.


-Tom

p.s. Options...
           # -n = num threads;
           # -v = verbose
           # -d = debug
           # -s = allowed size variance (bytes)
           # -p = allowed size variance (%)
           # -w = warn if response takes more than this seconds

#!/usr/bin/perl
#
# script to read in a file of "host uri status size"
# lines, and feed the requests to a pool of child processes via Sys5
# message queue.

##### constants

my $MSG_NORM = 2;
my $MSG_EXIT = 1;
my $MSG_SIZE = 10000;
my $KEY = 1984;  # use fixed key instead of IPC_PRIVATE
my $TIMEOUT = 10;

##### use & init

use strict;
use IPC::SysV qw(IPC_CREAT S_IRWXU S_IRWXG S_IRWXO IPC_NOWAIT);
use IPC::Msg;
use IO::Socket::INET;

use Getopt::Std;
use vars qw($opt_n $opt_v $opt_d $opt_s $opt_p $opt_w);  
getopts("n:vdw:s:p:");
       # -n = num threads;
       # -v = verbose
                 # -d = debug
                 # -s = allowed size variance (bytes)
                 # -p = allowed size variance (%)
                 # -w = warn if response takes more than this seconds

$opt_v++ if ($opt_d);

# defaults

$opt_n = 10 unless ($opt_n);
$opt_p = 5 unless (defined $opt_p);
$opt_s = 50 unless (defined $opt_s);
$opt_w = 0 unless (defined $opt_w);

my %DNS_HASH = ();

##########

my $msg = new IPC::Msg($KEY, IPC_CREAT | S_IRWXU | S_IRWXG | S_IRWXO)
   or die "message queue creation failed! ($!)";

# drain queue, since it might have old messages in it.
{ my $i=1e6;
  my $buffer;
  while ($i-- > 0 && $msg->rcv($buffer, $MSG_SIZE, $MSG_NORM, IPC_NOWAIT) ) {
    # drop it ;-)
  }
  while ($i-- > 0 && $msg->rcv($buffer, $MSG_SIZE, $MSG_EXIT, IPC_NOWAIT) ) {
    # drop it ;-)
  }
}

my $pid;
for (my $i=$opt_n; $i > 0; $i--) {
   $pid=fork();
        die "fork failed ($!)" if ($pid < 0);
        last if ($pid ==0);  # child
}

if ($pid != 0) { # parent

        # send messages
        while (defined (my $line = <>)) {
          $msg->snd($MSG_NORM,$line,undef);  # tough huh?
        }

        for (my $i=$opt_n; $i > 0; $i--) {
                $msg->snd($MSG_EXIT,"goodbye",undef); # one for each child
        }
        while ( wait() > 0 ) {
          # reap children.
        }
        $msg->remove;  # remove the message queue
        print "parent finished\n" if ($opt_v);
} else { # children
        child:
   while ( 1 ) {  # loop until
          my $buffer = '';
          my $timeout = $TIMEOUT;
          while ($timeout > 0) {
                  if ( $msg->rcv($buffer, $MSG_SIZE, $MSG_NORM, IPC_NOWAIT) ) {
                          print "$$: $buffer\n" if ($opt_d);
                          get_request($buffer);
                          next child;
                  } else {
                          last child if( $msg->rcv($buffer, $MSG_SIZE, $MSG_EXIT, 
IPC_NOWAIT));
                          sleep 1;
                          $timeout--;
                  }
                }
        }
        print "child $$: finished\n" if ($opt_v);
}

############

sub get_request {
        my ($host, $uri, $stat, $size) = split(' ', $_[0]);
        unless (defined $DNS_HASH{$host}) {
           $DNS_HASH{$host} = join('.', unpack('C4',(gethostbyname($host))[4]) );
        }
        my $sock = IO::Socket::INET->new("$DNS_HASH{$host}:80");
        if (!defined($sock)) {
          warn "can't connect to $host! ($!)\n";
          return;
        }
        my $start = time();
        $sock->send("GET $uri HTTP/1.0\nUser-Agent: $0\n\n");

        my $resp = '';
        my $buff = '';
        while ($sock->recv($buff,0x10000, undef)) {
           $resp .= $buff;
                last if ($buff eq ''); # zero length read. 
        }
        my $end = time();
        my ($header,$body); 
        unless ( ($header,$body) = ($resp =~ m/^(.*?)\r?\n\r?\n(.*)$/s) ) {
           $header = $resp;
           $body = '';
        }
        my $mystat = undef;
        unless ( ($mystat) = ($header =~ m/^HTTP\S+\s+(\d+)/s ) ) {
          $mystat = 550;
        }
        my $mysize=length($body);

        print "fetched $host$uri stat: $mystat vs $stat  size: $mysize vs $size\n" 
           if ($opt_v);
        print "resp: $resp \n\nheader: $header \n\nbody: $body\n\n-----------\n\n" 
           if ($opt_d);

        my $size_diff = abs($size - $mysize);
        if ( $size &&
             (($size_diff > $opt_s) && ($size_diff/$size*100 > $opt_p)) ) {
           print "size mismatch on $host/$uri fetched $mysize vs $size\n";
        }
        if ( $mystat != $stat) {
           print "status mismatch on $host$uri fetched $mystat vs $stat\n";
        }
        if ($opt_w) {
                printf "SLOW: $host$uri took %d seconds\n", $end - $start 
                  if ($end - $start > $opt_w);
        }
}
#!/usr/bin/perl -w
#
# take a normal access log, and reduce it to "host URI status length"
#

use strict;

die "you must specify input files as parameters (no pipes)"
  unless (@ARGV);

while (defined (my $line = <>)) {
        my @vals = split(' ', $line, 11);
        if ($vals[6] =~ m/"$/) {  # missing protocol
            $vals[6] =~ s/"$//;  # strip quote
                 splice(@vals,7,0,""); # insert a protocol element
        }
   my ($ip, $id1, $id2, $time1, $time2, $meth, $uri, $prot, $stat, $length) 
           = @vals; 
   next unless ($id1 eq '-');
   next unless ($id2 eq '-');
   next unless ($meth eq '"GET');
   next if ($stat == 304);
   next if ($stat == 206);
        my $host = $ARGV;  # current input file :-)
        $host =~ s/\.access.*$//;
        $length = 0 if ($length eq '-');
        print "$host $uri $stat $length\n";
}

Reply via email to