1############################################################################
2#                                                                          #
3# The contents of this file are subject to the WebStone Public License     #
4# Version 1.0 (the "License"); you may not use this file except in         #
5# compliance with the License. You may obtain a copy of the License        #
6# at http://www.mindcraft.com/webstone/license10.html                      #
7#                                                                          #
8# Software distributed under the License is distributed on an "AS IS"      #
9# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See      #
10# the License for the specific language governing rights and limitations   #
11# under the License.                                                       #
12#                                                                          #
13# The Original Code is WebStone 2.5.                                       #
14#                                                                          #
15# The Initial Developer of the Original Code is Silicon Graphics, Inc.     #
16# and Mindcraft, Inc.. Portions created by Silicon Graphics. and           #
17# Mindcraft. are Copyright (C) 1995#1998 Silicon Graphics, Inc. and        #
18# Mindcraft, Inc. All Rights Reserved.                                     #
19#                                                                          #
20# Contributor(s): ______________________________________.                  #
21#                                                                          #
22############################################################################
23
24use Cwd;
25use Sys::Hostname;
26$wd = cwd;
27push(@INC, "$wd/bin");
28require('ws-utils.pl');
29use File::Copy;
30use File::Basename;
31
32#
33# Parse command line.
34#
35while ($ARGV[0] =~ /^-[^\s]/)
36{
37	if ($ARGV[0] =~ /^-debug$|^-d$/i)
38	{
39		$debug = 1;
40		$| = 1;	# so debugging output is not buffered
41		shift;
42	}
43	else
44	{
45		&do_usage;
46		exit 0;
47	}
48}
49&set_webstone_conf();
50
51print "Clients: $CLIENTS\n";
52@clients = split(/,\s*|\s+/, $CLIENTS);
53
54#
55# Estimate run time
56#
57$numclienthosts = $#clients + 1;
58$trials = 1 + ( $MAXCLIENTS - $MINCLIENTS ) / $CLIENTINCR;
59$runtime = 60 * $ITERATIONS * $trials * $TIMEPERRUN;
60$runtime += $trials * ( $MAXCLIENTS + $MINCLIENTS ) / ( 2 * $numclienthosts );
61print "Estimated run time: ", &my_floor( $runtime / 3600 ), " hours ",
62	&my_floor( $runtime % 3600 / 60 ), " minutes\n";
63
64#
65# Make the results directory if it doesn't exist
66#
67unless (-d "bin/runs")
68{
69        mkdir("bin/runs", 0777);
70        print "Creating directory 'bin/runs'\n";
71}
72
73#
74# Distribute webclient binary.
75#
76$my_hostname = hostname();
77"$RCP" and &copy_file_to_clients($RCP, $my_hostname, $DELETE_FILE_CMD,
78				$LOCAL_CLIENTPROGFILE, $CLIENTPROGFILE,
79				@clients);
80
81# BEGIN iterations
82foreach $j (1..$ITERATIONS)
83{
84	for ($numclients = $MINCLIENTS;
85		$numclients <= $MAXCLIENTS;
86			$numclients += $CLIENTINCR)
87	{
88		($date, $timestamp) = &my_getdates;
89		print "\n***** Iteration $j, Total clients $numclients *****\n";
90		print "$date";
91
92		&clean_debug_files($DEBUGFILE, @clients);
93
94		#
95		# Create the log directory
96		#
97		$logdir = "bin/runs/$timestamp";
98		-d $logdir and die "Log directory '$logdir' already exists!\n";
99		mkdir($logdir, 0777) or
100			die "Unable to create directory '$logdir': $!\n";
101		print "Creating log directory '$logdir'\n";
102
103		#
104		# Set up the client config file
105		#
106		$client_config = "$logdir/config";
107		open(CFG, "> $client_config") or
108			die "Unable to create config file '$client_config': $!\n";
109		&debug("Creating config file '$client_config'\n");
110		&debug("config file contents:\n");
111
112		$clientsperhost = &my_floor($numclients / $numclienthosts);
113		$extraclients = ($numclients % $numclienthosts);
114
115		# If clients are all IP numbers and SERVER is a host number
116		# (just a number like "11", not an IP adress) then have each
117		# client hit that host number on its net.  Otherwise just
118		# point each webclient at SERVER.
119		$use_server = (grep(!/\d+\.\d+\.\d+\.\d+/, @clients) or
120			$SERVER =~ /\D/ ) and $servername=$SERVER;
121
122		foreach $c (@clients)
123		{
124			unless ($use_server)
125			{
126				$c =~ /(\d+\.\d+\.\d+)\.\d+$/;
127				$servername = "$1.$SERVER";
128			}
129			if ( $extraclients > 0 )
130			{
131				print CFG "$c $CLIENTACCOUNT $CLIENTPASSWORD ", $clientsperhost + 1, " $servername\n";
132				&debug("$c $CLIENTACCOUNT $CLIENTPASSWORD ", $clientsperhost + 1, " $servername\n");
133				$extraclients--;
134			}
135			else
136			{
137				print CFG "$c $CLIENTACCOUNT $CLIENTPASSWORD $clientsperhost $servername\n";
138				&debug("$c $CLIENTACCOUNT $CLIENTPASSWORD $clientsperhost $servername\n");
139			}
140		}
141		close CFG;
142
143		$fl = basename($FILELIST);
144		$fl = "$logdir/$fl";
145		copy($FILELIST, $fl) or
146			die("Copying file '$FILELIST' to '$fl': $!\n");
147
148		$WEBSERVERTUNINGFILES and $RCP and
149			&get_webservertuningfiles($RCP, $SERVER, $logdir,
150						  $WEBSERVERTUNINGFILES);
151
152		#
153		# Run benchmark
154		#
155		$cmd = "$WEBSTONEROOT\\bin\\webmaster.exe -v -W -C $CLIENTPROGFILE";
156		$cmd .= " -f $client_config -t $TIMEPERRUN";
157		$cmd .= " -U $CLIENTFILELIST"	if $CLIENTFILELIST;
158		$FILELIST = ""				if $CLIENTFILELIST;
159		$cmd .= " -u $FILELIST"			if $FILELIST;
160		$cmd .= " -p $PORTNO"			if $PORTNO;
161		$cmd .= " -P $PROXYSERVER"		if $PROXYSERVER;
162		$cmd .= " -d"				if $DEBUG;
163		$cmd .= " -D $DEBUGFILE"		if $DEBUGFILE;
164		$cmd .= " -S"				if $FIXED_RANDOM_SEED;
165
166		print "$cmd\n";
167
168		open(PROC, "$cmd |") or
169			die("Unable to run command '$cmd': $!\n");
170		$logfilepath = "$logdir/run";
171		open(LOGFD, "> $logfilepath") or
172			die("Opening file '$logfilepath': $!\n");
173
174		while(<PROC>)
175		{
176			print LOGFD "$_";
177			print;
178		}
179		close PROC;
180		close LOGFD;
181
182		print ((&my_getdates)[0]);
183	}
184}
185
186# rather than bring in the POSIX:strftime or ctime modules, just
187# do a simple subroutine.
188sub my_getdates
189{
190	my($sec,$min,$hr,$mday,$mon,$yr,$wday) = localtime;
191	my($tz) = $ENV{TZ};
192	(sprintf("%s %s %2d %02d:%02d:%02d %s %d\n",
193		('Sun','Mon','Tue','Wed','Thu','Fri','Sat')[$days[$wday]],
194		('Jan','Feb','Mar','Apr','May','Jun',
195                 'Jul','Aug','Sep','Oct','Nov','Dec')[$mos[$mon]],
196		$mday, $hr, $min, $sec, $tz, $yr+1900),
197	sprintf("%02d%02d%02d_%02d%02d", $yr, $mon, $mday, $hr, $min));
198}
199
200
201sub my_floor { "$_[0]" =~ /(\d+)\.?.*$/; $1; }
202
203
204sub copy_file_to_clients
205{
206	my($rcp, $my_hostname, $del, $localfile, $clientprogfile, @clients) = @_;
207	my($cmdline, $remotefile, $rempath);
208
209	# turn 'C:\tmp' into 'c$\tmp' to access NT remote shares
210	($remotefile = $clientprogfile) =~ s/^([a-zA-Z]):(.*)/$1\$$2/;
211
212	print "Distributing webclient binary to clients.\n";
213	foreach $client (@clients)
214	{
215	    if ($client eq 'localhost' ||
216 		$my_hostname =~ /^$client(\..*$)?/)
217	    {
218		if ($localfile eq $clientprogfile)
219		{
220		    &debug("No need to copy '$localfile' to itself!");
221		    next;
222		}
223		$cmdline = "$rcp $localfile $clientprogfile";
224	    }
225	    else
226	    {
227		$rempath = "\\\\$client\\$remotefile";
228		if (-f $rempath)
229		{
230			# remove old file from client system.
231			$cmdline = "$del $rempath";
232			&debug("Executing '$cmdline'\n");
233			system($cmdline);
234		}
235
236		# copy file to client system.
237		$cmdline = "$rcp $localfile $rempath";
238            }
239
240	    &debug("Executing '$cmdline'\n");
241	    system($cmdline);
242	}
243}
244
245
246sub clean_debug_files
247{
248	my($debugfile, @clients) = @_;
249	my ($remotefile);
250
251	# turn 'C:\tmp' into 'c$\tmp' to access NT remote shares
252	($remotefile = $debugfile) =~ s/^([a-zA-Z]):(.*)/$1\$$2/;
253	$remotefile .= '*';	# append '*' to remove multiple files.
254
255	print "Cleaning client debug files.\n";
256	foreach $client (@clients)
257	{
258		unlink( "\\\\$client\\$remotefile" );
259	}
260}
261
262
263sub get_webservertuningfiles
264{
265	my($copy, $server, $logdir, $webservertuningfiles) = @_;
266	my($cmdline, $remotefile);
267
268	print "Retrieving webserver tuning files: $webservertuningfiles\n";
269	foreach $file (split(/,\s*|\s+/, $webservertuningfiles))
270	{
271		# turn 'C:\tmp' into 'c$\tmp' to access NT remote shares
272		($remotefile = $file) =~ s/^([a-zA-Z]):(.*)/$1\$$2/;
273
274		# remove old file from client system.
275		$cmdline = "$copy \\\\$server\\$remotefile $logdir";
276		&debug("Executing '$cmdline'\n");
277		system($cmdline);
278	}
279}
280
281sub do_usage
282{
283	print "Usage: $0 [-help|-h] [-debug|-d] [config-file]\n";
284	exit 2;
285}
286
287# End
288