Why does `forever` mean this code doesn't read from a socket or print to stdout?

Question

I have written a systemd socket activated service in Haskell. The idea is the service should be started automatically when a message is sent to its socket, the service should process all messages waiting on the socket and then exit.

Note: the reason the service should close after processing all waiting messages (as opposed to running forever) is there shall be several hours or days between socket activations.

deploy-trigger.socket:

[Socket]
ListenStream=/var/run/deploy-trigger.socket

[Install]
WantedBy=sockets.target

deploy-trigger.service:

[Service]
ExecStart=/home/user4301448/.local/bin/deploy-trigger-exe
StartLimitInterval=0

Main.hs

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad (forever)
import qualified Data.ByteString.Char8 as BS (putStrLn)
import Data.Foldable (foldl')
import Network.Socket (withSocketsDo, accept, close, SockAddr(SockAddrUnix), Socket)
import Network.Socket.ByteString (recv)
import Network.Socket.Activation (getActivatedSockets)
import System.Exit (exitWith, ExitCode(..))

main :: IO ()
main = withSocketsDo $ forever $ getActivatedSockets >>= processSocks

processSocks :: Maybe [Socket] -> IO ()
processSocks (Just socks) = do
    putStrLn "Got socket(s)."
    traverse_ (\sock -> accept sock >>= printMsgFromSock) socks
    putStrLn "Finished processing socket(s)."
processSocks Nothing = do
    putStrLn "Received no socket(s)."
    exitWith ExitSuccess

printMsgFromSock :: (Socket, SockAddr) -> IO ()
printMsgFromSock (sock, sockaddr) = do
    msg <- recv sock 2048
    case sockaddr of
        SockAddrUnix s -> putStrLn ("Printing message from socket: " ++ s)
        _ -> putStrLn "Printing message from something that is not a UNIX socket."
    BS.putStrLn msg
    close sock

When compiled (and installed with stack install), then activated by sending some text to the socket using the following command:

printf 'Hello world\r\n' | nc -U /var/run/deploy-trigger.socket

the following is printed to the systemd journal (I'm using journalctl -f to watch the logs):

systemd[1]: Starting deploy-trigger.service...

nothing else is printed; the process runs forever and maxes out all the computer's CPU cores. Why does this happen and is there a way to change the behaviour to that described in the first paragraph?

Changing main to the following:

main = withSocketsDo $ getActivatedSockets >>= processSocks

thus removing forever, stack installing again and sending some text to the socket prints the following to the journal:

systemd[1]: Starting deploy-trigger.service...
deploy-trigger-exe[14800]: Got socket(s).
deploy-trigger-exe[14800]: Printing message from socket:
deploy-trigger-exe[14800]: Hello world
deploy-trigger-exe[14800]: Finished processing socket(s).
systemd[1]: Started deploy-trigger.service.

deploy-trigger-exe then exits cleanly. The downside to this is the binary appears to be run by systemd for every message sent to the socket, which is not desirable.

Note: I suspect the issue is rooted in my incompetence regarding UNIX sockets. Any answers with supporting information on what I'm misunderstanding, correcting my duff terminology would be a bonus.

That is quite strange. Could it have something to do with flushing? Try exiting the program after the first iteration: `main = withSocketsDo $ forever $ getActivatedSockets >>= processSocks >>= \_ -> exitSuccess` (this should be equivalent to the other program without `forever`) — Li-yao Xia, Jan 28 '18 at 23:16
@Li-yaoXia I replaced `main` with this: `main = withSocketsDo $ forever $ getActivatedSockets >>= processSocks >>= \_ -> exitWith ExitSuccess ` and the program behaves in the same way as with `forever` removed. That is it prints the info messages (as in the OP) to the journal and then exits. Does this information give you any idea of what may be happening? It's almost like the compiler decides `processSockets` doesn't actually *do* anything and optimises it out. — user4301448, Jan 29 '18 at 02:43
Try adding `hFlush stdout` instead of `exitWith ExitSuccess` there. Also, I'm not sure this is going to be relevant, but this `foldl'` only ends up processing the last socket in the list. You probably meant to use `traverse_` instead. — Li-yao Xia, Jan 29 '18 at 04:09
Haven't worked with systemd, just a wild guess: `withSocketsDo $ getActivatedSockets >>= \ss -> forever $ processSocks ss`. — arrowd, Jan 29 '18 at 06:26
@Li-yaoXia that works! Thank you! Still uses 100% CPU and the process never ends, but the journal has the lines (from the OP) I expected. I can understand why the process would run the CPU, presumably `threadDelay` would fix that, but do you know a way to make the code process all the waiting messages on the socket and then exit? — user4301448, Jan 29 '18 at 18:15
@arrowd thanks very much for looking at this; sadly that didn't change the code's behaviour. Seems flushing stdout is what's needed (see Li-yao's comment above). — user4301448, Jan 29 '18 at 20:20
@Li-yaoXia thank you very much for the recommendation to change `foldl'` for `traverse_`. I think you're right and have updated the code in the question. — user4301448, Jan 29 '18 at 20:28
Unfortunately I'm not familiar enough with the API to answer your last question. — Li-yao Xia, Jan 29 '18 at 22:02
@Li-yaoXia I think what you've provided is helpful, and adequately answers the question from the title. The bit specific to sockets could be split out into a second question. Would you like to write it up your comments as an answer? I will mark it as the accepted answer if you do. — user4301448, Jan 31 '18 at 16:25

score 3 · Answer 1 · answered Jan 31 '18 at 16:52

It seems that because stdout is not connected to a terminal, the small output of putStrLn remains buffered and thus does not appear in the logs. This is fixed by calling hFlush regularly, for example:

main = withSocketsDo $ forever $
  getActivatedSockets >>= processSocks >>= \_ -> hFlush stdout

score 2 · Accepted Answer · answered Feb 01 '18 at 13:49

OK, first regarding the missing output, it is exactly as Li-yao Xia says, on Linux outputs are block-buffered if written to a pipe.

Change your main to

main = do
    hSetBuffering stdout LineBuffering
    withSocketsDo $ forever $ getActivatedSockets >>= processSocks

and you will see in journalctl -f:

systemd[1]: Started deploy-trigger.service.
deploy-trigger-exe[14197]: Got socket(s).
deploy-trigger-exe[14197]: Printing message from socket:
deploy-trigger-exe[14197]: Hello world
deploy-trigger-exe[14197]: Finished processing socket(s).
deploy-trigger-exe[14197]: Got socket(s).

After this (expected) output, your program will hang.

How to find out where it hangs? Of course with strace (rumor has it that 95% of all computer problems can be solved with strace).

% sudo strace -fp $(pidof deploy-trigger-exe)
strace: Process 14197 attached

As we can see, the program is now blocked in accept sock. This makes sense (because the other side has disconnected).

Another thing you might be confused about is why it prints Got socket(s) a second time.

I think you have a misunderstanding on how getActivatedSockets works. I conclude so from you writing forever $ getActivatedSockets >>= .... This suggests to me that you expect that the second time you call getActivatedSockets, it would return something else than the first time (in particular, I suspect that you think it will return Nothing after having "processed" the sockets in some way).

But looking at the code of getActivatedSockets, it will always return the same result (because it just reads the contents of some environment variables). It thus doesn't seem to make sense to wrap it in forever.

You wrote

the service should process all messages waiting on the socket and then exit

To achieve that, I think you should just remove the forever:

main = do
    hSetBuffering stdout LineBuffering
    withSocketsDo $ getActivatedSockets >>= processSocks
    putStrLn "End of main, exiting"

(When trying this changed code, don't forget to kill the still-running deploy-trigger-exe first.)

You will get:

systemd[1]: Started deploy-trigger.service.
deploy-trigger-exe[15881]: Got socket(s).
deploy-trigger-exe[15881]: Printing message from socket:
deploy-trigger-exe[15881]: Hello world
deploy-trigger-exe[15881]: Finished processing socket(s).
deploy-trigger-exe[15881]: End of main, exiting

which I think is what you are looking for.

Another tip: Consider that if you send a large message to the socket, you will have to loop around recv sock ... to receive all the data.

^{(Quick plug: I'm in the business of helping with problems like this one.)}

Why does `forever` mean this code doesn't read from a socket or print to stdout?

2 Answers2