@@ -24,22 +24,11 @@ import System.IO (IOMode(ReadMode,AppendMode,WriteMode,ReadWriteMode),
2424 openFile, hClose, hPutStrLn, hPutStr, stderr, stdout)
2525import System.Posix.Files (createNamedPipe, unionFileModes, ownerReadMode, ownerWriteMode)
2626
27−-- Option 1: low level unix routines:
28−-- Option 2: ByteString-provided IO routines
29−#define UNIXIO
30−#ifdef UNIXIO
31−-- Added in unix-2.5.1.0. Let's not depend on this yet:
32−-- import qualified System.Posix.IO.ByteString as PIO
27+-- Basing this on low level unix routines:
3328import 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
3431import System.Posix.Types (Fd)
35−#else
36−
37−#endif
38−
39−
40−-- An address is just a filename -- the named pipe.
41−data Addr = Addr String
42− deriving (Show,Read)
4332
4433-- The msg header consists of just a length field represented as a Word32
4534sizeof_header = 4
@@ -70,16 +59,12 @@ mkTransport = do
7059
7160 mkSourceEnd :: String -> IO SourceEnd
7261 mkSourceEnd filename = do
73−# ifndef KEEP_CLOSED
74−-- fd <- openFile filename AppendMode
75−-- _ <- openFile filename WriteMode
76−-- mv <- onOSThread$ openFile filename WriteMode
77− mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
78−
79− -- [2012.02.19] Still getting indefinite MVar block errors even
80− -- using IORefs here:
81−-- fdref <- newIORef Nothing
82−# endif
62+ -- Initiate but do not block on file opening:
63+ -- Note: Linux fifo semantics are NOT to block on open until
64+-- mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
65+-- fd <- PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
66+ fd <- PIO.openFd filename PIO.WriteOnly Nothing PIO.defaultFileFlags
67+
8368 return $
8469 -- Write to the named pipe. If the message is less than
8570 -- PIPE_BUF (4KB on linux) then this should be atomic, otherwise
@@ -94,61 +79,34 @@ mkTransport = do
9479 error "Message larger than blocksize written atomically to a named pipe. Unimplemented."
9580 -- Otherwise it's just a simple write:
9681 -- We append the length as a header. TODO - REMOVE EXTRA COPY HERE:
97−
98−# ifdef KEEP_CLOSED
99−-- fd <- openFile filename AppendMode
100− fd <- openFile filename WriteMode
101−# else
102− -- OPTION 1: Lazy opening:
103− -- r <- readIORef fdref
104− -- fd <- case r of
105− -- Nothing -> do
106− -- dbgprint1$ " (No FD for sending yet... opening) "
107− -- fd <- openFile filename AppendMode
108− -- writeIORef fdref (Just fd)
109− -- return fd
110− -- Just fd -> return fd
111−
112− -- OPTION 2: Speculative file opening, plus this synchronnization:
113− fd <- readMVar mv
114− dbgprint1$ " (sending... got file descriptor) "
115−# endif
116−
117−-- TODO: Consider nonblocking opening of file to make things simpler.
118−
11982 let finalmsg = BS.concat (encode msgsize : bss)
12083 dbgprint1$ " Final send msg: " ++ show finalmsg
84+
85+ -- OPTION 2: Speculative file opening, plus this synchronnization:
86+-- fd <- readMVar mv
87+-- dbgprint1$ " (sending... got file descriptor) "
88+
12189 ----------------------------------------
122− -- BS.hPut fd finalmsg -- The actual send!
12390 cnt <- PIO.fdWrite fd (BS.unpack finalmsg) -- inefficient!
12491 unless (fromIntegral cnt == BS.length finalmsg) $
12592 error$ "Failed to write message in one go, length: "++ show (BS.length finalmsg)
12693 ----------------------------------------
127−# ifdef KEEP_CLOSED
128− hClose fd -- TEMP -- opening and closing on each send!
129−# endif
94+
13095 return ()
13196 }
13297
133−
134−-- mkTargetEnd :: Fd -> MVar () -> TargetEnd
98+ mkTargetEnd :: String -> MVar () -> TargetEnd
13599 mkTargetEnd filename lock = TargetEnd
136100 { receive = do
137101 dbgprint2$ "Begin receive action..."
138102 -- This should only happen on a single process. But it may
139103 -- happen on multiple threads so we grab a lock.
140104 takeMVar lock
141−#ifdef UNIXIO
142−-- fd <- PIO.openFd filename PIO.ReadOnly Nothing PIO.defaultFileFlags
105+
143106 mv <- onOSThread$ PIO.openFd filename PIO.ReadWrite Nothing PIO.defaultFileFlags
144107 fd <- takeMVar mv
145108 let oneread n = do (s,cnt) <- PIO.fdRead fd (fromIntegral n)
146109 return (BS.pack s, fromIntegral cnt)
147−#else
148− fd <- openFile filename ReadMode
149− let oneread n = do bs <- BS.hGet fd n;
150− return (bs, BS.length bs)
151−#endif
152110 dbgprint2$ " Attempt read header..."
153111
154112 let spinread :: Int -> IO BS.ByteString