简单的TCP客户端

时间:2014-08-10 07:53:17

标签: haskell haskell-platform

我试图在Haskell中实现简单的TCP客户端。但它一旦连接就会关闭。我不知道是什么导致它关闭。我怎样才能将它从服务器打印到stdout并从stdin直接发送到服务器,直到stdin收到行&#34;:退出&#34;?< / p>

import Control.Monad (forever)
import Network (withSocketsDo, PortID(..), connectTo)
import System.IO
import Control.Concurrent (forkFinally)
import Control.Concurrent.Async (race)

main :: IO ()
main = withSocketsDo $ do
  -- connect to my local tcp server
  handle <- connectTo "192.168.137.1" (PortNumber 44444)
  -- should close the connection using handle after everything is done
  _ <- forkFinally (talk handle) (\_ -> hClose handle)
  return ()

talk :: Handle -> IO ()
talk handle = do
    hSetNewlineMode handle universalNewlineMode
    hSetBuffering handle LineBuffering
    -- if either one of them terminates, other one will get terminated
    _ <- race (interactWithServer handle) (interactWithUser handle)
    return ()

interactWithServer :: Handle -> IO ()
interactWithServer handle = forever $ do
  line <- hGetLine handle
  print line          -- print a line that came from server into stdout

interactWithUser :: Handle -> IO ()
interactWithUser handle = do
  line <- getLine
  case line of
    ":quit" -> return ()            -- stop loop if user input is :quit
    _ -> do hPutStrLn handle line
            interactWithUser handle -- send, then continue looping

1 个答案:

答案 0 :(得分:4)

Ørjan Johansen的帮助下,我明白了。 forkFinally正在创建一个线程,然后主线程被关闭。该行意味着要等到talk完成,然后关闭连接。它必须(也缩短它)

main :: IO ()
main = withSocketsDo $ do
  handle <- connectTo "192.168.137.1" (PortNumber 44444)
  talk handle `finally` hClose handle

talk :: Handle -> IO ()
talk handle = do
    hSetNewlineMode handle universalNewlineMode
    hSetBuffering handle LineBuffering
    _ <- race fromServer toServer
    return ()
  where
    fromServer = forever $ do
      line <- hGetLine handle
      print line
    toServer = do
      line <- getLine
      case line of
-- server accepts /quit as disconnect command so better send it to the server 
        ":quit" -> do hPutStrLn handle "/quit"; return "Quit"
        _ ->  do hPutStrLn handle line; toServer

我希望这段代码是安全的:D