Consider something like this:
...
handleShutdown :: ThreadId -> IO ()
handleShutdown tid = doSomethingFunny >> throwTo tid ExitSuccess
main = do
...
installHandler sigTERM (Catch $ myThreadId >>= handleShutdown) Nothing
forever $ do
stuff
...
If sigINT (Ctrl+C) is handled in this manner, the process finishes nicely. However, it seems like sigTERM is being used by Haskell internally and the code above doesn't exit from the main process at all. Is there a way to exit the process from a sigTERM handler without using an MVar and a custom loop? I couldn't find any information on the sigTERM handling anywhere (didn't read ghc sources, that's just too much for me to handle).
Update:
The following works:
main = do
...
tid <- myThreadId -- This moved out of the Catch handler below.
installHandler sigTERM (Catch $ handleShutdown tid) Nothing
forever $ do
stuff
...
Sorry for short answer, but on mobile.
You want to run myThreadId from outside of the handler itself to get the main thread's ID. You're currently getting the ID of the signal handler itself.
Related
I'm currently authoring an application in Haskell that relies on Yesod and its web sockets implementation.
I was wondering what is the correct way to acquire and release resources for a WebSocketT handler.
For example, in the following naive case...
chatApp :: WebSocketsT Handler ()
chatApp = do
let outgoingFlow = forever $ deliverOutgoingMessages
let incomingFlow = forever $ deliverIncomingMessages
bracket_ acquireResource
releaseResource
(race_ outgoingFlow incomingFlow)
... releaseResource does not seem to be called when a client disconnects abruptly or purposefully.
This is what I ended up doing over the weekend. This is essentially a replication of how web socket background ping process works, apart for the fact that I'm not swallowing the ping send exception when the other end is no longer reachable, but rather using it to detect the disconnection.
echoApp' :: WebSocketsT Handler ()
echoApp' = do
conn <- ask
let acquire = putStrLn "Acquiring..."
release = putStrLn "Releasing"
hardWork = (threadDelay 600000000)
ping i = do
threadDelay (30 * 1000 * 1000)
WS.sendPing conn (T.pack $ show i)
ping (i + 1)
liftIO $ bracket_ acquire release $ race_ hardWork (ping 1)
The downside of this approach is that there's still an up to 30 seconds window when the web socket process is lingering, but at least the resource gets eventually released in a more or less controllable way.
What is the proper way to write an interruptible reader thread in OCaml? Concretely, the following single-threaded program works (that is, Ctrl-C Ctrl-C interrupts it immediately):
exception SigInt
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
try output_string stdout (input_line stdin);
with SigInt -> print_endline "SINGLE_SIGINT"
The following program, on the other hand, cannot be interrupted with C-c C-c:
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
let go () =
try output_string stdout (input_line stdin);
with SigInt -> print_endline "CHILD_SIGINT" in
try Thread.join (Thread.create go ());
with SigInt -> print_endline "PARENT_SIGINT"
What's a cross-platform way to implement an interruptible reader thread in OCaml?. That is, what changes do I need to make to the multithreaded program above to make it interruptible?
I've explored multiple hypotheses to understand why the multi-threaded example above was not working, but none made sense full to me:
Maybe input_line isn't interruptible? But the the single-threaded example above would not work.
Maybe Thread.join is blocking the signal for the whole process? But in that case the following example would not be interruptible either:
let _ =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
let rec alloc acc =
alloc (1::acc) in
let go () =
try alloc []
with SigInt -> print_endline "CHILD_SIGINT" in
try Thread.join (Thread.create go ());
with SigInt -> print_endline "PARENT_SIGINT"
…and yet it is: pressing Ctrl-C Ctrl-C exits immediately.
Maybe the signal is delivered to the main thread, which is waiting uninterruptibly in Thread.join. If this was true, pressing Ctrl-C Ctrl-C then Enter would print "PARENT_SIGINT". But it doesn't: it prints "CHILD_SIGINT", meaning that the signal was routed to the child thread and delayed until input_line completed. Surprisingly, though, this works (and it prints CHILD_SIGINT)
let multithreaded_sigmask () =
Sys.set_signal Sys.sigint (Sys.Signal_handle (fun _ -> raise SigInt));
let go () =
try
ignore (Thread.sigmask Unix.SIG_SETMASK []);
output_string stdout (input_line stdin);
with SigInt -> print_endline "CHILD_SIGINT" in
try
ignore (Thread.sigmask Unix.SIG_SETMASK [Sys.sigint]);
Thread.join (Thread.create go ());
with SigInt -> print_endline "PARENT_SIGINT"
… but sigmask is not available on Windows.
Two things are working together to make the behavior hard to understand. The first is OS signal delivery to the process. The second is how the OCaml runtime delivers them to the application code.
Looking at the OCaml source code, its OS signal handler simply records the fact that a signal was raised, via a global variable. That flag is then polled by other parts of the OCaml runtime, at times when it is safe to deliver the signal. So the Thread.sigmask controls which thread(s) the OS signal can be delivered on, to the OCaml runtime. It does not control delivery to your app.
Pending signals are delivered by caml_process_pending_signals(), which is called by caml_enter_blocking_section() and caml_leave_blocking_section(). There is no thread mask or affinity here... the first thread to process the global list of pending signals does so.
The input_line function polls the OS for fresh input, and each time it does, it enters and leaves the blocking section, so it is polling frequently for signals.
Thread.join enters the blocking section, then blocks indefinitely, until the thread is finished, then leaves the blocking section. So while it is waiting, it is not polling for pending signals.
In your first interruptable example, what happens if you actually type and hit enter? Does the input_line call actually accumulate input and return it? It may not.. the Thread.join may own the blocking section and be preventing input and signal delivery process-wide.
http://zguide.zeromq.org/hs:asyncsrv
hope to terminate the program by press q to exit
main :: IO ()
main =
runZMQ $ do
async $ clientTask "A"
async $ clientTask "B"
async $ clientTask "C"
async serverTask
liftIO $ threadDelay $ 5 * 1000 * 1000
Process-to-process message passing is the very power of the ZeroMQ, so use it:
design a central aKbdMONITOR-thread, that monitors Keyboard and scans for Q | q
async $ clientTask "C"
async $ aKbdMONITOR -- Add central-service async thread
equip this aKbdMONITOR-thread with a PUB service to broadcast to any SUB-side an appearance of such event
aKbdSCANNER <- socket Pub -- PUB-side adequate ZeroMQ Archetype
bind aKbdSCANNER "tcp://*:8123" -- yes, can serve even for remote hosts
equip all other threads with a SUB pattern part and review any subsequent arriving event-notification from aKbdMONITOR-thread to decide locally about self-termination in case aKbdMONITOR-thread announces such case as requested above to exit
aKbdSCANNER <- socket Sub -- SUB-side adequate ZeroMQ Archetype
connect aKbdSCANNER "tcp://ipKBD:8123" -- tcp transport-class remote ipKBD
--
-- + do not forget to subscribe
-- + use poll to scan
My main function has one infinite loop and I'd like to execute each loop of it every 100 millisecond. I know it's done by some concurrent or parallel method, but I've never done such things before and have no idea even where to start from. How would you implement such function?
Assuming your loop body takes negligible time, just use threadDelay from Control.Concurrent:
import Control.Concurrent
main = forever $ do
mainBody
threadDelay (100*1000) -- value in microseconds
Update: To account for the time of your loop body, use this:
import Data.Time.Clock
import Control.Concurrent
import Control.Monad
mainBody :: IO ()
mainBody = putStrLn "hi"
main = forever $ do
start <- getCurrentTime
mainBody
end <- getCurrentTime
let diff = diffUTCTime end start
usecs = floor (toRational diff * 1000000) :: Int
delay = 100*1000 - usecs
if delay > 0
then threadDelay delay
else return ()
Haskell's threads are light-weight, so a quick solution would be to fork on each cycle. Thus you'll end up using the main thread as a manager of worker threads, which ensures that a worker gets spawned every 100 micros.
import Control.Concurrent
main =
forever $ do
forkIO $ loopCycle
threadDelay $ 100 * 10^3
In case you care about exceptions not getting lost and getting reraised in the main thread instead, I recommend taking a look at the "slave-thread" package. Actually, I'd recommend to use that package instead of forkIO and brothers by default, but then I'm the author so I might be subjective.
Also note that the above solution might cause an accumulation of worker threads in case the loopCycle will take longer than 100 micros to execute too often. To protect against such a scenario, you can implement a strategy in the manager thread, which will ensure that the number of active workers is limited. Following is how such a strategy could be implemented:
-- From the "SafeSemaphore" package
import qualified Control.Concurrent.SSem as Sem
main =
manager 12 (100 * 10^3) $ putStrLn "Implement me!"
manager :: Int -> Int -> IO () -> IO ()
manager limit delay worker =
do
sem <- Sem.new limit
forever $ do
forkIO $ Sem.withSem sem $ worker
threadDelay delay
You could use sleep to pause the loop at the end of every iteration for 100 milliseconds. https://www.haskell.org/hoogle/?q=sleep
There is a function in the wiringPi 'C' library called delay with type
void delay(unsigned int howLong);
This function delays execution of code for howLong milliseconds. I wrote the binding code in haskell to be able to call this function. The haskell code is as follows,
foreign import ccall "wiringPi.h delay" c_delay :: CUInt -> IO ()
hdelay :: Int -> IO ()
hdelay howlong = c_delay (fromIntegral howlong)
After this, I wrote a simple haskell program to call this function. The simply haskell code is as follows..
--After importing relavent libraries I did
main = wiringPiSetup
>> delay 5000
But the delay does not happen or rather the executable generated by the ghc compiler exits right away.
Could someone tell me what could possibly go wrong here? A small nudge in the right direction would help.
Cheers and Regards.
Please ignore the part in block quote, and see update below - I am preserving the original non-solution because of comments associated with it.
You should mark the import as unsafe since you want the main
thread to block while the function is executing (see comment below by
#carl). By default, import is safe, not unsafe. So, changing
the function signature to this should make the main thread block:
foreign import ccall unsafe "wiring.h delay" c_delay :: CUInt -> IO ()
Also, if you plan to write multi-threaded code, GHC docs for multi-threaded FFI is >very useful. This also seems a good starter.
Update
The behavior seems to be due to signal interrupt handling (if I recall correctly, this was added in GHC 7.4+ to fix some bugs). More details here:
http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Signals
Please note the comment on the above page: Signal handling differs between the threaded version of the runtime and the non-threaded version.
Approach 1 - Handle signal interrupt in FFI code:
A toy code is below which handles the interrupt in sleep. I tested it on Linux 2.6.18 with ghc 7.6.1.
C code:
/** ctest.c **/
#include <unistd.h>
#include <stdio.h>
#include <time.h>
unsigned delay(unsigned sec)
{
struct timespec req={0};
req.tv_sec = sec;
req.tv_nsec = 0;
while (nanosleep(&req, &req) == -1) {
printf("Got interrupt, continuing\n");
continue;
}
return 1;
}
Haskell code:
{-# LANGUAGE ForeignFunctionInterface #-}
-- Filename Test.hs
module Main (main) where
import Foreign.C.Types
foreign import ccall safe "delay" delay :: CUInt -> IO CUInt
main = do
putStrLn "Sleeping"
n <- delay 2000
putStrLn $ "Got return code from sleep: " ++ show n
Now, after compiling with ghc 7.6.1 (command: ghc Test.hs ctest.c), it waits until sleep finishes, and prints a message every time it gets an interrupt signal during sleep:
./Test
Sleeping
Got interrupt, continuing
Got interrupt, continuing
Got interrupt, continuing
Got interrupt, continuing
....
....
Got return code from sleep: 1
Approach 2 - Disable SIGVTALRM before calling FFI code, and re-enable:
I am not sure what the implications are for disabling SIGVTALRM. This is alternative approach which disables SIGVTALRM during FFI call, if you can't alter FFI code. So, FFI code is not interrupted during sleep (assuming it is SIGVTALRM that is causing the interrupt).
{-# LANGUAGE ForeignFunctionInterface #-}
-- Test.hs
module Main (main) where
import Foreign.C.Types
import System.Posix.Signals
foreign import ccall safe "delay" delay :: CUInt -> IO CUInt
main = do
putStrLn "Sleeping"
-- Block SIGVTALRM temporarily to avoid interrupts while sleeping
blockSignals $ addSignal sigVTALRM emptySignalSet
n <- delay 2
putStrLn $ "Got return code from sleep: " ++ show n
-- Unblock SIGVTALRM
unblockSignals $ addSignal sigVTALRM emptySignalSet
return ()