Haskell broken pipe error when working with streams - multithreading

I'm trying to build a player using streams. The main idea is to have a thread running a player that reads from bytes that come from another thread that downloads youtube audio concurrently. The code works for a while and the content is streamed correctly, but after a few seconds I always got this error:
Exception: fd:13: hPutBuf: resource vanished (Broken pipe).
I guess I'm missing something, because even when using the connect function the result is the same. Here's the code (simplified):
import Control.Concurrent
import System.IO.Streams
import Data.ByteString
main = do
(sink,_,_,_) <- runInteractiveCommand "mplayer -novideo - cache 5096 -"
mainSink <- lockingOutputStream sink -- main audio stream, goes straight to player
(_,source,_,_) <- runInteractiveCommand "yt-dlp \"https://www.youtube.com/watch?v=uFtfDK39ZhI\" -f bv+ba -o -"
loop mainSink source
loop :: OutputStream ByteString -> InputStream ByteString -> IO ()
loop sink src = do
sourceBytes <- peek src
case sourceBytes of
Nothing -> do loop sink src
Just _ -> do
audioBytes <- read src
write audioBytes sink
loop sink src

The problem appears to be that mplayer is generating its usual verbose terminal output on stdout and stderr, while yt-dlp is similarly generating output on stderr. Since you toss these handles away and never drain them, eventually the pipe buffers fill, and the processes get stuck. I can't say precisely why one or both of the processes dies instead of just hanging, but that's what's happening. Here's a simple example that redirects the unneeded output to /dev/null and appears to work:
import System.IO.Streams
main = do
(sink,_,_,_) <- runInteractiveCommand "mplayer -cache 5096 - 2>/dev/null >&2"
(_,source,_,_) <- runInteractiveCommand "yt-dlp \"https://www.youtube.com/watch?v=uFtfDK39ZhI\" -f bv+ba -o - 2>/dev/null"
connect source sink

Related

basic mqtt with haskell

I moved mqtt-hs to LTS-5.13 and compiled just fine with stack. Then I created the following subscriber to listen on a topic hierarchy. This is the subscriber code
{-# LANGUAGE OverloadedStrings #-}
module Main(main) where
import Control.Concurrent (threadWaitRead)
import System.Posix.Types
import Network.MQTT
import Network.MQTT.Logger
main :: IO ()
main = do
conn <- connect defaultConfig { cLogger = warnings stdLogger, cHost = "192.168.0.1" }
qos <- subscribe conn Confirm "/something" callback
putStrLn "control-c to finish"
threadWaitRead $ Fd 1
callback topic payload = putStrLn $ "A message was published to " ++ show topic ++ ": " ++ show payload
When I send something to the topic (using a simple Haskell publisher too), I am getting this in the console of this program:
control-c to finish
[Error] {handle: <socket: 3>}: recvLoop: end of file
[Error] recvLoop: No reconnect, terminating.
but no other output.
Both publisher and subscriber connect to a broker (Mosquitto). The subscriber seems to be Ok, the above happens only when receiving the message from the publisher. The above message also occurs when I stop the broker.
Any ideas?
Update
I cloned most recent mqtt-hs (0.3.0) and introduced this change
--- a/Network/MQTT.hs
+++ b/Network/MQTT.hs
## -448,9 +448,10 ## recvLoop :: MQTT -> IO ()
recvLoop m = loopWithReconnect m "recvLoop" $ \mqtt -> do
h <- readMVar (handle mqtt)
eof <- hIsEOF h
- if eof
- then ioError $ mkIOError eofErrorType "" (Just h) Nothing
- else getMessage mqtt >>= dispatchMessage mqtt
+ getMessage mqtt >>= dispatchMessage mqtt
+ -- if eof
+ -- then ioError $ mkIOError eofErrorType "" (Just h) Nothing
+ -- else getMessage mqtt >>= dispatchMessage mqtt
`catch`
\e -> logWarning mqtt $ "recvLoop: Caught " ++ show (e :: MQTTException)
i.e, I disabled the EOF checking. Now the message is printed to the console, but the subscriber enters into a loop throwing [Warning] recvLoop: Caught EOF as fast as it can.
Is this a mosquito error or bug in mqtt-hs?
Update 2
I can confirm it works with ActiveMQ without the hack. Having said this, it is better if mqtt-hs could recover from broker closing connection to a subscriber.
I believe that you might have it misconfigured. I'm currently using mqtt-hs in production and have almost no issues with it (barring a bug that has already been corrected in the project's github). The new update uses a TChan to have the messages delivered correctly as in a persistent connection, there is a chance the that some messages may be lost as the handler has not yet been made available.
You define the connection to the broker, but you don't tell the client about how the reconnections should be handled. For reference, I'm using something like the following at the moment:
mqttConfig :: HostName -> MQTTConfig
mqttConfig host = defaultConfig { cClean = False
, cClientID = "myClientId"
, cHost = host
, cUsername = Just "username"
, cPassword = Just "password"
, cKeepAlive = Just 10
, cReconnPeriod = Just 1
, cLogger = stdLogger }
Even though the version in use here is slightly updated, very little needed to change and reconnctions happen as needed when the broker (mosquitto as well here) goes down and then later recovers.

