Arjen Markus (5 january 2005) I was inspired by a white paper from Electric Cloud, Inc. to consider a solution for a particular problem me and my colleagues are facing: the automatic tests for part of our software are taking hours and hours to complete.
Now these are all independent tasks: a single case consists of one or more programs that are run and results that are checked. There are a lot of cases. So, using several machines seems a nice way to reduce the time needed to run them all.
The scripts below illustrate how this can be done:
Okay, nothing fancy, but the principle works: there is one process in charge, all others cooperate smoothly.
# server.tcl --
# Server application that distributes work among interested clients
#
# General information:
# This script sets up a server that listens to a socket.
# Clients connect to it and are then passed a "job" that
# they should process. The jobs are found in the file "server.inp"
#
# setUp --
# Create the server
# Arguments:
# None
# Return value:
# None
#
proc setUp { } {
global srvsock
set port 8085
set timeout 60000
set srvsock [socket -server [list acceptClient $timeout] $port]
}
# acceptClient --
# Accept the service request
#
# Arguments:
# timelimit Maximum time to wait
# socket Name of the socket we listen to
# ip IP address of client
# args (Possibly) all other arguments
#
# Return value:
# None
#
proc acceptClient { timelimit socket ip args } {
fconfigure $socket -block false
fileevent $socket readable [list sendJob $socket]
}
# sendJob --
# Send the description of a newjob to the client
#
# Arguments:
# socket Name of the socket we listen to
#
# Return value:
# None
#
proc sendJob { socket } {
global jobfile
global srvsock
if { ! [eof $socket] } {
gets $socket line
puts "Client: $line"
#
# Get the next job description
#
set end 1
while { [gets $jobfile job] >= 0 } {
set end 0
if { [lindex [split $job] 0] == "job" } {
puts $socket [join [lrange [split $job] 1 end]]
puts " Sent: $job"
flush $socket
break
}
}
#
# If end of job file ...
#
if { $end } {
close $jobfile
close $srvsock
puts "Server done!"
exit
}
} else {
close $socket
}
}
# main --
# Open the file with jobs and get the server going ...
#
set ::jobfile [open "server.inp" "r"]
setUp
puts "Server up and running ..."
vwait forever # client.tcl --
# Client application that takes work from a server
#
# General information:
# This script connects to the server and accepts a job to be done
#
# setUp --
# Connect to the server
# Arguments:
# None
# Return value:
# None
#
proc setUp { {host localhost} } {
global channel
set port 8085
set channel [socket $host $port]
puts $channel "client-[pid]"
flush $channel
fileevent $channel readable [list acceptJob $channel]
}
# acceptJob --
# Receive the job that is to be done from the server
#
# Arguments:
# None
# Return value:
# None
#
proc acceptJob {channel} {
if { [gets $channel line] >= 0 } {
puts "Received job: $line"
#
# Wait a while ...
#
after [expr {int(10000*rand())}]
#
# Send a string to say we are ready
#
puts $channel "client-[pid]"
flush $channel
} else {
#
# No more jobs ...
#
close $channel
puts "Done"
exit
}
}
# main --
# Get the client going ...
#
if { [llength $argv] > 0 } {
setUp [lindex $argv 0]
} else {
setUp
}
vwait forever# server.inp -- # Input for the server: # Lines that represent jobs ... # job "Test 1" job "Test 2" job "Test 3" job "Test 4" job "Test 5" job "Test 6" job "Test 7" job "Test 8" job "Test 9" job "Test 10"