Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
tree: b294f2ac5f
Fetching contributors…

Cannot retrieve contributors at this time

executable file 336 lines (288 sloc) 9.799 kb
#!/usr/bin/perl -w
# autobench - tool to automatically benchmark one or more machines.
# Copyright (C) 2001 - 2003 Julian T. J. Midgley <jtjm@xenoclast.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# A copy of version 2 of the GNU General Public License may be found
# in the file "LICENCE" in the Autobench tarball.
use strict;
use Getopt::Long;
# The location of the master config file
my $MASTER_CONFIG = "/etc/autobench.conf";
# The location of the autobench config file
my $CONFIG_FILE = $ENV{HOME}."/.autobench.conf";
my $VERSION="2.1.1";
my $DEBUG = 0;
#---------------------------------------------------------------------------
# check_host($hostname)
# checks that $hostname is resolvable
sub
check_host
{
my $hostname = shift;
my @tmp = gethostbyname($hostname);
unless (@tmp) {
die "Fatal: hostname: $hostname is unresolvable\n";
}
}
#---------------------------------------------------------------------------
# check_present (hashref $cref, @vars)
# Checks that of the keys in @vars is present in %$cref
sub
check_present
{
my ($cref, @vars) = @_;
my $err = 0;
foreach my $var (@vars) {
unless ($$cref{$var}) {
print STDERR "Argument $var not supplied\n";
$err ++;
}
}
if ($err) {
print STDERR "Please run autobench again, supplying the missing arguments\n".
"either on the command line, or in the config file\n";
}
}
#--------------------------------------------------------------------------
# get_config([$config_file])
#
# Reads the config file ($CONFIG_FILE), and returns the configuration
# as a hash.
sub
get_config
{
my $CONFIG_FILE = shift @_; # optional - overrides $CONFIG_FILE if present
my %config;
my $install = 0;
open (IN,$CONFIG_FILE)
or $install = 1;
if ($install) {
install_new_config($CONFIG_FILE);
print "Installation complete - please rerun autobench\n";
exit(0);
}
while (<IN>) {
# Throw away comments and blank lines
next if (/^\#.*|^\s+$|^\s+\#|^$/);
# Check for valid key-value pair and extract key into $1, value into $2
unless (/^\s*([a-zA-Z][a-zA-Z_0-9\-]*?)\s*=\s*(\S.*?)\s*$/) {
warn "AUTOBENCH: Warning - invalid line in config file:'$_'";
next;
}
if (defined $config{$1}) {
warn "AUTOBENCH: Warning - parameter '$1' defined more than once,".
"ignoring '$1'='$2'";
next;
}
$config{$1}=$2;
}
return %config;
}
#--------------------------------------------------------------------------
# install_new_config($dest)
#
# Installs a copy of the autobench config file into a user's home directory
sub
install_new_config
{
my $dest = shift @_;
print STDERR "Autobench configuration file not found\n - installing new copy in $dest\n";
system("cp $MASTER_CONFIG $dest");
}
#--------------------------------------------------------------------------
# test_host ($config_ref, $rate, $server, $uri, $port)
sub
test_host
{
my ($config_ref, $rate, $server, $uri, $port) = @_;
my %results;
# build a list of config options - change underscores to hyphens
my ($extra_httperf_opts) ;
foreach (keys %$config_ref) {
if ( /^httperf_(.*)$/ ) {
my $hf_val = $$config_ref{$_};
$hf_val = ($hf_val eq 'NULL') ? '' : $hf_val;
$extra_httperf_opts .= " --".$1." ".$hf_val ;
}
}
check_present($config_ref, qw(num_conn num_call timeout));
my $httperf_command = "httperf --server $server --uri \"$uri\" --num-conn ".
$$config_ref{num_conn}." --num-call ".
$$config_ref{num_call}." --timeout ".
$$config_ref{timeout}." --rate $rate --port $port".
($extra_httperf_opts || "");
print STDERR "$httperf_command\n" if $DEBUG;
open (IN, "$httperf_command |")
or die "Cannot execute httperf\n";
while(<IN>) {
if (/^Total: .*replies (\d+)/) {
$results{replies}=$1;
}
if (/^Connection rate: (\d+\.\d)/) {
$results{conn_rate}=$1;
}
if (/^Request rate: (\d+\.\d)/) {
$results{req_rate}=$1;
}
if (/^Reply rate .*min (\d+\.\d) avg (\d+\.\d) max (\d+\.\d) stddev (\d+\.\d)/) {
$results{rep_rate_min} = $1;
$results{rep_rate_avg} = $2;
$results{rep_rate_max} = $3;
$results{rep_rate_stdv} = $4;
}
if (/^Reply time .* response (\d+\.\d)/) {
$results{rep_time} = $1;
}
if (/^Net I\/O: (\d+\.\d)/) {
$results{net_io} = $1;
}
if (/^Errors: total (\d+)/) {
$results{errors} = $1;
}
print $_ unless $$config_ref{quiet};
}
close (IN);
if ($results{replies} == 0) {
print STDERR "Zero replies received, test invalid: rate $rate\n";
$results{percent_errors} = 101;
}
else {
$results{percent_errors} = ( 100 * $results{errors} / $results{replies} );
}
return \%results;
}
sub
print_header
{
my ($config_ref, $sep, $out_stream) = @_;
my %config = %{$config_ref};
# The following is really quite ugly...
print $out_stream "dem_req_rate".$sep.
"req_rate_$config{host1}".$sep.
"con_rate_$config{host1}".$sep.
"min_rep_rate_$config{host1}".$sep.
"avg_rep_rate_$config{host1}".$sep.
"max_rep_rate_$config{host1}".$sep.
"stddev_rep_rate_$config{host1}".$sep.
"resp_time_$config{host1}".$sep.
"net_io_$config{host1}".$sep.
"errors_$config{host1}";
if ($config{single_host}) {
print $out_stream "\n";
}
else {
print $out_stream $sep."req_rate_$config{host2}".$sep.
"con_rate_$config{host2}".$sep.
"min_rep_rate_$config{host2}".$sep.
"avg_rep_rate_$config{host2}".$sep.
"max_rep_rate_$config{host2}".$sep.
"stddev_rep_rate_$config{host2}".$sep.
"resp_time_$config{host2}".$sep.
"net_io_$config{host2}".$sep.
"errors_$config{host2}\n";
}
}
#--------------------------------------------------------------------------
# Main
# Declarations
my ($curr_rate, $sep);
my (%res_host1, %res_host2, $dem_req);
# Get configuration from config file
my %config = get_config($CONFIG_FILE);
# Override config file with options supplied on the command line.
GetOptions( \%config, "host1:s","host2:s","uri1:s","uri2:s","port1:i",
"port2:i","low_rate:i","high_rate:i","rate_step:i","num_conn:i",
"num_call:i","timeout:i","quiet","single_host","debug",
"output_fmt=s","file=s","version", "const_test_time:i");
if ($config{version}) {
print "Autobench $VERSION\nCopyright (C) Julian T. J. Midgley <jtjm\@xenoclast.org> 2003\n";
exit 0;
}
$DEBUG = 1 if ($config{debug});
if ( $config{output_fmt} eq 'csv' ) {
$sep = ",";
}
elsif ( $config{output_fmt} eq 'tsv' ) {
$sep = "\t";
}
else {
die "Output Format '$config{output_fmt}' not supported";
}
# Check that httperf is in our path
system("which httperf > /dev/null") == 0
or die 'Cannot find httperf in $PATH; please ensure it is installed and your PATH is'."\ncorrectly set\n";
# Basic input checking
check_present(\%config, qw(low_rate high_rate rate_step host1 uri1 port1));
check_host($config{host1});
unless ($config{single_host}) {
check_present(\%config, qw(host2 uri2 port2));
check_host($config{host2});
}
if ($config{const_test_time} && $config{const_test_time} < 10) {
die "--const_test_time must be >= 10. See autobench(1) for details\n";
}
# Set the output stream correctly
if ($config{file}){
# Filename supplied with --file option, try to open it for writing.
open(OUT, ">$config{file}") or die "Cannot open $config{file} for writing\n";
}
else {
# Connect OUT to STDOUT
open(OUT, ">&STDOUT") or die "Bizarre, cannot connect OUT to STDOUT!";
}
# Print first line of output
print_header(\%config, $sep, \*OUT);
# Conduct the tests
for ($curr_rate = $config{low_rate}; $curr_rate <= $config{high_rate};
$curr_rate += $config{rate_step}) {
if ($config{const_test_time}) {
$config{num_conn} = $curr_rate * $config{const_test_time};
}
# Test Host 1
%res_host1 = %{test_host (\%config, $curr_rate, $config{host1}, $config{uri1}, $config{port1})};
# Test Host 2
unless ( $config{single_host} ) {
%res_host2 = %{test_host (\%config, $curr_rate, $config{host2}, $config{uri2}, $config{port2})};
}
# Merge and Display Results
$dem_req = ($config{num_call} * $curr_rate);
print OUT $dem_req.$sep.
$res_host1{req_rate}.$sep.
$res_host1{conn_rate}.$sep.
$res_host1{rep_rate_min}.$sep.
$res_host1{rep_rate_avg}.$sep.
$res_host1{rep_rate_max}.$sep.
$res_host1{rep_rate_stdv}.$sep.
$res_host1{rep_time}.$sep.
$res_host1{net_io}.$sep.
$res_host1{percent_errors};
if ($config{single_host}) {
print OUT "\n";
}
else {
print OUT $sep.$res_host2{req_rate}.$sep.
$res_host2{conn_rate}.$sep.
$res_host2{rep_rate_min}.$sep.
$res_host2{rep_rate_avg}.$sep.
$res_host2{rep_rate_max}.$sep.
$res_host2{rep_rate_stdv}.$sep.
$res_host2{rep_time}.$sep.
$res_host2{net_io}.$sep.
$res_host2{percent_errors}."\n";
}
}
close (OUT);
Jump to Line
Something went wrong with that request. Please try again.