Ticket #2835: sockLeak.hs

File sockLeak.hs, 1.4 KB (added by sclv, 6 years ago)
Line 
1{-# LANGUAGE ScopedTypeVariables #-}
2module Main where
3import System.Environment
4import System.Process
5import Control.Monad
6import Control.Concurrent
7import System.IO
8import Control.Applicative
9import Control.Exception (handle, throwIO, Exception(..), SomeException)
10import Network(listenOn, PortID(..))
11import Network.Socket
12import System.IO
13import System.Directory
14import System.FilePath
15
16sGetLine' :: Socket -> IO String
17sGetLine' s = reverse <$> go []
18    where go xs = do
19            (x,n) <- recvLen s 1
20            if x == "\n" || n <= 0
21               then return xs
22               else go $ x++xs
23
24listenSock sk = forkIO . forever $ handle (\ (e::SomeException) -> print e) $ do
25           (resp,_) <- accept sk
26           forkIO $ handle (\(e::SomeException) -> sClose resp) $ forever $ sGetLine' resp >>= \line -> case line of
27              ('q':_) -> throwIO $ userError "exit"
28              ('l':_) -> launchNew
29              x -> putStrLn x
30           return ()
31
32launchNew = do
33  pn <- getProgName
34  dir <- getCurrentDirectory
35  forkIO $ runProcess (dir </> pn) ["arg"] Nothing Nothing Nothing Nothing Nothing >> forever (threadDelay 100000)
36  return ()
37
38main = do
39  hSetBuffering stdout NoBuffering
40  putStrLn "hi"
41  args <- getArgs
42  case args of
43    [] -> do sk <- listenOn $ PortNumber 9020
44             listenSock sk
45             return ()
46    _  -> putStrLn "subprogram launched"
47  forever $ threadDelay 1000000