@@ -14,6 +14,8 @@ import Data.Int
1414import System.Environment (getArgs, withArgs)
1515import Data.Time (getCurrentTime, diffUTCTime)
1616import System.IO (withFile, IOMode(..), hPutStrLn)
17+import Control.Concurrent (forkIO)
18+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)
1719
1820#ifndef LAZY
1921import qualified Data.ByteString.Char8 as BS
@@ -50,42 +52,43 @@ decode :: Ser.Serialize a => BS.ByteString -> Either String a
5052-- The server must be restarted between benchmarks.
5153main :: IO ()
5254main = do
53− args <- getArgs
54− case args of
55− "server" : host : service : sourceAddrFilePath : [] -> do
56− -- establish transport
57− transport <- mkTransport $ TCPConfig defaultHints host service
58−
59− -- create ping end
60− putStrLn "server: creating ping end"
61− (sourceAddrPing, targetEndPing) <- newConnection transport
62− BS.writeFile sourceAddrFilePath $ serialize sourceAddrPing
63−
64− -- create pong end
65− putStrLn "server: creating pong end"
66− [sourceAddrPongBS] <- receive targetEndPing
67− sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
68−
69− -- always respond to a ping with a pong
70− putStrLn "server: awaiting pings"
71− pong targetEndPing sourceEndPong
72−
73−
74− "client" : host : service : sourceAddrFilePath : pingsStr : [] -> do
75− let pings = read pingsStr
76− -- establish transport
77− transport <- mkTransport $ TCPConfig defaultHints host service
78−
79− -- create ping end
80− sourceAddrPingBS <- BS.readFile sourceAddrFilePath
81− sourceEndPing <- connect . fromJust $ deserialize transport sourceAddrPingBS
82−
83− -- create pong end
84− (sourceAddrPong, targetEndPong) <- newConnection transport
85− send sourceEndPing [serialize sourceAddrPong]
86−
87− ping sourceEndPing targetEndPong pings
88− putStrLn "Done with all ping/pongs."
55+ [pingsStr] <- getArgs
56+ serverReady <- newEmptyMVar
57+
58+ -- Start the server
59+ forkIO $ do
60+ -- establish transport
61+ transport <- mkTransport $ TCPConfig defaultHints "127.0.0.1" "8080"
62+
63+ -- create ping end
64+ putStrLn "server: creating ping end"
65+ (sourceAddrPing, targetEndPing) <- newConnection transport
66+ putMVar serverReady sourceAddrPing
67+
68+ -- create pong end
69+ putStrLn "server: creating pong end"
70+ [sourceAddrPongBS] <- receive targetEndPing
71+ sourceEndPong <- connect . fromJust $ deserialize transport sourceAddrPongBS
72+
73+ -- always respond to a ping with a pong
74+ putStrLn "server: awaiting pings"
75+ pong targetEndPing sourceEndPong
76+
77+ -- Client
78+ sourceAddr <- takeMVar serverReady
79+ let pings = read pingsStr
80+ -- establish transport
81+ transport <- mkTransport $ TCPConfig defaultHints "127.0.0.1" "8081"
82+
83+ -- create ping end
84+ sourceEndPing <- connect sourceAddr
85+
86+ -- create pong end
87+ (sourceAddrPong, targetEndPong) <- newConnection transport
88+ send sourceEndPing [serialize sourceAddrPong]
89+
90+ ping sourceEndPing targetEndPong pings
91+ putStrLn "Done with all ping/pongs."
8992
9093-- | The message we use to ping (CAF so that we don't keep encoding it)
9194pingMessage :: BS.ByteString