Detect when reader closes named pipe (FIFO)

Is there any way for a writer to know that a reader has closed its end of a named pipe (or exited), without writing to it?
I need to know this because the initial data I write to the pipe is different; the reader is expecting an initial header before the rest of the data comes.
Currently, I detect this when my write() fails with EPIPE. I then set a flag that says "next time, send the header". However, it is possible for the reader to close and re-open the pipe before I've written anything. In this case, I never realize what he's done, and don't send the header he is expecting.
Is there any sort of async event type thing that might help here? I'm not seeing any signals being sent.
Note that I haven't included any language tags, because this question should be considered language-agnostic. My code is Python, but the answers should apply to C, or any other language with system call-level bindings.
If you are using an event loop that is based on the poll system call you can register the pipe with an event mask that contains EPOLLERR. In Python, with select.poll,
import select
fd = open("pipe", "w")
poller = select.poll()
poller.register(fd, select.POLLERR)
poller.poll()
will wait until the pipe is closed.
To test this, run mkfifo pipe, start the script, and in another terminal run, for example, cat pipe. As soon as you quit the cat process, the script will terminate.
Oddly enough, it appears that when the last reader closes the pipe, select indicates that the pipe is readable:
writer.py
#!/usr/bin/env python
import os
import select
import time
NAME = 'fifo2'
os.mkfifo(NAME)
def select_test(fd, r=True, w=True, x=True):
rset = [fd] if r else []
wset = [fd] if w else []
xset = [fd] if x else []
t0 = time.time()
r,w,x = select.select(rset, wset, xset)
print 'After {0} sec:'.format(time.time() - t0)
if fd in r: print ' {0} is readable'.format(fd)
if fd in w: print ' {0} is writable'.format(fd)
if fd in x: print ' {0} is exceptional'.format(fd)
try:
fd = os.open(NAME, os.O_WRONLY)
print '{0} opened for writing'.format(NAME)
print 'select 1'
select_test(fd)
os.write(fd, 'test')
print 'wrote data'
print 'select 2'
select_test(fd)
print 'select 3 (no write)'
select_test(fd, w=False)
finally:
os.unlink(NAME)
Demo:
Terminal 1:
$ ./pipe_example_simple.py
fifo2 opened for writing
select 1
After 1.59740447998e-05 sec:
3 is writable
wrote data
select 2
After 2.86102294922e-06 sec:
3 is writable
select 3 (no write)
After 2.15910816193 sec:
3 is readable
Terminal 2:
$ cat fifo2
test
# (wait a sec, then Ctrl+C)
There is no such mechanism. Generally, according to the UNIX-way, there are no signals for streams opening or closing, on either end. This can only be detected by reading or writing to them (accordingly).
I would say this is wrong design. Currently you are trying to have the receiver signal their availability to receive by opening a pipe. So either you implement this signaling in an appropriate way, or incorporate the "closing logic" in the sending part of the pipe.

How to implement data streaming with the Snap framework?

