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

13
Telegram.hs
View File

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