1#!/usr/local/bin/perl -w
2
3# autobench - tool to automatically benchmark one or more machines.
4
5# Copyright (C) 2001 - 2003 Julian T. J. Midgley <jtjm@xenoclast.org>
6#
7#    This program is free software; you can redistribute it and/or modify
8#    it under the terms of the GNU General Public License as published by
9#    the Free Software Foundation; either version 2 of the License, or
10#    (at your option) any later version.
11#
12#    This program is distributed in the hope that it will be useful,
13#    but WITHOUT ANY WARRANTY; without even the implied warranty of
14#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15#    GNU General Public License for more details.
16#
17#    You should have received a copy of the GNU General Public License
18#    along with this program; if not, write to the Free Software
19#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
20#
21# A copy of version 2 of the GNU General Public License may be found
22# in the file "LICENCE" in the Autobench tarball.
23
24
25use strict;
26use Getopt::Long;
27
28# The location of the master config file
29my $MASTER_CONFIG = "/usr/local/etc/autobench.conf";
30
31# The location of the autobench config file
32my $CONFIG_FILE = $ENV{HOME}."/.autobench.conf";
33
34my $VERSION="2.1.1";
35
36my $DEBUG = 0;
37#---------------------------------------------------------------------------
38# check_host($hostname)
39# checks that $hostname is resolvable
40sub
41check_host
42{
43    my $hostname = shift;
44    my @tmp = gethostbyname($hostname);
45    unless (@tmp) {
46        die "Fatal: hostname: $hostname is unresolvable\n";
47    }
48}
49
50#---------------------------------------------------------------------------
51# check_present (hashref $cref, @vars)
52# Checks that of the keys in @vars is present in %$cref
53
54sub
55check_present
56{
57    my ($cref, @vars) = @_;
58    my $err = 0;
59    foreach my $var (@vars) {
60        unless ($$cref{$var}) {
61            print STDERR "Argument $var not supplied\n";
62            $err ++;
63        }
64    }
65    if ($err) {
66        print STDERR "Please run autobench again, supplying the missing arguments\n".
67            "either on the command line, or in the config file\n";
68    }
69}
70
71#--------------------------------------------------------------------------
72# get_config([$config_file])
73#
74# Reads the config file ($CONFIG_FILE), and returns the configuration
75# as a hash.
76
77sub
78get_config
79{
80    my $CONFIG_FILE = shift @_; # optional - overrides $CONFIG_FILE if present
81    my %config;
82    my $install = 0;
83
84    open (IN,$CONFIG_FILE)
85	or $install = 1;
86
87    if ($install) {
88	install_new_config($CONFIG_FILE);
89	print "Installation complete - please rerun autobench\n";
90	exit(0);
91    }
92
93    while (<IN>) {
94	# Throw away comments and blank lines
95	next if (/^\#.*|^\s+$|^\s+\#|^$/);
96
97	# Check for valid key-value pair and extract key into $1, value into $2
98	unless (/^\s*([a-zA-Z][a-zA-Z_0-9\-]*?)\s*=\s*(\S.*?)\s*$/) {
99	    warn "AUTOBENCH: Warning - invalid line in config file:'$_'";
100	    next;
101	}
102
103	if (defined $config{$1}) {
104	    warn "AUTOBENCH: Warning - parameter '$1' defined more than once,".
105		 "ignoring '$1'='$2'";
106	    next;
107	}
108	$config{$1}=$2;
109    }
110    return %config;
111}
112
113#--------------------------------------------------------------------------
114# install_new_config($dest)
115#
116# Installs a copy of the autobench config file into a user's home directory
117
118sub
119install_new_config
120{
121    my $dest = shift @_;
122    print STDERR "Autobench configuration file not found\n - installing new copy in $dest\n";
123    system("cp $MASTER_CONFIG $dest");
124}
125
126#--------------------------------------------------------------------------
127# test_host ($config_ref, $rate, $server, $uri, $port)
128sub
129test_host
130{
131    my ($config_ref, $rate, $server, $uri, $port) = @_;
132    my %results;
133
134
135    # build a list of config options - change underscores to hyphens
136    my ($extra_httperf_opts) ;
137    foreach (keys %$config_ref) {
138	if ( /^httperf_(.*)$/ ) {
139            my $hf_val = $$config_ref{$_};
140            $hf_val = ($hf_val eq 'NULL') ? '' : $hf_val;
141	    $extra_httperf_opts .= " --".$1." ".$hf_val ;
142	}
143    }
144    check_present($config_ref, qw(num_conn num_call timeout));
145    my $httperf_command = "httperf --server $server --uri \"$uri\" --num-conn ".
146	  $$config_ref{num_conn}." --num-call ".
147	  $$config_ref{num_call}." --timeout ".
148	  $$config_ref{timeout}." --rate $rate --port $port".
149	  ($extra_httperf_opts || "");
150
151    print STDERR "$httperf_command\n" if $DEBUG;
152
153    open (IN,  "$httperf_command |")
154	or die "Cannot execute httperf\n";
155    while(<IN>) {
156	if (/^Total: .*replies (\d+)/) {
157	    $results{replies}=$1;
158	}
159	if (/^Connection rate: (\d+\.\d)/) {
160	    $results{conn_rate}=$1;
161	}
162	if (/^Request rate: (\d+\.\d)/) {
163	    $results{req_rate}=$1;
164	}
165	if (/^Reply rate .*min (\d+\.\d) avg (\d+\.\d) max (\d+\.\d) stddev (\d+\.\d)/) {
166	    $results{rep_rate_min} = $1;
167	    $results{rep_rate_avg} = $2;
168	    $results{rep_rate_max} = $3;
169	    $results{rep_rate_stdv} = $4;
170	}
171	if (/^Reply time .* response (\d+\.\d)/) {
172	    $results{rep_time} = $1;
173	}
174	if (/^Net I\/O: (\d+\.\d)/) {
175	    $results{net_io} = $1;
176	}
177	if (/^Errors: total (\d+)/) {
178	    $results{errors} = $1;
179	}
180	print $_ unless $$config_ref{quiet};
181    }
182    close (IN);
183
184    if ($results{replies} == 0) {
185	print STDERR "Zero replies received, test invalid: rate $rate\n";
186	$results{percent_errors} = 101;
187    }
188    else {
189	$results{percent_errors} = ( 100 * $results{errors} / $results{replies} );
190    }
191    return \%results;
192}
193
194sub
195print_header
196{
197    my ($config_ref, $sep, $out_stream) = @_;
198    my %config = %{$config_ref};
199
200    # The following is really quite ugly...
201    print $out_stream "dem_req_rate".$sep.
202        "req_rate_$config{host1}".$sep.
203        "con_rate_$config{host1}".$sep.
204        "min_rep_rate_$config{host1}".$sep.
205        "avg_rep_rate_$config{host1}".$sep.
206        "max_rep_rate_$config{host1}".$sep.
207        "stddev_rep_rate_$config{host1}".$sep.
208        "resp_time_$config{host1}".$sep.
209        "net_io_$config{host1}".$sep.
210        "errors_$config{host1}";
211
212    if ($config{single_host}) {
213        print $out_stream "\n";
214    }
215    else {
216        print $out_stream $sep."req_rate_$config{host2}".$sep.
217            "con_rate_$config{host2}".$sep.
218            "min_rep_rate_$config{host2}".$sep.
219            "avg_rep_rate_$config{host2}".$sep.
220            "max_rep_rate_$config{host2}".$sep.
221            "stddev_rep_rate_$config{host2}".$sep.
222            "resp_time_$config{host2}".$sep.
223            "net_io_$config{host2}".$sep.
224            "errors_$config{host2}\n";
225    }
226}
227
228#--------------------------------------------------------------------------
229# Main
230
231# Declarations
232my ($curr_rate, $sep);
233my (%res_host1, %res_host2, $dem_req);
234
235# Get configuration from config file
236my %config = get_config($CONFIG_FILE);
237
238# Override config file with options supplied on the command line.
239GetOptions( \%config, "host1:s","host2:s","uri1:s","uri2:s","port1:i",
240            "port2:i","low_rate:i","high_rate:i","rate_step:i","num_conn:i",
241            "num_call:i","timeout:i","quiet","single_host","debug",
242	    "output_fmt=s","file=s","version", "const_test_time:i");
243
244if ($config{version}) {
245    print "Autobench $VERSION\nCopyright (C) Julian T. J. Midgley <jtjm\@xenoclast.org> 2003\n";
246    exit 0;
247}
248
249$DEBUG = 1 if ($config{debug});
250
251if ( $config{output_fmt} eq 'csv' ) {
252    $sep = ",";
253}
254elsif ( $config{output_fmt} eq 'tsv' ) {
255    $sep = "\t";
256}
257else {
258    die "Output Format '$config{output_fmt}' not supported";
259}
260
261# Check that httperf is in our path
262system("which httperf > /dev/null") == 0
263    or die 'Cannot find httperf in $PATH; please ensure it is installed and your PATH is'."\ncorrectly set\n";
264
265# Basic input checking
266check_present(\%config, qw(low_rate high_rate rate_step host1 uri1 port1));
267check_host($config{host1});
268unless ($config{single_host}) {
269    check_present(\%config, qw(host2 uri2 port2));
270    check_host($config{host2});
271}
272if ($config{const_test_time} && $config{const_test_time} < 10) {
273    die "--const_test_time must be >= 10. See autobench(1) for details\n";
274}
275
276# Set the output stream correctly
277if ($config{file}){
278    # Filename supplied with --file option, try to open it for writing.
279    open(OUT, ">$config{file}") or die "Cannot open $config{file} for writing\n";
280}
281else {
282    # Connect OUT to STDOUT
283    open(OUT, ">&STDOUT") or die "Bizarre, cannot connect OUT to STDOUT!";
284}
285
286# Print first line of output
287
288print_header(\%config, $sep, \*OUT);
289
290# Conduct the tests
291
292for ($curr_rate = $config{low_rate}; $curr_rate <= $config{high_rate};
293     $curr_rate += $config{rate_step}) {
294
295    if ($config{const_test_time}) {
296        $config{num_conn} = $curr_rate * $config{const_test_time};
297    }
298    # Test Host 1
299    %res_host1 = %{test_host (\%config, $curr_rate, $config{host1}, $config{uri1}, $config{port1})};
300
301    # Test Host 2
302    unless ( $config{single_host} ) {
303	%res_host2 = %{test_host (\%config, $curr_rate, $config{host2}, $config{uri2}, $config{port2})};
304    }
305
306    # Merge and Display Results
307    $dem_req = ($config{num_call} * $curr_rate);
308    print OUT $dem_req.$sep.
309	  $res_host1{req_rate}.$sep.
310	  $res_host1{conn_rate}.$sep.
311	  $res_host1{rep_rate_min}.$sep.
312	  $res_host1{rep_rate_avg}.$sep.
313	  $res_host1{rep_rate_max}.$sep.
314	  $res_host1{rep_rate_stdv}.$sep.
315          $res_host1{rep_time}.$sep.
316	  $res_host1{net_io}.$sep.
317          $res_host1{percent_errors};
318    if ($config{single_host}) {
319	print OUT "\n";
320    }
321    else {
322	print OUT $sep.$res_host2{req_rate}.$sep.
323	  $res_host2{conn_rate}.$sep.
324	  $res_host2{rep_rate_min}.$sep.
325	  $res_host2{rep_rate_avg}.$sep.
326	  $res_host2{rep_rate_max}.$sep.
327	  $res_host2{rep_rate_stdv}.$sep.
328	  $res_host2{rep_time}.$sep.
329	  $res_host2{net_io}.$sep.
330	  $res_host2{percent_errors}."\n";
331    }
332
333}
334
335close (OUT);
336