I'd like to implement streaming of large data (in both directions) with the Snap server. To explore the possibilities I created a sample program that has two endpoints - reading and writing. There is a very simple internal buffer that holds one ByteString and whatever is written to the writing endpoint appears in the reading one. (Currently there is no way how to terminate the stream, but that's fine for this purpose.)
{-# LANGUAGE OverloadedStrings #-}
import Control.Applicative
import Control.Concurrent.MVar.Lifted
import Control.Monad
import Data.ByteString (ByteString)
import Blaze.ByteString.Builder (Builder, fromByteString)
import Data.Enumerator
import qualified Data.Enumerator.List as E
import Data.Enumerator.Binary (enumFile, iterHandle)
import Snap.Core
import Snap.Http.Server
main :: IO ()
main = do
buf <- newEmptyMVar
quickHttpServe (site buf)
site :: MVar ByteString -> Snap ()
site buf =
route [ ("read", modifyResponse (setBufferingMode False
. setResponseBody (fromBuf buf)))
, ("write", runRequestBody (toBuf buf))
]
fromBuf :: MVar ByteString -> Enumerator Builder IO a
fromBuf buf = E.repeatM (liftM fromByteString $ takeMVar buf)
toBuf :: MVar ByteString -> Iteratee ByteString IO ()
toBuf buf = E.mapM_ (putMVar buf)
Then I run in different terminals
curl http://localhost:8000/read >/dev/nul
and
dd if=/dev/zero bs=1M count=100 | \
curl --data-binary #- http://localhost:8000/write
But the writing part fails with an exception escaped to toplevel: Too many bytes read. This is obviously an instance of TooManyBytesReadException, but I couldn't find where it's thrown. Writing smaller amount of data like 1MB works as expected.
My questions are:
Where/how to fix the reading limit?
Will this stream data, without loading the whole POST request in memory? If not, how to fix it?
It will work if you add any content type that's not "application/x-www-form-urlencoded" to your /write, e.g.:
dd if=/dev/zero bs=1M count=100 | \
curl -H "Content-Type: application/json" --data-binary #- http://localhost:8000/write
This bit in Snap does something like
if contentType == Just "application/x-www-form-urlencoded" then readData maximumPOSTBodySize
where
maximumPOSTBodySize = 10*1024*1024
and x-www-form-urlencoded is curl's default.
To follow up on the previous answer: because forms of type application/x-www-form-urlencoded are so common, as a convenience Snap auto-decodes them for you and puts them into a parameters map in the request. The idea is similar in spirit to e.g. $_POST from PHP.
However, since these maps are read into RAM, naively decoding unbounded amounts of this data would allow an attacker to trivially DoS a server by sending it arbitrary amounts of this input until heap exhaustion. For this reason snap-server limits the amount of data it is willing to read in this way.

Haskell ZeroMQ binding not working for REQ socket

So here i was, barely able to install the libzmq on a windows desktop and then zeromq-haskell with cabal. I wanted to test the api by binding a python program with a haskell program in a hello-world type application.
So the most basic pattern i see is the request-reply pattern . First i tried to make the server in haskell (REP) and the client in python (REQ), witch failed miserably no matter what i did. The generated exception message was Exception: receive: failed (No error).
So i look inside the System.ZMQ and System.ZMQ.Base source code and i see that receive throws an error on calling c_zmq_recv , witch in turn maps directly to a ffi (?) call to the C api. So i think perhaps i didn't do the installation properly , but then i try to make the client in Haskell and the server in python and i notice it works without any problem, so perhaps the recv interface isn't the problem here.
Here is the haskell code below , with both client and server functions
import System.ZMQ
import Control.Monad (forM_,forever)
import Data.ByteString.Char8 (pack,unpack)
import Control.Concurrent (threadDelay)
clientMain :: IO ()
clientMain = withContext 1 (\context->do
putStrLn "Connecting to server"
withSocket context Req $ (\socket-> do
connect socket "tcp://127.0.0.1:5554"
putStrLn $ unwords ["Sending request"]
send socket (pack "Hello...") []
threadDelay (1*1000*1000)
reply<-receive socket []
putStrLn $ unwords ["Received response : ",unpack reply]))
serverMain :: IO ()
serverMain = withContext 1 (\context-> do
putStrLn "Listening at 5554"
withSocket context Rep $ (\socket-> do
connect socket "tcp://127.0.0.1:5554"
forever $ do
message<-receive socket [] -- this throws an IO Exception
putStrLn $ unwords ["Received request : ",unpack message]
threadDelay (1*1000*1000)
send socket (pack "World") [] ))
main :: IO ()
main = serverMain -- replace with clientMain and it works
Now i really didn't get around to testing all other modes of communication (push/pull, subscribe/publish, pair etc.) and for what i need the python server/haskell client is probably better but i am curious about weather i'm doing something wrong or if any part of my code is broken in any way.
Thanks in advance
You need to make one of the sockets (usually the server) bind, you seem to have them both connecting.
Try changing connect socket "tcp://127.0.0.1:5554" to bind socket "tcp://127.0.0.1:5554" in the serverMain function.

Connect to Unix domain socket as client in Haskel

I can't find a good info on dealing with Unix Domain sockets in Haskell.
I need a simple function to open a socket and write a command to it.
Can anyone help me with an advice of where to read about this or maybe give an example?
Basically, I need to port this simple Ruby function (if it helps to understand what I mean):
def monitor(string_command)
require "socket"
socket = File.join($vbase, #name, "monitor.soc")
raise RuntimeError, "Monitor socket does not exst!" unless File.exist? socket
begin
UNIXSocket.open(socket) do |s|
s.puts string_command
s.flush
end
rescue
return false
end
true
end
All it does opens socket and writes a command to it returning true upon success.
Thank you.
I think I figured it out. Well, it works and does what I need so I guess it should do for now.
Here is the snippet (without any error checks) if some one needs a similar thing:
monitor n c = do
soc <- socket AF_UNIX Stream 0
connect soc (SockAddrUnix (vmBaseDir </> n </> "monitor.soc"))
send soc (c ++ "\n")
sClose soc
Here is a full example:
{-# Language OverloadedStrings #-}
module Main where
import Network.Socket hiding (send)
import Network.Socket.ByteString
main :: IO ()
main = do
withSocketsDo $ do
soc <- socket AF_UNIX Stream 0
connect (soc) (SockAddrUnix "/tmp2/test2.soc")
send soc ("test123")
close soc

Resources