commit 135c4cbfae4fdf658fa4ac792487d99ba3a10e52
Merge: 1025002 2b51613
Author: Brian Foley <[email protected]>
Date: Wed Mar 23 14:31:48 2016 +0000
Merge branch 'stable-2.15' into stable-2.16
* stable-2.15
Update install-quick DRBD requirements to include DRBD 8.4
Fix memory/perf bug in gnt-cluster verify
Improve luxid QueryInstances performance for large clusters
Optimize LXC hypervisor GetAllInstancesInfo
Add debug logging for time to sendMsg in Haskell servers
Add debug logging to profile python CallRPCMethod
Bracket ConfigWriter writeConfigAndUnlock with debug logging
Bracket client LockConfig calls with debug logging
Get onInotify and onPollTimer to print filepath
Prevent InstanceShutdown from waiting on success
Manually resolve sendMsg patch conflict.
Signed-off-by: Brian Foley <[email protected]>
diff --cc src/Ganeti/UDSServer.hs
index b4f975f,31f2f6c..30ee1c5
--- a/src/Ganeti/UDSServer.hs
+++ b/src/Ganeti/UDSServer.hs
@@@ -287,14 -286,14 +287,17 @@@ clientToFd client | rh == wh = join (,
-- | Sends a message over a transport.
sendMsg :: Client -> String -> IO ()
sendMsg s buf = withTimeout (sendTmo $ clientConfig s) "sending a message" $
do
+ t1 <- getCurrentTimeUSec
- let encoded = UTF8.fromString buf
- handle = wsocket s
- B.hPut handle encoded
+ let handle = wsocket s
+ -- Allow buffering (up to 1MiB) when writing to the socket. Note that
+ -- otherwise we get the default of sending each byte in a separate
+ -- system call, resulting in very poor performance.
+ hSetBuffering handle (BlockBuffering . Just $ 1024 * 1024)
+ hPutStr handle buf
B.hPut handle bEOM
hFlush handle
+ t2 <- getCurrentTimeUSec
+ logDebug $ "sendMsg: " ++ (show ((t2 - t1) `div` 1000)) ++ "ms"
-- | Given a current buffer and the handle, it will read from the
-- network until we get a full message, and it will return that
