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 Network
import System.IO import System.IO
import System.Process import System.Process
import System.Process.Internals
import System.Posix.Signals (signalProcess, sigKILL)
import Data.List.Utils (replace) import Data.List.Utils (replace)
import Control.Monad (when, replicateM_) import Control.Monad (when, replicateM_)
import Control.Retry import Control.Retry
@ -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 ()