Commit b0a7e3771bfd changed sending of JSON-encoded answers to standard String sending. This was necessary as converting Strings to ByteStrings, even to lazy ones, fully enforced the String before the first Char got out of scope and could be garbage collected. The down-side of this approach is, that we know end up with one system call per character to be send. The good news, however, is that the library's buffering uses memory only a little more than a byte for the byte, so we can afford buffering in that layer. Do so, to reduce the number of system calls.
On a, not quite realistic, test cluster, this resulted in the time for a config-read going down by 1.5 orders of magnitude with only small increase in residual memory. Signed-off-by: Klaus Aehlig <[email protected]> --- src/Ganeti/UDSServer.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Ganeti/UDSServer.hs b/src/Ganeti/UDSServer.hs index a374f69..ab82e41 100644 --- a/src/Ganeti/UDSServer.hs +++ b/src/Ganeti/UDSServer.hs @@ -83,7 +83,8 @@ import Data.List import Data.Word (Word8) import qualified Network.Socket as S import System.Directory (removeFile) -import System.IO (hClose, hFlush, hPutStr, hWaitForInput, Handle, IOMode(..)) +import System.IO ( hClose, hFlush, hPutStr, hWaitForInput, Handle, IOMode(..) + , hSetBuffering, BufferMode(..)) import System.IO.Error (isEOFError) import System.Posix.Types (Fd) import System.Posix.IO (createPipe, fdToHandle, handleToFd) @@ -287,6 +288,7 @@ clientToFd client | rh == wh = join (,) <$> handleToFd rh sendMsg :: Client -> String -> IO () sendMsg s buf = withTimeout (sendTmo $ clientConfig s) "sending a message" $ do let handle = wsocket s + hSetBuffering handle (BlockBuffering . Just $ 1024 * 1024) hPutStr handle buf B.hPut handle bEOM hFlush handle -- 2.7.0.rc3.207.g0ac5344
