You're not reading from the stdout or stderr of the subprocess, so either those handles get garbage collected and closed (as Donn pointed out), which will probably cause mplayer to crash, or the stdout buffer of the mplayer process will fill and further write()s to that file descriptor will block, causing deadlock. Try forking a couple of threads to keep those handles clear.

G


On Sat, May 17, 2014 at 1:44 AM, Karsten Gebbert <k@ioctl.it> wrote:
Hello,

I'm writing a little networking wrapper around a sub-process (mplayer
-idle -slave) and I'm running into some issues with the System.Process
API. This is the program:

> module Main where
>
> import System.IO
> import System.Process
> import Network.Socket hiding (recv)
> import Network.Socket.ByteString
> import Control.Concurrent
> import qualified Data.ByteString.Char8 as C
>
> -- WARNING: when compiled with -threaded, this program is likely not going
> -- to work. As soon as one writes to the stdin of the forked process, it
> -- zombifies and any other command with crash this program.
>
> main = withSocketsDo $ do
>     -- network stuff
>     addrinfos <- getAddrInfo Nothing (Just "localhost") (Just "4000")
>     let serveraddr = head addrinfos
>     sock <- socket (addrFamily serveraddr) Stream defaultProtocol
>     bindSocket sock (addrAddress serveraddr)
>     listen sock 1
>
>     -- mplayer
>     (hand,o,e,pid) <- runInteractiveProcess "mplayer" ["-fs", "-idle", "-slave"] Nothing Nothing
>     hSetBinaryMode hand False
>     hSetBuffering hand LineBuffering
>
>     putStrLn "listening for commands"
>     loop sock hand
>
>     -- closing everything down
>     sClose sock
>     terminateProcess pid
>     waitForProcess pid
>     return ()
>
> loop sock hand = do
>     (conn, _) <- accept sock
>     str <- recv conn 2048
>
>     putStr $ "received: " ++ C.unpack str
>
>     -- write command to handler
>     hPutStr hand $ C.unpack str
>
>     sClose conn
>     loop sock hand


When compile with -threaded, the mplayer process gets zombified and
hangs until I shut down the program. When compiled with non-threaded RTS
(thats whats its called, correct?) I can successfully send a few
commands, but then mplayer freezes. When I strace mplayer, this error is
what it gets stuck on.


    ioctl(0, TIOCGWINSZ, 0x7fff2897a070)    = -1 ENOTTY (Inappropriate ioctl for device)

Apparently that means I'm trying to communicate with it as though it
were a type writer. How fitting :)

The commands are all simple strings as docs here:

    http://www.mplayerhq.hu/DOCS/tech/slave.txt

My questions are these: is there anything I need to take care of when
handling sub-processes like this, specifically while writing to stdin of
the process, and with particular regard to -threaded? Does anybody spot
a problem or something I'm overlooking when handling processes like this?
I have been reading the API docs, but found no mention of potential
caveats pertaining to -threaded.

Thanks!

k


k@ioctl.it
+49(0)176 / 61995110
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe



--
Gregory Collins <greg@gregorycollins.net>