Ticket #2835: sockLeak.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import System.Environment
import System.Process
import Control.Monad
import Control.Concurrent
import System.IO
import Control.Applicative
import Control.Exception (handle, throwIO, Exception(..), SomeException)
import Network(listenOn, PortID(..))
import Network.Socket
import System.IO
import System.Directory
import System.FilePath

sGetLine' :: Socket -> IO String
sGetLine' s = reverse <$> go []
    where go xs = do
            (x,n) <- recvLen s 1
            if x == "\n" || n <= 0
               then return xs
               else go $ x++xs

listenSock sk = forkIO . forever $ handle (\ (e::SomeException) -> print e) $ do
           (resp,_) <- accept sk
           forkIO $ handle (\(e::SomeException) -> sClose resp) $ forever $ sGetLine' resp >>= \line -> case line of
              ('q':_) -> throwIO $ userError "exit"
              ('l':_) -> launchNew
              x -> putStrLn x
           return ()

launchNew = do
  pn <- getProgName
  dir <- getCurrentDirectory
  forkIO $ runProcess (dir </> pn) ["arg"] Nothing Nothing Nothing Nothing Nothing >> forever (threadDelay 100000)
  return ()

main = do
  hSetBuffering stdout NoBuffering
  putStrLn "hi"
  args <- getArgs
  case args of
    [] -> do sk <- listenOn $ PortNumber 9020
             listenSock sk
             return ()
    _  -> putStrLn "subprogram launched"
  forever $ threadDelay 1000000