rnhmjoj/oglaf
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Fix process hanging

Browse Source
This commit is contained in:
rnhmjoj 2015-12-04 00:56:48 +01:00
parent dc2920aa8f
commit 78833a1603
1 changed files with 4 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
Telegram.hs
View File

@ -3,8 +3,6 @@ module Telegram where
import Network
import System.IO
import System.Process
import System.Process.Internals
import System.Posix.Signals (signalProcess, sigKILL)
import Data.List.Utils (replace)
import Control.Monad (when, replicateM_)
import Control.Retry
@ -18,7 +16,7 @@ args = ["-d", "-P", show port]
telegramProcess :: IO ProcessHandle
telegramProcess = do
(_,_,_, handle) <- createProcess (proc program args)
(_,_,_, handle) <- createProcess (proc program args) { create_group = True }
return handle
@ -30,10 +28,7 @@ telegramSocket = recoverAll timeout connect
closeTelegram :: Handle -> ProcessHandle -> IO ()
closeTelegram socket handle =
hClose socket >> getPid handle >>= signalProcess sigKILL
where
go (OpenHandle h) = h
getPid h = withProcessHandle h (return . go)
hClose socket >> replicateM_ 2 (interruptProcessGroupOf handle)
send :: Handle -> String -> IO ()