@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
1+{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables, PackageImports #-}
22
33module Network.Transport.Pipes
44 ( mkTransport
@@ -23,13 +23,24 @@ import System.Random (randomIO)
2323import System.IO (IOMode(ReadMode,AppendMode,WriteMode,ReadWriteMode),
2424 openFile, hClose, hPutStrLn, hPutStr, stderr, stdout)
2525import System.Posix.Files (createNamedPipe, unionFileModes, ownerReadMode, ownerWriteMode)
26−
27−-- Basing this on low level unix routines:
28−import qualified System.Posix.IO as PIO
29−-- Bytestring-version added in unix-2.5.1.0. Let's not depend on this yet:
30−-- import qualified System.Posix.IO.ByteString as PIO
3126import System.Posix.Types (Fd)
3227
28+#ifdef USE_UNIX_BYTESTRING
29+import qualified "unix-bytestring" System.Posix.IO.ByteString as PIO
30+import System.Posix.IO as PIO (openFd, defaultFileFlags, OpenMode(ReadWrite, WriteOnly))
31+(fromS,toS) = (BS.pack, BS.unpack)
32+(fromBS,toBS) = (id,id)
33+readit fd n = PIO.fdRead fd n
34+#else
35+import qualified System.Posix.IO as PIO
36+(toS,fromS) = (id,id)
37+(fromBS,toBS) = (BS.unpack, BS.pack)
38+readit fd n = do (s,_) <- PIO.fdRead fd n
39+ return (BS.pack s)
40+#endif
41+
42+----------------------------------------------------------------------------------------------------
43+
3344-- The msg header consists of just a length field represented as a Word32
3445sizeof_header = 4
3546
@@ -60,7 +71,9 @@ mkTransport = do
6071 mkSourceEnd :: String -> IO SourceEnd
6172 mkSourceEnd filename = do
6273 -- Initiate but do not block on file opening:
63− -- Note: Linux fifo semantics are NOT to block on open until
74+ -- Note: Linux fifo semantics are NOT to block on open-RW, but this is not Posix standard.
75+ --
76+ -- We may protect from blocking other threads by running on a separate (OS) thread:
6477-- mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
6578-- fd <- PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
6679 fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags
@@ -84,10 +97,8 @@ mkTransport = do
8497
8598 -- OPTION 2: Speculative file opening, plus this synchronnization:
8699-- fd <- readMVar mv
87−-- dbgprint1$ " (sending... got file descriptor) "
88−
89100 ----------------------------------------
90− cnt <- PIO.fdWrite fd (BS.unpack finalmsg) -- inefficient!
101+ cnt <- PIO.fdWrite fd (fromBS finalmsg) -- inefficient to use String here!
91102 unless (fromIntegral cnt == BS.length finalmsg) $
92103 error$ "Failed to write message in one go, length: "++ show (BS.length finalmsg)
93104 ----------------------------------------
@@ -105,8 +116,8 @@ mkTransport = do
105116
106117 mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
107118 fd <- takeMVar mv
108− let oneread n = do (s,cnt) <- PIO.fdRead fd (fromIntegral n)
109− return (BS.pack s, fromIntegral cnt)
119+ let oneread n = do bs <- readit fd (fromIntegral n)
120+ return (bs, BS.length bs)
110121 dbgprint2$ " Attempt read header..."
111122
112123 let spinread :: Int -> IO BS.ByteString