#!/usr/local/bin/perl # # # (C) 1997 Standard Performance Evaluation Corporation # # Revised 06/05/98 - Paula # Added support for Custom Ad Rotation model: Dynamic GET w/Cookie # Created 3 Dynamic URLS to support POST, GET, and GET w/cookie # will default to use DYNAMIC_ROOT (POST) if others not specified # Add percentage for GET w/cookie to loadload data. Also fixed # defaults for other percentages and changed lg_proc and lg_num to # use actual test values to avoid configuration description errors. # # Revised 09/23/98 - Paula, Keti, Yea-Cheng # Ketii: Added client logging option; use -l option to invoke. # Yea-Cheng: Improved post log validation to check for serialization # across all clients not just within each client (ie. check # that the record id increases after each entry). This is # in keeping with the 2.1.2 SUT run rule where the result of # any dynamic request must be visible to any client on any # subsequent dynamic request. # Paula: Added urlroot to list of parameters passed on Reset command, # this will be used in WEB98_INC processing. # Updated parameters used for dynamic script designation - # allow use of 4 separate RC parameters to specify COMMAND's, # simple dynamic GET's, dynamic GET's for Custom Ad Rotation # model and POST's # Add minor bug fixes. # # Revised 02/01/99 - Yea-Cheng # Support the new SIMULTANEOUS_CONNECTIONS in the rc file. LOAD_VALUES and # PROCS are no more supported. In the rc file, a client can be configured # as name(port)[speed]. # # # SIMULTANEOUS_CONNECTIONS replaces LOAD_VALUES in the sense that the # number of connections will be distributed among all the clients as the # requested workload of a client. The speed of a client will be taken # into consideration when calculating the workload distribution. On a # client system, there will be as many number of processes/threads # created as the requested workload. Each of these processes/threads # will send requests to the SUT in a contiguous manner. # # Support the new USER_LINE_SPEED, and USER_SPEED_LIMIT in the rc file. # Every Client process/thread will not start another operation until enough # time has elapsed so that all the bytes received from the SUT can be # transmitted over the user dial up line. The speed of the dialup line # (USER_LINE_SPEED) will determine that elapsed time. The connection to # the SUT will remain open for that period of time. # # Based on the average size of SPECweb fileset files, at the user # dialup line speed of 400000bits/secs, each connection can get about # 3 OPS/sec. SIMULTANEOUS_CONNECTIONS will therefore determine the scope # of the file_set directories every client will access in a single run. # # Process the new result data: rate, rate2, and aggregate_bytes. # Report the new result in terms of the number of simultaneous connections, # the aggregate bit rate, the throughput, and the statistical # distributions of bit rates in raw, ascii, and screen formats. # # Other changes: unlink 'post.log' file before fetching it from the server. # # Revised 2/24/99 - Ruth Morgenstein # Changed the way run data from each point is passed around. There # used to be 3 pieces of data in the 'config' structure (connections, # throughput, and avg. response). There's more data than that, so # I replaced those 3 fields with an associative array containing # all the relevant data. Having this array, makes it easy to change # what data gets passed around. # # # Revised 2/26/99 - Ruth Morgenstein # Added code to support ITERATIONS. For each point in SIMULTANEOUS_ # CONNECTIONS, it will be repeated ITERATIONS times. Each group if # ITERATIONS is a separate test. For each group, WARMUP_TIME done # before the 1st point and the new parameter RAMPUP_TIME is done # before iterations 2 through n. # # The reported result is the median value. # # Revised 3/11/99 - Ruth Morgenstein # Add checking for required values to make sure the test will be valid. # Added -C flag, to make all required values conforming # Added validation code to check all paths for GETs and POSTS # Changed SPECweb98 to SPECweb99 in ASCII output # Better error reporting # # # require 5.005; use Getopt::Std; use IO::Select; use Time::localtime; use LWP::UserAgent; use strict; use IO::Socket; use IO::File; use Compress::Zlib; use MIME::Base64; use Cwd; use WebClient; sub Log; sub client_log; ############################################################################## # Set up global variables ############################################################################## use vars qw ($perfcnt); use vars qw(@info @config_files %formatter $default_config_file $output_dir); $default_config_file = "rc"; use vars qw(@info @config_files %formatter $default_config_file $MAX_ERROR_RATE $MIX_TOLERANCE $MIN_WARMUP_TIME $MIN_CONFORM_PCT $REQ_ITERATIONS $REQ_RUN_TIME $REQ_RAMPUP_TIME $REQ_RAMPDOWN_TIME $REQ_DYNAMIC_CONTENT $REQ_DYNAMIC_POST $REQ_DYNAMIC_CAD_GET $REQ_DYNAMIC_CGI_GET $REQ_REQUESTS_PER_KEEP_ALIVE $REQ_PERCENT_KEEP_ALIVE_REQUESTS $REQ_ABORTIVE_CLOSE $REQ_USER_LINE_SPEED $REQ_USER_SPEED_LIMIT $REQ_MAX_FILE $REQ_WAIT_BETWEEN_POINTS $ERROR_CHECK_RANGE $FILES_PER_CLASS $MB_PER_DIRECTORY); $MAX_ERROR_RATE = .0104999999; # dependant upon %.3f formatting $MIX_TOLERANCE = .1049999999; # dependant upon %.3f formatting $MIN_WARMUP_TIME = 1200; $MIN_CONFORM_PCT = 95; $REQ_ITERATIONS = 3; $REQ_RUN_TIME = 1200; $REQ_RAMPUP_TIME = 300; $REQ_RAMPDOWN_TIME = 300; $REQ_DYNAMIC_CONTENT = 0.3; $REQ_DYNAMIC_POST = 0.16; $REQ_DYNAMIC_CAD_GET = 0.42; $REQ_DYNAMIC_CGI_GET = .005; $REQ_REQUESTS_PER_KEEP_ALIVE = 10; $REQ_PERCENT_KEEP_ALIVE_REQUESTS = 0.7; $REQ_ABORTIVE_CLOSE = 0; $REQ_USER_LINE_SPEED = 400000; $REQ_USER_SPEED_LIMIT = 320000; $REQ_MAX_FILE = 8; $REQ_WAIT_BETWEEN_POINTS = 0; $ERROR_CHECK_RANGE = .25; $FILES_PER_CLASS = 9; $MB_PER_DIRECTORY = 4.88; use vars qw($verbose $output_types @output_types $ignore_errors $compliant $rawformat $logclient $file_num $test_time $version $rcs_version $max_load @configs $short_version $details); use vars qw( @network_fields @clients_fields @bm_config_fields @notes_fields ); &init_output; @info = ( @network_fields, @clients_fields, @bm_config_fields, @notes_fields, ); $verbose = 10; $output_types=""; $logclient = 1; $details = 0; $test_time = time; $version = "99-v1.0"; ($short_version)= $version =~ m/([\d.]+-)/; $rcs_version = q#$Id: manager,v 1.30 1999/06/29 20:30:12 ruth Exp $#; # # A note on the @configs data structures. # # @configs is an array of inputs and results from each config file. # A config file can either be an "rc" file that gets used to run a test, # or a raw file that gets read in for post-processing. # We typically operate on 1 $config within @configs at a time # # Each $config a reference to a hash containing inputs and results from a # series of points # # Each $config hash has a key for each input from the rc file. For example, # $config->{'WARMUP_TIME'} is used to hold the WARMUP_TIME that was input # from the rc file. In addition, there are 2 substructures, used to hold # output data from the test: # 'results' # 'errors' # # The 'results' key contains an array, @results, with each element of the array # representing the results from an individual run within the series of # tests. # Each array element $results in the @results array contains an array, with each # entry as the following # $results[0] %run_stats - hash of statistics from the point # $results[1] $run_number - (this ought match the index of @results) # $results[2] $unused field # $results[3] @class_results - per class rollup info # $results[4] @errors - errors for this run # # # The %run_stats contains the following keys: # connections, invalid, conforming, conform_pct, throughput, # ops_per_thread, response, bitrate, cum_conformance # # So, to roll things up, here's an example of getting to a run stat, for the # 5th point in a test # $config->{'results'}[4][0]{'conforming'} # # My advice: use lots of temporaries # # -- Ruth if (! exists $ENV{'SPEC'}) { die "\nERROR: environement variable \$SPEC not defined.\n" . "Do \". shrc\" in sh or \"shrc.bat\" from NT to setup SPEC environment\n\n"; } if (! -e "$ENV{'SPEC'}/bin/fonts") { die "\nERROR: SPEC environment not properly installed.\n" . "Can't find \$SPEC/bin/fonts directory\n\n"; } # Make sure the results directory exists $output_dir = "results/"; mkdir $output_dir, 0755 if ! -d $output_dir; # Initialize HTTP useragent my $ua = new LWP::UserAgent; $ua->agent("SPECweb/$short_version " . $ua->agent); # Open up the log file my $file_num = &find_next_number($output_dir); my $log_file = "res.$file_num"; open (LOG, ">$output_dir$log_file") || die "Can't open log file '$log_file': $!\n"; select((select(LOG),$|=1)[0]); # Unbuffer LOG file Log (10, "\nOpened logfile $output_dir$log_file\n"); # die " #$ENV{'SPEC'}/bin/fonts") if exists $ENV{'SPEC'}; sub usage { print <$output_dir$cllog_file") || die "Can't open client log file '$cllog_file': $!\n"; select((select(CLLOG),$|=1)[0]); # Unbuffer client log file Log (10, "\nOpened client logfile $output_dir$cllog_file\n"); } # These are the valid formatters, to add a new formatter just write the # function and add it here. $formatter{'asc'} = \&write_asc; $formatter{'screen'} = \&write_screen; $formatter{'raw'} = \&write_raw; # If no config file was specified, use the efault push (@config_files, $default_config_file) if (!@config_files); # Rawformat is the process of taking a .raw file and outputting any of # the defined output formats. This is used so that people don't have # to create all of the different outputs they desire at once. They can # produce any output from a .raw file. Also useful for fixing up # incorrect notes and things. if ($rawformat) { # for all of the files (not actually config files) specified on the # command line for my $config_file (@config_files) { local(*FILE); open (FILE, "<$config_file") || die "Cannot open '$config_file'"; my @foo=(); # Grab the raw data out of the file while () { push (@foo, $_) if /^(%% )?BEGIN SPECWEB99/ .. /^(%% )?END SPECWEB99/; } close(FILE); if ($#foo < 0) { print STDERR "******\n$config_file is not a valid raw file\n"; next; } # strip any comment and character escaping that might have been # done. We comment for Postscript and PDF and escape for HTML. @foo = grep(!m/(%% )?(BEGIN|END) SPECWEB99/, @foo); grep(s/^\s*%%\s*//, @foo); grep(s/\<//g, @foo); grep(s/\&/\&/g, @foo); # Read in the config file, we use a special option to mark this # as a read of a raw file. my $config = config_read(\@foo, 1); my ($num) = $config_file =~ m/^.*\.(\d+)\.raw$/; &do_outputs($config, $num, $output_dir); } # If rawformatting that's all we do exit (0); } # Read in and parse all the config files and find the maximum load value $max_load = 0; for (@config_files) { my ($req, $res, $url); #as we read each config file, we save its info as an entry in @configs my $config = config_read($_); push (@configs, $config); # Make sure that for each config file, we can actually do all the # operations (Static GET, Dyn GET, Dyn CGI GET, Dyn CAD GET, Dyn POST) Log(5, "\nValidating all paths for $config->{'FILENAME'}\n"); &verify_all_HTTP_operations($config); Log(5, "\n"); } # Run all of the separate config files for my $config (@configs) { # &validate_config($config); #For multiple iterations, monkey with the SIMULTANEOUS CONNECTIONS #parameter to make separate tests for each point if ($config->{'ITERATIONS'} > 1) { my @saved_connections_list = @{$config->{'SIMULTANEOUS_CONNECTIONS'}}; foreach my $point (@saved_connections_list) { $config->{'results'} = []; $config->{'errors'} = []; &validate_config($config); @{$config->{'SIMULTANEOUS_CONNECTIONS'}} = (); for (my $i = 0; $i < $config->{'ITERATIONS'}; $i++) { push (@{$config->{'SIMULTANEOUS_CONNECTIONS'}} ,$point); } run_all ($config); &do_outputs($config, $file_num, $output_dir); $file_num++; } } #If single iteration, then just run all the points -- this is really #just a testing mode, not something that can be done in a submittable test else { &validate_config($config); run_all($config); &do_outputs($config, $file_num, $output_dir); $file_num++; } } ############################################################################## # Config file routines ############################################################################## # Initialize configuration file to have default values sub config_init { Log(30, 'init_config\n'); my $config = {}; &set_required_parameters($config); $config->{'SIMULTANEOUS_CONNECTIONS'} = 10; $config->{'SUCCESSIVE_SPEED_LIMITS'} = 0; $config->{'LOAD_FILL'} = 0; $config->{'CLIENTS'} = 'client1'; $config->{'URL_ROOT'} = 'http://server/spec/file_set'; $config->{'DYNAMIC_ROOT'} = 'http://server/spec/cgi-bin/dynamic?'; $config->{'DYN_CMD_SCRIPT'} = ''; $config->{'DYN_GET_SCRIPT'} = ''; $config->{'DYN_CAD_SCRIPT'} = ''; $config->{'DYN_CGI_SCRIPT'} = ''; $config->{'DYN_POST_SCRIPT'} = ''; $config->{'HTTP_PROTOCOL'} = ''; $config->{'SERVER'} = "server"; $config->{'OUTPUT_NAME'} = "output"; # $config->{'LOG_SUFFIX'} = ".err"; $config->{'WAIT_TO_BEGIN'} = 5; $config->{'WAIT_BETWEEN_POINTS'} = 0; $config->{'OUTPUT_TYPE'} = "all"; $config->{'Volume'} = '--'; $config->{'Issue'} = '--'; $config->{'Page'} = '--'; $config->{'munge_date'} = 1; # $config->{'detail'} = 1; #Turn on more data in ASCII for (@info) { $config->{$_->[1]} = ''; } return $config; } sub set_required_parameters { my ($config) = @_; $config->{'USER_LINE_SPEED'} = $REQ_USER_LINE_SPEED; $config->{'USER_SPEED_LIMIT'} = $REQ_USER_SPEED_LIMIT; $config->{'RUN_TIME'} = $REQ_RUN_TIME; $config->{'RAMPDOWN_TIME'} = $REQ_RAMPDOWN_TIME; $config->{'RAMPUP_TIME'} = $REQ_RAMPUP_TIME; $config->{'DYNAMIC_CONTENT'} = $REQ_DYNAMIC_CONTENT; $config->{'DYNAMIC_POST'} = $REQ_DYNAMIC_POST; $config->{'DYNAMIC_CAD_GET'} = $REQ_DYNAMIC_CAD_GET; $config->{'DYNAMIC_CGI_GET'} = $REQ_DYNAMIC_CGI_GET; $config->{'REQUESTS_PER_KEEP_ALIVE'} = $REQ_REQUESTS_PER_KEEP_ALIVE; $config->{'PERCENT_KEEP_ALIVE_REQUESTS'} =$REQ_PERCENT_KEEP_ALIVE_REQUESTS; $config->{'MAX_FILE'} = $REQ_MAX_FILE; $config->{'ABORTIVE_CLOSE'} = $REQ_ABORTIVE_CLOSE; $config->{'ITERATIONS'} = $REQ_ITERATIONS; $config->{'WAIT_BETWEEN_POINTS'} = $REQ_WAIT_BETWEEN_POINTS; $config->{'WARMUP_TIME'} = $MIN_WARMUP_TIME if $config->{'WARMUP_TIME'} < $MIN_WARMUP_TIME; } # Read in a configuration file # $file may be a filename or an reference to the array containing # the file. sub config_read { my($file, $rawread) = @_; my ($key, $value, $num, @lines); Log(30, "Reading Config file\n"); # Initializes the default values for the config file. my $hash = config_init(); # If it's an array then just use it, otherwise read in the file. if (ref($file) eq "ARRAY") { @lines = @$file; } else { $hash->{'FILENAME'} = $file; my $fh = new IO::File "< $file"; die "Can't open file '$file': $!\n" if (!defined $fh); @lines = $fh->getlines; $fh->close; } # Put any option=val arguments at the bottom so they override the # values in the config file. push (@lines, @ARGV); my @rawlines = grep(!m/^\s*[#;]>/, @lines); # If we are reading a .raw file, we need to define some values so # that they won't be interpreted as errors if ($rawread) { for (qw(median_index median_results metric test_time WORK_DIR FILENAME MAX_LOAD version total_speed rcs_version rawconfig)) { $hash->{$_} = '--'; } $hash->{'results'} = []; $hash->{'errors'} = []; } # Parse the actual file for (@lines) { if (m/^\s*$/ || m/^\s*[#;]/) { # Comments and blank lines are ignored } elsif (m/^\s*(\S+)\s*=\s*"(.*)"\s*$/ || m/^\s*(\S+)\s*=\s*(.*\S)\s*$/ || m/^\s*(\S+)\s*=\s*(.*)/){ # key=value, key="value" are accepted ($key, $value) = ($1, $2); # Check to see if the key is in the form of label### these # are treated specially $num = -1; if ($key =~ m/(.*\D)(\d+)/) { ($key, $num) = ($1, $2); } # If the key is results then we have to parse the line to # fill out our data if ($key eq "results") { # Make sure we have somewhere to put the data if (!defined $hash->{'results'}[$num]) { $hash->{'results'}[$num] = []; $hash->{'results'}[$num][0] = {}; # %run_stats $hash->{'results'}[$num][1] = $num; # $run_num $hash->{'results'}[$num][2] = "unused_field"; $hash->{'results'}[$num][3] = []; # @class_results $hash->{'results'}[$num][4] = []; # @errors } # For quick reference my $res = $hash->{'results'}[$num]; # Find out our subkey so we can put the data in the # right place my ($subkey, $val); if (($subkey, $val) = $value =~ m/(\S+)\s+(.*)/) { #find error strings if ($subkey eq "error") { push (@{$res->[4]}, $val) ; } #find per class statistics elsif ($subkey eq "class") { my ($class_num, $class_name, $class_data) = $val =~ m/^(\d+)\s+"(.*)"\s+(.*)/; $res->[3][$class_num] = [ $class_name, split(" ", $class_data) ]; } else { # all the rest are other result statistics $res->[0]{$subkey} = $val; } } else { Log(10, "Can't parse line: $_\n"); next; } } elsif (!defined $hash->{$key}) { # We make sure that there aren't any typos by only # accepting keys which we have defined for the user $num = '' if ($num == -1); Log(10, "Key '$key$num' is unknown. Ignoring.\n"); } else { # If it was in the form label### assign the value to # the correct index in the entry, otherwise just assign # the value. #if ($num ne "") { if ($num != -1) { if (ref($hash->{$key}) ne "ARRAY") { $hash->{$key} = [$hash->{$key}]; } $hash->{$key}->[$num] = $value; } else { $hash->{$key} = $value; } } } else { Log(10, "Can't parse $.: $_\n"); } } $hash->{'metric'} = 'SPECweb99'; if (!$rawread) { chomp(@rawlines); chomp(@rawlines); my $rawtxt = join("\n", @rawlines); my $cmptxt = Compress::Zlib::memGzip($rawtxt); my $md5txt = encode_base64($cmptxt); $hash->{'rawconfig'} = [ split("\n", $md5txt) ]; } # Fix up a bunch of values &finalize_config($hash,[qw(SIMULTANEOUS_CONNECTIONS CLIENTS)]) if !$rawread; # If $compliant asked for, then change the parameters to valid values if ($compliant && !$rawread) { Log (10, "\nSetting all required parameters to legal values\n\n"); &set_required_parameters($hash); } # Any descriptive information which doesn't have a label gets # assigned two dashes for (@info) { my $key = $_->[1]; $hash->{$key} = "--" if ($hash->{$key} =~ /^\s*$/); } # The 'errors' field in @notes_field in @info shouldn't # get preloaded with '--'. We want it to be an array delete $hash->{'errors'} if !$rawread; return $hash; } # Fix up the data from the config file sub finalize_config { Log(30, "finalize_config\n"); my ($hash, $multi) = @_; my ($key, %load, $step, $fudge_step, $fudge, $num, $bad, $i); # Turn multi-valued entries into an arrays so we can fetch data out easily for $key (@$multi) { if (ref($hash->{$key}) eq "") { $hash->{$key} = [grep(!/^\s*$/, split(/ |,/, $hash->{$key}))]; } } $hash->{'OUTPUT_TYPES'} = join (",", grep(!/^\s*$/, split(/ |,/, $hash->{'OUTPUT_TYPES'}))); # Make sure we have version information $hash->{'version'} =$version if !defined $hash->{'version'}; $hash->{'rcs_version'}=$rcs_version if !defined $hash->{'rcs_version'}; # Check to see if MSL and TIME_WAIT were RFC compliant ($hash->{'msl'}) = $hash->{'msl'} =~ /(\d+)/; ($hash->{'time_wait'}) = $hash->{'time_wait'} =~ /(\d+)/; $hash->{'msl'} .= ' (Non RFC1122)' if $hash->{'msl'} < 120; $hash->{'time_wait'} .= ' (Non RFC1122)' if $hash->{'time_wait'} < 240 || $hash->{'time_wait'}/$hash->{'msl'} < 2; # Record where this took place $hash->{'WORK_DIR'} =cwd if ($hash->{'WORK_DIR'} eq ""); # Set individual DYN parameters if the 1-size-fits-all DYNAMIC_ROOT was used if ($hash->{'DYN_GET_SCRIPT'} eq '') { $hash->{'DYN_GET_SCRIPT'} = $hash->{'DYNAMIC_ROOT'} } if ($hash->{'DYN_CAD_SCRIPT'} eq '') { $hash->{'DYN_CAD_SCRIPT'} = $hash->{'DYNAMIC_ROOT'} } if ($hash->{'DYN_POST_SCRIPT'} eq '') { $hash->{'DYN_POST_SCRIPT'} = $hash->{'DYNAMIC_ROOT'} } if ($hash->{'DYN_CMD_SCRIPT'} eq '') { $hash->{'DYN_CMD_SCRIPT'} = $hash->{'DYNAMIC_ROOT'} } # Get rid of the '?' and anything following it ($hash->{'DYN_CMD_SCRIPT'} = $hash->{'DYN_CMD_SCRIPT'}) =~ s/\?.*$//; print "$hash->{'DYN_CMD_SCRIPT'} \n"; # This code is from before we had reasonable RAMP_DOWN values # Set some really long value for WAIT_BETWEEN_POINTS. Hopefully to # allow all of the sockets to shut down gracefully. # if ($hash->{'WAIT_BETWEEN_POINTS'} eq "" && $hash->{'time_wait'} > 0) { # $hash->{'WAIT_BETWEEN_POINTS'} = $hash->{'time_wait'}; # } #expand any ranges in simultaneous_connections string and store list @{$hash->{'SIMULTANEOUS_CONNECTIONS'}} = &expand_ranges(@{$hash->{'SIMULTANEOUS_CONNECTIONS'}}); $hash->{'MAX_LOAD'} = &max(@{$hash->{'SIMULTANEOUS_CONNECTIONS'}}); # Make sure that we have 10 evenly spaced points %load = map {$_ => 1} @{$hash->{'SIMULTANEOUS_CONNECTIONS'}}; my $max = $hash->{'MAX_LOAD'}; if ($max < 10 && $hash->{'LOAD_FILL'}) { Log(5, "Can't make 10 evenly spaced points for a load of less than 10\n"); } # Store the load in order @{$hash->{'SIMULTANEOUS_CONNECTIONS'}} = sort { $a <=> $b } keys %load; $hash->{'test_time'} = $test_time; # Parse the client names. See if they've overridden the port to # connect to, or if they've specified a relative speed rating $hash->{'clients_parsed'} = []; $hash->{'total_speed'} = 0; Log(10, "\nCLIENT LIST: \n"); $i = 1; for (@{$hash->{'CLIENTS'}}) { my ($name, $port, $speed, $host); ($port) = m/\((\d*)\)/; # () ($speed) = m/\[([\d.]*)\]/; # [] ($host) = m/\{([^<{([\])}>]*)\}/; # {} ($name) = m/^([^<{([\])}>]+)/; $speed = 1 if $speed eq "" || $speed <= 0; Log(10, " Client $i: name=$name, port=$port, speed=$speed, host=$host\n"); $hash->{'total_speed'} += $speed; push (@{$hash->{'clients_parsed'}}, [$name, $port, $speed, $host]); $i++; } } ############################################################################## # Do the actual runs ############################################################################## sub run_all { Log(30, "run_all\n"); my ($config) = @_; #my (@values) = &expand_ranges(@{$config->{'SIMULTANEOUS_CONNECTIONS'}}); my (@values) = @{$config->{'SIMULTANEOUS_CONNECTIONS'}}; my $num_runs = 1; my $max_run = @values; # my @results; # Do a run for each requested load value for (my $i = 0; $i < @values; $i++) { my $load = $values[$i]; # while (@values) { # my $load = shift @values; my $date = &date; #for multiple iterations, the 1st point does a long warmup, #and the rest of the points do a short rampup my $test_warmup = $config->{'WARMUP_TIME'}; my ($tmp_string) = "Point $num_runs"; if ($config->{'ITERATIONS'} > 1 ) { $tmp_string = "Iteration $num_runs of $config->{'ITERATIONS'}"; if ( $i > 0) { $test_warmup = $config->{'RAMPUP_TIME'}; } } $tmp_string = sprintf("\n%s with load of %d connections\n%s\n", $tmp_string, $load, $date); Log (10, $tmp_string); &client_log($tmp_string) if $logclient; my $num_clients = @{$config->{'CLIENTS'}}; Log 101, <{'RUN_TIME'} EOT my $rc = run_one($config, $load, $num_runs++, $test_warmup); if (!defined $rc) { &Log(10, "Error running with load of $load\n"); return undef if !$ignore_errors; } if (@values) { &Log(20, "Waiting for $config->{'WAIT_BETWEEN_POINTS'} seconds between points\n"); sleep ($config->{'WAIT_BETWEEN_POINTS'}); } } &validate_results($config); #Log(10, "Finding median result\n"); ($config->{'median_index'},$config->{'median_results'}) = &find_median_result($config); # my(%med_run_stats)= %{$config->{'results'}[$config->{'median_index'}][0]}; # $config->{'bm_requested_conn'} = $med_run_stats{'requested_conn'}; # $config->{'bm_fileset_size'} = $MB_PER_DIRECTORY * # &dirs_from_load($config, $med_run_stats{'requested_conn'}); } # Run one data point sub run_one { Log(30, "run_one\n"); my ($config, $load, $num, $test_warmup) = @_; my ($i, $j, $exe, $hostname, $client, @clients); my (%tmp, $tmp, @errors, $class); my ($ts, $ts1, $ts2); my $num_clients = @{$config->{'CLIENTS'}}; my $total_speed = $config->{'total_speed'}; my $client_num = 0; my $expired_list = '' ; my @client_loads; #Calculate the total load with regard to the weightings my $total_load; my $wtload = 0; for my $data (@{$config->{'clients_parsed'}}) { my ($hostname, $port, $speed, $clients_server) = @$data; my $client_load = int ($load * ($speed/$total_speed)); if ($client_load > $wtload) { $wtload = $client_load; } $total_load += $client_load; push (@client_loads, $client_load); next if $client_load <= 0; } my $maxthread = $num_clients * $wtload; # If the total load is not evenly divisible by the clients # and their weightings, then distribute the extra processes my $delta_load = $load - $total_load; for (; $delta_load > 0; $delta_load--) { @client_loads[$delta_load]++; } # Initialize the POST and Get w/Cookie data on the server if necessary if ($config->{'DYNAMIC_POST'} > 0 || $config->{'DYNAMIC_CAD_GET'} > 0 ) { my ($req, $res, $dynamic_url); $ts = time; $ts1 = $ts % 360; $ts2 = $ts1 + 100; if ($ts2 > 359) { $ts = $ts2 - 360; $ts2 = $ts1; $ts1 = $ts; } $expired_list = $ts1 . ',' . $ts2; # For the command/Reset, we don't want any other argument pieces # so delete everything after the first '?' and append the command. $dynamic_url = $config->{'DYN_CMD_SCRIPT'}; $dynamic_url =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; my $pttime = $config->{'RUN_TIME'} + $test_warmup + $config->{'RAMPDOWN_TIME'}; my $tmp_url_root = $config->{'URL_ROOT'}; $tmp_url_root =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $req = new HTTP::Request 'GET' => $dynamic_url . '?command/Reset' . '&maxload=' . $max_load . '&pttime=' . $pttime . '&maxthread=' . $maxthread . '&exp=' . $expired_list . '&urlroot=' . $tmp_url_root; $req->header('Accept' => '*/*'); $res = $ua->request($req); if (!$res->is_success) { die "Can't reset POST log on server, make sure cgi script\n" . "DYNAMIC_ROOT (or DYN_CMD_SCRIPT) is configured correctly!\n" . "Error: " . $res->code . " " . $res->message, "\n"; } } # Open and initialize each client my $data; my $clientnum = 0; for my $data (@{$config->{'clients_parsed'}}) { my ($hostname, $port, $speed, $clients_server) = @$data; if ($clients_server eq '') { $clients_server = $config->{'SERVER'}; } $port = 'specweb(2222)' if $port eq ""; my $client_load = shift (@client_loads); next if $client_load <= 0; Log(30, "Opening client '$hostname'\n"); my $client = WebClient->new(PeerAddr => $hostname, PeerPort => $port, Proto => 'tcp'); die "Can't open socket to '$hostname'\n" if (!defined $client); # If the hostname has already been seen, then add a modifier to # the end in the hopes that we can make unique names. my $tmp = $hostname; if ($tmp{$tmp}++) { $tmp .= "-".$tmp{$tmp}++; } # Wait until this client is ready and that the version of the # daemon on each client matches this manager script wait_until_ready([ $client ]); if ($client->identity() ne "SPEC-WEB-$version") { die "Client $client_num($hostname) is not running version $version of the SPEC daemon!\n"; } # Configure this client my $max_dir = dirs_from_load($config, $load); my $tmp_url_root = $config->{'URL_ROOT'}; my $tmp_dyn_post_script = $config->{'DYN_POST_SCRIPT'}; my $tmp_dyn_get_script = $config->{'DYN_GET_SCRIPT'}; my $tmp_dyn_cad_script = $config->{'DYN_CAD_SCRIPT'}; my $tmp_dyn_cgi_script = $config->{'DYN_CGI_SCRIPT'}; $tmp_url_root =~ s/\@\@SERVER\@\@/$clients_server/e; $tmp_dyn_post_script =~ s/\@\@SERVER\@\@/$clients_server/e; $tmp_dyn_get_script =~ s/\@\@SERVER\@\@/$clients_server/e; $tmp_dyn_cad_script =~ s/\@\@SERVER\@\@/$clients_server/e; $tmp_dyn_cgi_script =~ s/\@\@SERVER\@\@/$clients_server/e; $client->workload99 ($tmp_url_root, $tmp_dyn_post_script, $tmp_dyn_get_script, $tmp_dyn_cad_script, $tmp_dyn_cgi_script, $max_dir, $config->{'MAX_FILE'}, $config->{'DYNAMIC_CONTENT'}, $config->{'DYNAMIC_POST'}, $config->{'DYNAMIC_CAD_GET'}, $config->{'DYNAMIC_CGI_GET'}, $config->{'PERCENT_KEEP_ALIVE_REQUESTS'}, $config->{'REQUESTS_PER_KEEP_ALIVE'}, $config->{'USER_LINE_SPEED'}, $config->{'USER_SPEED_LIMIT'}, $expired_list, "class0", "0.35", "class1", "0.50", "class2", "0.14", "class3", "0.01"); $client->set_server ($config->{'SERVER'}); $client->set_client ($tmp); $client->set_clientnum($clientnum++); $client->set_runtime ($config->{'RUN_TIME'}); $client->set_rampup ($test_warmup);; $client->set_rampdown ($config->{'RAMPDOWN_TIME'}) if $config->{'RAMPDOWN_TIME'}; $client->set_abortive_close ($config->{'ABORTIVE_CLOSE'}) if ($config->{'ABORTIVE_CLOSE'}); $client->set_loadgen ($client_load); # set the load in terms of OPS/sec: $client->set_load (($config->{'USER_LINE_SPEED'}/122000)*$client_load); my $protocol = $config->{'HTTP_PROTOCOL'}; if ($protocol =~ s#.*/##) { $protocol *= 10; $client->set_http_protocol($protocol); } else { die "Can't use HTTP_PROTOCOL '$config->{'HTTP_PROTOCOL'}'\n"; } $client->srandom (2331 + 256*$client_num++); # $client->workload ('workload'); $client->init (); $client->set_auto_advance(1); push (@clients, $client); } wait_until_ready(\@clients); sleep($config->{'WAIT_TO_BEGIN'}); # At this point in time all of the clients are ready to run. So we # just send the comand to kick them off. for (@clients) { $_->dorampup(); } wait_until_ready(\@clients); # Everybody is running now, queue up a few commands to run fetch # the results and then disconnect from the client. for (@clients) { $_->wait_advance('Result'); $_->fetch_results(); $_->quit(); } wait_until_ready(\@clients); # OKAY -- we're all done running this point/iteration, now # For the command/Finish, we don't want any other argument pieces # so delete everything after the first '?' and append the command. if ($config->{'DYNAMIC_POST'} > 0 || $config->{'DYNAMIC_CAD_GET'} > 0 ) { my ($req, $res, $dynamic_url); $dynamic_url = $config->{'DYN_CMD_SCRIPT'}; $dynamic_url =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $req = new HTTP::Request 'GET' => $dynamic_url . '?command/Finish'; $req->header('Accept' => '*/*'); $res = $ua->request($req); if (!$res->is_success) { die "Can't issue Finish on server\n"; } $perfcnt = $res->content; print $res->content . "\n"; } # Check to see that the post log looks okay my ($server_post_count_ref,$post_errors_ref); if ($config->{'DYNAMIC_POST'} > 0) { ($server_post_count_ref,$post_errors_ref) = &validate_post_log($config, $num); push (@errors, @$post_errors_ref); } # For each of the clients, sum all of the results for each class. my $cl_results = []; my $lg_res = []; my $successive_speed_limits = []; my $speed_limit_string; my $lg_cum_res = []; my $total_cum = []; my $total_missing_ops; my %run_stats; #Initialize min_bitrate to max possible speed $run_stats{'min_bitrate'} = $config->{'USER_LINE_SPEED'} + 1000; # Get results from each client for (@clients) { &client_log( "\n***** Client: $_->{'client'}\n") if $logclient; $lg_res = $_->{'lg_results'}; my(%client_run_stats); # Load generator status info $client_run_stats{'requested_conn'} = $_->loadgen(); $client_run_stats{'conforming'} = $lg_res->[1]; $client_run_stats{'invalid_conn'}=$client_run_stats{'requested_conn'} - $lg_res->[0]; $client_run_stats{'min_bitrate'} = $lg_res->[2] * 8; $client_run_stats{'mean_bitrate'} = $lg_res->[3] * 8; $client_run_stats{'max_bitrate'} = $lg_res->[4] * 8; $run_stats{'requested_conn'} += $client_run_stats{'requested_conn'}; $run_stats{'conforming'} += $client_run_stats{'conforming'}; $run_stats{'invalid_conn'} += $client_run_stats{'invalid_conn'}; if ($client_run_stats{'min_bitrate'} < $run_stats{'min_bitrate'}) { $run_stats{'min_bitrate'} = $client_run_stats{'min_bitrate'}; } if ($client_run_stats{'max_bitrate'} > $run_stats{'max_bitrate'}) { $run_stats{'max_bitrate'} = $client_run_stats{'max_bitrate'}; } # Look for generators that have 0 ops (i.e. 0 good, 0 bad); my (%no_ops, @opkeys, @text_results); @text_results = split (/\n/, $_->text_results()); for (@text_results) { # Log 130, "$_\n"; # pattern: 602 generator class time time2 good bad ... if (m/^602 (\d+) \d+ \d+ \d+ 0 0/) { $no_ops{$1} = 1; } } @opkeys = keys (%no_ops); $client_run_stats{'gens_missing_class_ops'} = @opkeys; $run_stats{'gens_missing_class_ops'} += @opkeys; # Cumulative conformance data $lg_cum_res = $_->{'lg_cum_results'}; for (my $i = 0; $i < @$lg_cum_res; $i++) { $client_run_stats{'cum_conformance'} .= sprintf("%6.2f ", ($lg_cum_res->[$i] / $client_run_stats{'requested_conn'})*100.0); $total_cum->[$i] += $lg_cum_res->[$i]; } # Successive speed limit string $successive_speed_limits = $_->{'successive_speed_limits'}; if (! $config->{'successive_speed_limits'}) { $config->{'SUCCESSIVE_SPEED_LIMITS'}= [@{$successive_speed_limits}]; $speed_limit_string = sprintf "@{$successive_speed_limits}"; } # Total up per class results my $tmp = $_->results(); for ($class = 0; $class < @$tmp; $class++) { $cl_results->[$class] = [] if !defined($cl_results->[$class]); # Don't subtotal name and probability fields $cl_results->[$class][0] = $tmp->[$class][0]; $cl_results->[$class][1] = $tmp->[$class][1]; # Subtotal all the other stats for ($j = 2; $j < @{$tmp->[$class]}; $j++) { $cl_results->[$class][$j] = 0 if !defined($cl_results->[$class][$j]); $cl_results->[$class][$j] += $tmp->[$class][$j]; } } #Printout class results for this client my (@misc_results) = &printout_class_results ($tmp, $config->{'RUN_TIME'},$num,"CLIENT"); for (qw(response bitrate throughput)) { $client_run_stats{$_} = shift @misc_results; } push (@errors, @misc_results); #Prinout summary infor for this client printout_summary( \%client_run_stats, $speed_limit_string, $config->{'USER_SPEED_LIMIT'},"CLIENT"); &client_log("ERRORS FOUND\n" . join("\n", @misc_results) . "\n\n") if (@misc_results); &client_log ("=============================================================================\n"); undef $_; } #end of for (@clients) # Printout class results for this run my (@misc_results) = &printout_class_results($cl_results, $config->{'RUN_TIME'}, $num, "TOTALS"); #Save return values and errors for (qw(response bitrate throughput)) { $run_stats{$_} = shift @misc_results; } push (@errors, @misc_results); # Check to see if the posts per class match what's in the post.log if ($config->{'DYNAMIC_POST'} > 0) { my (@server_post_count) = @$server_post_count_ref; for ($class = 0; $class < @server_post_count; $class++) { my $difference = $cl_results->[$class][6] - $server_post_count[$class]; # The server isn't allowed to have more posts than were submitted if ($difference < 0) { push (@errors, sprintf "Iteration $num: The server post.log recorded %d too many POSTS in class %d", abs($difference), $class); } # The server is allowed to have less, up to the MAX_ERROR_RATE percent. elsif ($difference / $cl_results->[$class][6] > $MAX_ERROR_RATE) { push (@errors, sprintf "Iteration $num: %.1f%% of class %d POSTS missing in post.log.", 100 * $difference / $cl_results->[$class][6], $class); } # if ($cl_results->[$class][6] != $server_post_count[$class]) { # push (@errors, # sprintf "Iteration $num: The server saw %d instead of %d class %d POST transactions", # $server_post_count[$class], $cl_results->[$class][6], # $class); # } } } # Make the conformance stirng for (my $i = 0; $i < @$total_cum; $i++) { $run_stats{'cum_conformance'} .= sprintf("%6.2f ", ($total_cum->[$i] / $run_stats{'requested_conn'})*100.0); } # Printout summary info for this run printout_summary( \%run_stats, $speed_limit_string, $config->{'USER_SPEED_LIMIT'}, "TOTALS"); # A few more error checks if ($run_stats{'invalid_conn'} > 0) { push (@errors, sprintf "Iteration $num: $run_stats{'invalid_conn'} invalid connections found"); push (@errors, sprintf (" %d from load generators with 0 requests in a class or classes", $run_stats{'gens_missing_class_ops'})); push (@errors, sprintf (" %d from load generators with > %.1f%% errors in a class or classes", $run_stats{'invalid_conn'} - $run_stats{'gens_missing_class_ops'}, $MAX_ERROR_RATE * 100)); } if ($run_stats{'conform_pct'} < $MIN_CONFORM_PCT) { push (@errors, sprintf "Iteration $num: %% conforming connections is %.1f%% must be >= %.1f%%", $run_stats{'conform_pct'}, $MIN_CONFORM_PCT); } # Save the errors off so that we can peruse them later. $config->{'results'} = [] if !defined $config->{'results'}; push (@{$config->{'results'}}, [ { %run_stats }, #%run_stats $num - 1, #$num is 1-based "unused field", #place-holder, if we need it $cl_results, #class results stuff [ @errors ] ]); #@errors &Log (101, "ERRORS FOUND\n" . join("\n", @errors) . "\n\n") if (@errors); &Log (101, "=============================================================================\n"); return 1; } # This is called to validate whether the inputs in the config file will # generate a valid test sub validate_config { my ($config) = @_; my (@errors); push (@errors, &validate_req('RUN_TIME', $config->{'RUN_TIME'})); push (@errors, &validate_req('RAMPUP_TIME', $config->{'RAMPUP_TIME'})); push (@errors, &validate_req('ITERATIONS', $config->{'ITERATIONS'})); push (@errors, &validate_req('RAMPDOWN_TIME', $config->{'RAMPDOWN_TIME'})); push (@errors, &validate_req('DYNAMIC_CONTENT', $config->{'DYNAMIC_CONTENT'})); push (@errors, &validate_req('DYNAMIC_POST', $config->{'DYNAMIC_POST'})); push (@errors, &validate_req('DYNAMIC_CAD_GET', $config->{'DYNAMIC_CAD_GET'})); push (@errors, &validate_req('DYNAMIC_CGI_GET', $config->{'DYNAMIC_CGI_GET'})); push (@errors, &validate_req('REQUESTS_PER_KEEP_ALIVE', $config->{'REQUESTS_PER_KEEP_ALIVE'})); push (@errors, &validate_req('PERCENT_KEEP_ALIVE_REQUESTS', $config->{'PERCENT_KEEP_ALIVE_REQUESTS'})); push (@errors, &validate_req('ABORTIVE_CLOSE', $config->{'ABORTIVE_CLOSE'})); push (@errors, &validate_req('USER_LINE_SPEED', $config->{'USER_LINE_SPEED'})); push (@errors, &validate_req('USER_SPEED_LIMIT', $config->{'USER_SPEED_LIMIT'})); push (@errors, &validate_req('MAX_FILE', $config->{'MAX_FILE'})); push (@errors, &validate_req('WAIT_BETWEEN_POINTS', $config->{'WAIT_BETWEEN_POINTS'})); # check for reportable values for warmup and runtime if ($config->{'WARMUP_TIME'} < $MIN_WARMUP_TIME) { push (@errors, sprintf "Invalid test: WARMUP_TIME is %d, must be greater than %d", $config->{'WARMUP_TIME'}, $MIN_WARMUP_TIME); } if (@errors) { push (@{$config->{'errors'}}, @errors); my $errorstring = "\nWARNING: RUN WILL BE INVALID\n" . join ("\n", @errors) . "\n\n"; &Log(10, $errorstring); } # Check the validity of USER_SPEED_LIMIT versus USER_LINE_SPEED if ($config->{'USER_SPEED_LIMIT'} > $config->{'USER_LINE_SPEED'} ) { die "Fatal error: USER_SPEED_LIMIT cannot be larger than USER_LINE_SPEED!\n"; } } sub validate_req { my ($varname, $input_value) = @_; # Create the $REQ_varname variable and find out its value my $REQ_varname = '$REQ_' . $varname; my $REQ_value = eval $REQ_varname; #Test it against the input, and return an error string if not equal if ($REQ_value != $input_value) { return "Invalid test: $varname is $input_value, must be $REQ_value"; } return; } # This is called to validate the results of the entire run for this # config file. It uses the error data calculated for each data point # in run_one sub validate_results { &Log(30, "validate_results\n"); my ($config) = @_; my ($num, $idxname, $peakidx, $peak, $min, $max, $tmp); my (@invalid_mix, @invalid_errors); my (@results) = @{$config->{'results'}}; my (@test_errors) = (); my %conform_cxn; #@{$config->{'errors'}} = (); #MC: initialize to no errors &Log(10, scalar(@{$config->{'results'}}) . " data points\n"); #Look through all of the results my ($i); for ($i = 0; $i < @results; $i++) { #Test for errors my @run_errors = @{$results[$i][4]}; if (@run_errors ) { push (@test_errors, "\n"); push (@test_errors, @run_errors); } } push (@{$config->{'errors'}}, @test_errors); # Return a list of the errors -- why? nobody checks the return value #return @{$config->{'errors'}};; } #check the post log for any errors -- done after every point sub validate_post_log { my ($config, $iteration) = @_; my @errors = (); # Fetch the POST data on the server if necessary my @server_post_count; my ($req, $res, $real_count, $reference_count, $dynamic_url); unlink('post.log'); # For the command/Fetch, we don't want any other argument pieces # so delete everything after the first '?' and append the command. $dynamic_url = $config->{'DYN_CMD_SCRIPT'}; $dynamic_url =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $req = new HTTP::Request 'GET' => $dynamic_url . '?command/Fetch'; $req->header('Accept' => '*/*'); $res = $ua->request($req, 'post.log'); if (!$res->is_success) { die "Can't fetch POST log from server, make sure cgi script\n" . "DYNAMIC_ROOT (or DYN_CMD_SCRIPT) is configured correctly!\n" . "Error: " . $res->code . " " . $res->message, "\n"; } if (open(FILE, ") { if (!$seen_pre) { $seen_pre = 1 if m/^
/;
		next;
	    } elsif (m#^
#) { $seen_pre = 0; next; } elsif (m#^\s*$#) { next; } elsif (m#^\s*(\d+)\s*$#) { $reference_count = $1; next; } $real_count++; my ($count, $ts, $pid1, $dir, $class, $num, $client, $query, $pid2, $cookie) = split; warn "POST Log contains inconsistent data!\n" if ($pid1 != $pid2); if (!$errorseen && $lastseen >= $count) { $errorseen=1; push (@errors, "Iteration $iteration: out of order entry in log\n"); } else { $lastseen = $count; } $server_post_count[$class]++; } } else { die "Can't open POST log we fetched from server 'post.log': $!\n"; } if ($reference_count != $real_count) { push (@errors, "Iteration $iteration: Number of POST requests in log inconsistant\n"); } return \@server_post_count, \@errors; } # This simply loops until all of the clients are in the 'Ready' state. sub wait_until_ready { my ($clients, $state) = @_; $state = 'Ready' if $state eq ''; my $ready = 0; while (!$ready) { $ready = 1; for (@$clients) { if ($_->state() ne $state) { $ready = 0; event_loop($clients); last; } } } } # This checks to see which clients are active, and selects on them. sub event_loop { my ($clients) = @_; my $sel_read = IO::Select->new(); my $sel_write = IO::Select->new(); my %sock_to_client; for (@$clients) { my $sock = $_->sock(); $sel_read->add($_->sock()) if $_->need_read(); $sel_write->add($_->sock()) if $_->need_write(); $sock_to_client{$sock} = $_; } my ($reads, $writes, $errors) = $sel_read->select($sel_write, undef); for (@$reads) { $sock_to_client{$_}->handle_read(); } for (@$writes) { $sock_to_client{$_}->handle_write(); } } sub dirs_from_load { my ($config, $load) = @_; # 122000 is the average size of reply per SPECweb99 request my $opsps = ($config->{'USER_LINE_SPEED'}/122000) * $load; return int(25+($opsps/5)); } #the @results are passed in -- an index number for the median one is returned sub find_median_result { my ($config) = @_; my @sorted_results = sort results_sort @{$config->{'results'}}; my $median_index = $#sorted_results / 2; return $sorted_results[$median_index][1], $sorted_results[$median_index][0]{'conforming'}; } ############################################################################## # Helper functions ############################################################################## # Try one of each test operation to make sure it works -- die if any # are broken. # Note: This is the ONLY place where the custom ad scan/replacement scheme # is verified. # Another note: we set $config->{'HTTP_PROTOCOL'} in here with the return # protocol from the 1st GET (if not specified in the rc file, that is) sub verify_all_HTTP_operations { my($config) = @_; my($url); my($thiserror, $errors, $res); my $tmp_url_root = $config->{'URL_ROOT'}; $tmp_url_root =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $max_load = $config->{'MAX_LOAD'} if $config->{'MAX_LOAD'} > $max_load; if ($config->{'DYNAMIC_POST'} > 0 || $config->{'DYNAMIC_CAD_GET'} > 0 ) { my $tmp_dyn_cmd_script = $config->{'DYN_CMD_SCRIPT'}; $tmp_dyn_cmd_script =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; ($res, $thiserror) = &HTTP_operation ("Reset command", $tmp_dyn_cmd_script . '?command/Reset' . '&maxload=' . $max_load . '&pttime=' . 100 . '&maxthread=' . 100 . '&exp=' . '1,100' . '&urlroot=' . $tmp_url_root , 'dynreset.out'); if ($thiserror) { Log (1, $thiserror); $errors++; } } if ($config->{'DYNAMIC_POST'} > 0 || $config->{'DYNAMIC_CAD_GET'} > 0 ) { my $tmp_dyn_cmd_script = $config->{'DYN_CMD_SCRIPT'}; $tmp_dyn_cmd_script =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; ($res, $thiserror) = &HTTP_operation ("Finish command", $tmp_dyn_cmd_script . '?command/Finish'); if ($thiserror) { Log (1, $thiserror); $errors++; } } my($filenum) = int(rand($FILES_PER_CLASS - 1)); $url = sprintf ("/file_set/dir%05d/class3_$filenum", &dirs_from_load($config, $config->{'MAX_LOAD'})-1); # Static GET ($res, $thiserror) = &HTTP_operation("static GET", $tmp_url_root . $url, 'staticget.out'); if ($thiserror) { Log (1, $thiserror); $errors++; } #Decide whether we need HTTP 1.0 or 1.1 if ($config->{'HTTP_PROTOCOL'} eq '') { $config->{'HTTP_PROTOCOL'} = $res->protocol(); #print "HTTP_PROTOCOL = $config->{'HTTP_PROTOCOL'}\n"; } # Switch to shorter files! $url =~ s/class3/class1/; # Dynamic GET my $tmp_dyn_get_script = $config->{'DYN_GET_SCRIPT'}; $tmp_dyn_get_script .= '?' if !($tmp_dyn_get_script =~ m/\?/); $tmp_dyn_get_script =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; if ($config->{'DYNAMIC_CONTENT'} > 0) { ($res, $thiserror) = &HTTP_operation("dynamic GET", $tmp_dyn_get_script . $url, 'dynget.out'); if ($thiserror) { Log (1, $thiserror); $errors++; } } # Dynamic CGI GET my $tmp_dyn_cgi_script = $config->{'DYN_CGI_SCRIPT'}; $tmp_dyn_cgi_script =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $tmp_dyn_cgi_script .= '?' if !($tmp_dyn_cgi_script =~ m/\?/); if ($config->{'DYNAMIC_CGI_GET'} > 0) { ($res, $thiserror) = &HTTP_operation("dynamic CGI GET", $tmp_dyn_cgi_script . $url, 'dyncgiget.out'); if ($thiserror) { Log (1, $thiserror); $errors++; } } my ($filename) = 'dyncadget.out'; # Dynamic Custom Ad GET my $tmp_dyn_cad_script = $config->{'DYN_CAD_SCRIPT'}; $tmp_dyn_cad_script =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $tmp_dyn_cad_script .= '?' if !($tmp_dyn_cad_script =~ m/\?/); if ($config->{'DYNAMIC_CAD_GET'} > 0) { my ($old_errors) = $errors; ($res, $thiserror) = &HTTP_operation("dynamic custom ad (CAD) GET", $tmp_dyn_cad_script . $url, $filename); if ($thiserror) { Log (1, $thiserror); $errors++; } # From the cookie, figure out the expected n, x, and y values my ($adid, $en, $ex, $ey, $fn, $fx, $fy, $ct, $found, $sep); my $headers = $res->headers_as_string(); if ($headers =~ m/Set-Cookie.*Ad_id=(\d+)/) { $adid = $1; $en = sprintf( "%05d", int($adid/36)); $ex = int(($adid % 36) / 9); $ey = int($adid % 9); } if (open(FILE, "<$filename")) { while () { #Note: on NT, the headers show up in the file, not in #headers-as-string() method if (undef($adid) && m/Set-Cookie.*Ad_id=(\d+)/) { $adid = $1; $en = sprintf( "%05d", int($adid/36)); $ex = int(($adid % 36) / 9); $ey = int($adid % 9); } if (m##) { $found = $1; $ct++; if ($1 =~ m/(\S{1})class/) { $sep = $1; } else { Log (1, " **ERROR**: Bizarre stuff found in WEBCAD string\n\n$_\n"); $errors++; } my($expected) =sprintf("%sfile_set%sdir%5s%sclass%01d_%01d", $sep,$sep,$en,$sep,$ex,$ey); if ($expected ne $found) { Log (1, "ERROR: Substitution in Custom Ad scan is incorrect\n Expected: $expected Found: $found\n"); $errors++ } } } close FILE; if (undef($adid)) { Log (1, " **ERROR**: No Set-Cookie header returned -- Header string:\n\n$headers\n"); $errors++; } elsif ($ct == 0) { Log(1, " **ERROR**: No Custom Ad substitution was found -- see runrules for information on the WEB99CAD string substitution\n"); $errors++ } } else { Log(1, " **ERROR**: Can't open $filename fetched from dynamic CAD GET of $!\n"); $errors++ } if ($old_errors < $errors) { Log(1, " NOTE: errors in Custom Ad Rotation may be caused by" . " problems in \n command/Reset. Check that upfgen and cadgen" . " get run correctly\n"); } } # Dynamic post my $tmp_dyn_post_script = $config->{'DYN_POST_SCRIPT'}; $tmp_dyn_post_script =~ s/\@\@SERVER\@\@/$config->{'SERVER'}/e; $tmp_dyn_post_script .= '?' if !($tmp_dyn_post_script =~ m/\?/); if ($config->{'DYNAMIC_POST'} > 0) { ($res, $thiserror) = &HTTP_operation("dynamic POST", $tmp_dyn_post_script . $url, 'dynpost.out'); if ($thiserror) { Log (1, $thiserror); $errors++; } my ($server_pcount) = 0; my($pcount_ref, $errors_ref) = &validate_post_log($config, "pre test"); for (@$pcount_ref) {$server_pcount += $_}; if ($server_pcount != 1) { Log(1, " **ERROR**: There should only be 1 post log entry;" . "$server_pcount" . " were found\n"); Log(1, " NOTE: errors in dynamic POST may be caused by" . " problems in \n command/Reset. Check that the post.log" . " gets zeroed correctly\n"); $errors++; } } die "\n\n****** FATAL ERRORS FOUND *******\n\n" if $errors; } # Code for doing HTTP operations from manager sub HTTP_operation { my ($operation, $url, $output_file) = @_; my($req, $res, $error); Log(5, "\n Checking $operation with '$url'\n"); if ($operation =~ m/POST/i) { $req = new HTTP::Request 'POST' => $url . "f"; my($urlroot) = ($url =~ m#\?(.*file_set/)#); $req->content("class=1&client=2&dir=00004&num=3&urlroot=$urlroot"); } else { $req = new HTTP::Request 'GET' => $url; } $req->header('Accept' => '*/*'); if ($operation =~ m/CAD/i || $operation =~ m/POST/i) { $req->header('Cookie'=> "my_cookie=user_id=10001&last_ad=20"); } $res = $ua->request($req,$output_file); if (!$res->is_success) { if ($operation =~ m/static/i) { $error .= " **ERROR**:" . "Can't fetch file $url with a $operation request\n" . "Did WAFGEN generate a large enough fileset?\n" . "Error: " . $res->code . " " . $res->message . "\n"; } else { $error .= " **ERROR**:" . " Can't fetch file $url with a $operation request\n" . "Is DYNAMIC_ROOT (or DYN_xxx_SCRIPT) configured " . " correctly?\n" . "Error: " . $res->code . " " . $res->message . "\n"; } return $res, $error; } if ($operation =~ m/Reset/i) { return $res, $error; } if ($operation =~ m/Finish/i) { return $res, $error; } my($fileset_string); if (open(FILE, "<$output_file")) { while () { if (m/\d+\s+(file_set.*class.*)/){ $fileset_string = $1; last; } } if (!$fileset_string ) { $error .= " **ERROR**: Improper file returned. See " . "$output_file for returned text\n"; } } else { $error .= "Can't open $output_file to check $operation: $!\n"; } return $res, $error; } # Printout the class summary tables. The first table has the mix, # op count, and response time information. The 2nd table has bitrate # information. # This routine works for both the per-client and per-iteration printouts # Also, check for per-class errors: # 1) Mix problems (only for entire iteration) # 2) Error rate (for each client) sub printout_class_results { my ($cl_res_array, $runtime, $runnum, $output_type) = @_; # Set this (and change the label ) to the confidence interval you # desire: # my $CHI_SQR = 2.71; # chi-sqr value for 90% CI # my $CHI_SQR = 3.84; # chi-sqr value for 95% CI # my $CHI_SQR = 5.02; # chi-sqr value for 97.5% CI # my $CHI_SQR = 6.63; # chi-sqr value for 99% CI my $CHI_SQR = 7.88; # chi-sqr value for 99.5% CI my (@subtotals, $mix_str, $rate_str, $total_wtd_abr, @errors); $subtotals[0] = $cl_res_array->[0][0]; $subtotals[1] = -10101; #The probability subtotal is meaningless # Subtotal all the classes, then save in the xxx_T variables for (my $class = 0; $class < @$cl_res_array; $class++) { for (my $j = 2; $j < @{$cl_res_array->[$class]}; $j++) { $subtotals[$j] += $cl_res_array->[$class][$j]; } } my ($name_T, $prob_T, $time_T, $time2_T, $good_T, $bad_T, $post_T, $rate_T, $rate2_T, $slow_rate_T, $aggregate_bytes_T) = @subtotals; # Calculate the aggregate bit-rate my $throughput_T = $runtime?$good_T / $runtime:0; my $aggregate_rate_T = $throughput_T ? $aggregate_bytes_T / ($time_T/1000) : 0; # convert into bits/sec $aggregate_rate_T *= 8; # Build $mix_str with basic class mix information $mix_str = " -------------------------+-----------------+--------------------------+------ M I X | O P C O U N T | MEAN RESPONSE TIME Ms/Op | Total Class Target Actual | Success Error | Mean StdDev 95% CI | Time -------------------------+-----------------+--------------------------+------ "; #Build $rate_str with bit-rte information $rate_str .= " -------+--------------------------------+------------------+-------------------- |Individual OP Bit Rate(bits/sec)| Aggregate Bit | Weighted ABR Class | Mean StdDev 95% CI | Rate (bits/sec) | (%) -------+--------------------------------+------------------+-------------------- "; # Go through each class, calculating and printing stats for the 2 tables for (my $class = 0; $class < @$cl_res_array; $class++) { my ($name, $prob, $time, $time2, $good, $bad, $post, $rate, $rate2, $slow_rate, $aggregate_bytes) = @{$cl_res_array->[$class]}; # Stats for response times my $stddev = 0; my $confidence = 0; my $mean = 0; # Stats for bit rates my $stddev_rate = 0; my $confidence_rate = 0; my $mean_rate = 0; my $abr = 0; my $weighted_abr = 0; my $actual_mix= $good_T ? $good/$good_T : 0 ; my $class_time = $time_T ? $time/$time_T : 0; if ($good > 0) { $mean = $time / $good; $mean_rate = $rate / $good; # convert into bits/sec $mean_rate *= 8; $abr = ($aggregate_bytes / ($time/1000)) * 8.0; $weighted_abr = $abr * $class_time; $total_wtd_abr += $weighted_abr; } if ($good > 1) { $stddev = sqrt(($time2 - ($time*$time)/$good) / ($good - 1)); $confidence = sqrt($CHI_SQR * $stddev / $good); $stddev_rate = sqrt(($rate2 - ($rate*$rate)/$good) / ($good - 1)); # convert into bits/sec $stddev_rate *= 8; $confidence_rate = sqrt($CHI_SQR * $stddev_rate / $good); } # Check for per-class error rate problems # NOTE: this is the only place where Class 3 error rates are checked # Classes 0-2 are checked in the client on a per load-generator # per-class basis. If the error rate is too high, the load-gen is # marked as invalid. # Class 3 is such a small portion, a single error could invalidate # a load-gen, so class 3 errors rates are calculated for each client. if ($output_type eq "CLIENT") { if ($good && $bad / ($bad+$good) > $MAX_ERROR_RATE) { push (@errors, sprintf "Iteration $runnum: error rate for class %s is %.1f%%, must be <= %.1f%%", $name, 100 * $bad/($bad+$good), $MAX_ERROR_RATE * 100); } } # Check for errors on the whole run elsif ($output_type eq "TOTALS") { # Mix problems for each class if ($actual_mix < $prob * (1 - $MIX_TOLERANCE) || $actual_mix > $prob * (1 + $MIX_TOLERANCE)) { push (@errors, sprintf "Iteration $runnum: mix for class %s is %.3f, must be between %.3f and %.3f", $name, $actual_mix, $prob * (1 - $MIX_TOLERANCE), $prob * (1 + $MIX_TOLERANCE)); } } $mix_str.=sprintf ("%-12s %5.3f %5.3f | %7d %7d | %8.2f %8.2f %6.2f |%5.1f%%\n", $name, $prob, $actual_mix, $good, $bad, $mean, $stddev, $confidence, $class_time*100.0); $rate_str .= sprintf ("%-6s | %11.2f %11.2f %6.2f | %11.2f | %11.2f(%3.2f)\n", $name, $mean_rate, $stddev_rate, $confidence_rate, $abr, $weighted_abr, ($aggregate_rate_T ? $weighted_abr/$aggregate_rate_T : 0)*100); } # Calculate and print the totals for the 2 tables my $stddev_T = 0; my $confidence_T = 0; my $mean_T = 0; my $error_pct_T = 0; if ($good_T > 0) { $mean_T = $time_T / $good_T; $error_pct_T = ($bad_T / ($bad_T+$good_T)) * 100; } if ($good_T > 1) { $stddev_T =sqrt(($time2_T - ($time_T*$time_T)/$good_T) / ($good_T - 1)); $confidence_T = sqrt($CHI_SQR * $stddev_T / $good_T); } $mix_str .= sprintf "-------------------------+-----------------+--------------------------+------ | %7d %7d | %8.2f %8.2f %6.2f |\n\n", $good_T, $bad_T, $mean_T, $stddev_T, $confidence_T; $rate_str .= sprintf "-------+--------------------------------+------------------+-------------------- | | | %11.2f(%3.2f) ", $total_wtd_abr, ($aggregate_rate_T ? $total_wtd_abr/$aggregate_rate_T : 0 )*100; # Print out mix table and rate table if ($output_type eq "ASCII") { return ($mix_str . $rate_str) } if ($logclient && $output_type eq "CLIENT") { &client_log($mix_str . $rate_str); } &Log(101, $mix_str . $rate_str) if $output_type eq "TOTALS"; return $mean_T, $aggregate_rate_T, $throughput_T, @errors; } # # # Summary information for a client or run # sub printout_summary { my ($run_stats, $speed_limit_string, $user_speed_limit, $output_type) = @_; $run_stats->{'conform_pct'} = 100 * $run_stats->{'conforming'}/$run_stats->{'requested_conn'}; $run_stats->{'ops_per_thread'} = $run_stats->{'throughput'} / $run_stats->{'requested_conn'}; my ($str2) = sprintf " | | total | ops/sec/| | SPECweb99 | ops/sec | loadgen | msec/op -------------+------------+---------+---------+--------- RESULTS | %6d | %6d | %4.2f | %5.1f | | | | conforming* | requested | valid | invalid | (conf %) -------------+-----------+-----------+-----------+---------------- SIMULTANEOUS | %7d | %7d | %7d | %7d (%6.2f%%) CONNECTIONS | | | | * a conforming connection is one that operates faster than 320K bit/sec | mean | min | max -------------+---------+---------+-------- AGGREGATE | | | BITRATES | %6d | %6d | %6d (bits/sec) | | | ------------------------------------------------------------------------- Percentage of simultaneous connections conforming at various speed limits --------------------------+---------------------------------------------- Successive Speed Limits : | %s Cumulative Conformance %: | %s --------------------------+---------------------------------------------- ", $run_stats->{'conforming'}, $run_stats->{'throughput'}, $run_stats->{'ops_per_thread'}, $run_stats->{'response'}, $run_stats->{'requested_conn'}, $run_stats->{'requested_conn'} - $run_stats->{'invalid_conn'}, $run_stats->{'invalid_conn'}, $run_stats->{'conforming'}, $run_stats->{'conform_pct'}, $run_stats->{'bitrate'}, $run_stats->{'min_bitrate'}, $run_stats->{'max_bitrate'}, $speed_limit_string, $run_stats->{'cum_conformance'}; my($str) = sprintf " RESULTS: %6d SPECweb99 BITRATES(bits/sec): avg = %6d min =%6d max = %6d THROUGHPUTS: ops/sec = %6d ops/sec/loadgen = %4.2f msec/op = %6.1f SIMULTANEOUS_CONNECTIONS: %6d requested %6d invalid %6d (%.2f%) conforming at %d bits/sec ------------------------------------------------------------------------- Percentage of simultaneous connections conforming at various speed limits --------------------------+---------------------------------------------- Successive Speed Limits : | %s Cumulative Conformance %: | %s --------------------------+---------------------------------------------- ", $run_stats->{'conforming'}, $run_stats->{'bitrate'}, $run_stats->{'min_bitrate'}, $run_stats->{'max_bitrate'}, $run_stats->{'throughput'}, $run_stats->{'ops_per_thread'}, $run_stats->{'response'}, $run_stats->{'requested_conn'}, $run_stats->{'invalid_conn'}, $run_stats->{'conforming'}, $run_stats->{'conform_pct'}, $user_speed_limit, $speed_limit_string, $run_stats->{'cum_conformance'}; # Print out mix table and rate table return $str2 if $output_type eq "ASCII"; &client_log($str2) if $logclient && $output_type eq "CLIENT"; &Log(101, $str2) if $output_type eq "TOTALS"; } ############################################################################## # Utility functions ############################################################################## sub Log { my ($level, @data) = @_; my ($type, @output); my $log_output = ""; my $screen_output = ""; for (@data) { $type = ref($_); if ($type eq "ARRAY") { if ($verbose >= $level) { $screen_output .= join ("", @$_); $log_output .= join ("", @$_); } elsif ($level >= 100) { $screen_output .= $_ if $verbose + 100 >= $level; $log_output .= join ("", @$_); } } elsif ($type eq "SCALAR") { if ($verbose >= $level) { $screen_output .= $$_; $log_output .= $$_; } elsif ($level >= 100) { $screen_output .= $_ if $verbose + 100 >= $level; $log_output .= $$_; } } else { if ($verbose >= $level) { $screen_output .= $_; $log_output .= $_; } elsif ($level >= 100) { $screen_output .= $_ if $verbose + 100 >= $level; $log_output .= $_; } } } print $screen_output; print LOG $log_output; } sub client_log { my (@data) = @_; my ($type, @output); my $log_output = ""; for (@data) { $type = ref($_); if ($type eq "ARRAY") { $log_output .= join ("", @$_); } elsif ($type eq "SCALAR") { $log_output .= $$_; } else { $log_output .= $_; } } print CLLOG $log_output; } sub max { my ($val) = @_; for (@_) { $val = $_ if $_ > $val; } return $val; } # This expands strings in the form of M or M-N or M-NxO into a complete # list of the values they represent. 1-3 would be 1,2,3 and 1-5x2 # would be 1,3,5 sub expand_ranges { my (@data) = @_; my (@rc, $start, $stop, $step, $i); for (@data) { if (($start, $stop, $step) = m/^(\d+)-(\d+)x(\d+)$/) { for ($i = $start; $i <= $stop; $i+=$step) { push (@rc, $i); } } elsif (($start, $stop) = m/^(\d+)-(\d+)$/) { for ($i = $start; $i <= $stop; $i++) { push (@rc, $i); } } else { push (@rc, $_); } } @rc; } # Return the date (Note that this doesn't have time time zone in it, # but I'm not sure if we are that concerned about it sub date { my ($result); chomp($result = &ctime(time)); return $result; } # Given an list of choices, choose the one that matches the first few # characters. Ambiguous and non-matching strings return undef. sub choose_string { my ($string, @choices) = @_; my (@matches) = grep (m/^$string/, @choices); return undef if @matches != 1; return $matches[0]; } # resolve_choices takes a string containing a comma separated list of # choices and returns the choices from valid_outputs that match. The # choices in required_outputs are added automatically. sub resolve_choices { my($temp, $valid_outputs, $required_outputs) = @_; my @temp = split(/\s*[,\s]\s*/, $temp); my %temp; my @output_types = (); for (@$required_outputs) { push (@output_types, $_) if (!$temp{$_}++); } for (@temp) { $temp = &choose_string ($_, @$valid_outputs, "all"); if ($temp eq "all") { for (@$valid_outputs) { if (!$temp{$_}++) { push (@output_types, $_); } } } elsif (!defined $temp) { Log(0, "Don't know how to output type '$_'\n"); } else { if (!$temp{$_}++) { push (@output_types, $_); } } } push (@output_types, $valid_outputs->[0]) if (!@output_types); @output_types; } # Find the largest 3 digit numbered file in the directory and return a # 3 digit string of the next number. Used to output numbered log files. sub find_next_number { local (*DIR); my($path) = @_; my (@files, $max); opendir (DIR, $path) || die "Can't open directory '$path': $!\n"; @files = readdir(DIR); closedir (DIR); $max = 0; for (@files) { $max = $1 if ((m/^(\d{3})\./ || m/\.(\d{3})$/ || m/\.(\d{3})\./) && $max < $1 ); } if ($max < 0) { $max = "000"; } else { $max = sprintf ("%03d", $max+1); } $max; } #For 2 $results, compares 'conforming' -- if equal, then compares 'throughput' sub results_sort { my ($res) = $a->[0]{'conforming'} <=> $b->[0]{'conforming'}; return $res if $res != 0; return $a->[0]{'throughput'} <=> $b->[0]{'throughput'}; } ############################################################################## # Formatting functions ############################################################################## # All formatting functions build the output file in a string which they # return. If a filename is specified, then they also output to a file. # do_outputs, figures out what types are needed and calls the appropriate # functions sub do_outputs { my ($config, $file_num, $output_dir) = @_; # Fill in some benchmark stats for the output my(%med_run_stats)= %{$config->{'results'}[$config->{'median_index'}][0]}; $config->{'bm_requested_conn'} = $med_run_stats{'requested_conn'}; $config->{'bm_fileset_size'} = $MB_PER_DIRECTORY * &dirs_from_load($config, $med_run_stats{'requested_conn'}); my $outsel=($output_types ne "")?$output_types:$config->{'OUTPUT_TYPE'}; my @types=&resolve_choices($outsel, [ sort keys %formatter ], ['screen', 'raw']); # Output the results for (@types) { my $name = "$output_dir$config->{'OUTPUT_NAME'}.$file_num.$_"; my $output = &{$formatter{$_}}($config); next if $_ eq 'screen'; my $fh = new IO::File ">$name"; &Log (10, "Writing '$name'\n"); if (!defined $fh) { &Log (0, "Cannot create '$name': $!\n"); exit (1); } print $fh $output; $fh->close(); } } sub init_output { @network_fields = ( [ 'MSL (sec)', 'msl' ], [ 'Time-Wait (sec)', 'time_wait' ], ); @clients_fields = ( [ '# of Clients', 'lg_num' ], ); @bm_config_fields = ( [ 'Requested Connections', 'bm_requested_conn' ], [ 'Fileset Size (MB)', 'bm_fileset_size' ], ); @notes_fields = ( [ 'Errors', 'errors', ], ); return 0; } # .raw files are to look at the raw data and to re-format into the # other formats. sub write_raw { my ($config, $output_name) = @_; my $rc = ""; # Header for a raw file $rc .= "BEGIN SPECWEB99 1.00\n"; # for (qw( peak_index peak_load peak_throughput peak_response peak_size )) { # $rc .= "$_= $config->{$_}\n"; # } # Print out the results my $num = "000"; for (@{$config->{'results'}}) { my(%run_stats) = %{$_->[0]}; my($statname); foreach $statname (sort keys %run_stats) { $rc .= "results$num = $statname $run_stats{$statname}\n"; } my $class = 0; for (@{$_->[3]}) { my ($name, @rest) = @$_; $rc .= "results$num = class $class \"$name\" ". join(" ", @rest). "\n"; $class++; } for (@{$_->[4]}) { $rc .= "results$num = error $_\n"; } $num++; } # Print out the entire configuration array for my $key (sort keys %$config) { if ($key eq 'results' || $key eq 'clients_parsed') { # except these, results is done above, and clients_parsed would # need similar logic, but really isn't worth it. If we # *really* need it we can regenerate it } elsif (ref($config->{$key}) eq "ARRAY") { # arrays are output as numbered lines my $num = "000"; for (@{$config->{$key}}) { $rc .= "$key$num = $_\n"; $num++; } } elsif ($config->{$key} ne "--" && $config->{$key} !~ /^\s*$/) { # Don't print out lines with no values $rc .= "$key = $config->{$key}\n"; } } # Trailer to mark the end of the raw data $rc .= "END SPECWEB99 1.00\n"; return $rc; } # write_screen Just writes the ASCII output to the screen. Used to # output the results during the run sub write_screen { print &write_asc($_[0]); } # Produces an ASCII formatted listing. sub write_asc { my ($config) = @_; my (@results) = @{$config->{'results'}}; my (@errors) = @{$config->{'errors'}} if $config->{'errors'}; my $rc = ""; # Make sure we mark runs invalid my $invalid_string = (@errors)?"INVALID TEST":""; my $successive_speed_limits = []; $successive_speed_limits = $config->{'SUCCESSIVE_SPEED_LIMITS'}; my $speed_limit_string = sprintf "@{$successive_speed_limits}"; # Banner $rc .= sprintf <{'median_results'}; SPECweb99 Result =============================================================================== || %-45.45s || %6d SPECweb99 %-45.45s || $invalid_string || =============================================================================== PERFORMANCE | Conforming Simultaneous Iteration | Connections ---------------+---------------------------- EOT for (my $i = 0; $i < @results; $i++) { my ($conforming) = $results[$i][0]->{'conforming'}; $rc .= sprintf(" %2d | %7d\n", $i+1, $conforming); } $rc .= "---------------+----------------------------\n"; $rc .= sprintf(" Median | %7d\n", $config->{'median_results'}); $rc .= "\n"; ### Use actual test values - so no mismatch occurs ### $config->{'lg_num'} = scalar(@{$config->{'CLIENTS'}}); my $width = 79; $rc .= '=' x $width . "\n"; my $title = "Notes/Tuning information"; $rc .= ' ' x int(($width - length($title))/2) . $title . "\n"; for my $info ( @notes_fields ) { my ($name, $key) = @$info; my $val = $config->{$key}; my @vals = (); next if $val eq '' || $val eq '--' || (ref($val) eq 'ARRAY' && @$val == 0); $rc .= "\n$name\n"; if (ref($val) eq 'ARRAY') { for (@$val) { push (@vals, split("\n", $_)); } } else { @vals = split("\n", $val); } for (@vals) { $rc .= " $_\n"; } } $rc .= <{'median_index'} ? "=>" : " ", $i+1, $run_stats{'conforming'}, $run_stats{'conform_pct'}, $run_stats{'throughput'}, $run_stats{'response'}, $run_stats{'ops_per_thread'}, $run_stats{'bitrate'} / 1000); } $rc .= sprintf("Performance Counters:\n"); $rc .= sprintf ("%s\n", $perfcnt); if ($details) { $rc .= sprintf <{'median_index'} ? "=>" : " ", $i + 1, $run_stats{'conforming'}, $run_stats{'cum_conformance'}); } $rc .= "\n\n"; } if ($details) { #Write results for individual tests for (my $i = 0; $i < @results; $i++) { $rc .= sprintf("\n\nResults From Iteration %d\n", $i+1); my (@class_results) = @{$results[$i][3]}; $rc .= &printout_class_results( \@class_results, $config->{'RUN_TIME'}, $i + 1, "ASCII"); my(%run_stats) = %{$results[$i][0]}; $rc .= &printout_summary(\%run_stats, $speed_limit_string, $config->{'USER_SPEED_LIMIT'}, "ASCII"); } } return $rc; } sub firstof($) { my ($val) = @_; $val = $val->[0] if (ref($val) eq 'ARRAY'); return $val; }