haskell 로 간단한 소켓 서버와 클라이언트 제작 두번째

이전글 에서는 코드가 전체적으로 Socket 기반으로 돌아가는데 뭐랄까.. 이게 그다지 좋은 방법이 아닌가보다. haskell 의 경우 입출력이 Handle 을 통해서 이루어지게 디자인 되어있어서 Socket 을 바로 입출력에 쓰기엔 제공되는 api 들이 좀 난감한 면이 있다.

그래서 이전 코드에서 세션핸들러 함수들이 Socket 을 받던것을 Handle 을 받도록 수정해봤다. 그리고 핸들(소켓) 을 닫는 책임을 세션핸들러 쪽으로 옮겨버렸다... 세션함수 작성시 클로즈를 잊지말고 해야 하는 부담이 있긴 하지만 이게 좀더 유연할거 같다.


이건 서버쪽 소스

      펼쳐두기..
  
-- haskell 에서 입출력을 하려면 소켓보다는 핸들이 좀더 나은것 같아서
-- 소켓 기반이었던 것을 핸들 기반으로 바꿨다. 소켓인 경우 소켓만으로
-- peer 를 알수 있지만 핸들은 좀더 추상화 된 놈이라.. 핸들을 다루는
-- 놈한테 peer 정보까지 인자로 넘기도록 했다.
import Prelude hiding (log)
import Network.Socket
import Control.Monad(liftM,forever)
import Control.Exception(finally)    
import Control.Concurrent(forkIO)
import System.IO    

serveTcp port f = do
  s <- socket AF_INET Stream defaultProtocol
  bindSocket s (SockAddrInet port iNADDR_ANY)
  listen s maxListenQueue
  forever $ do
    (child,from) <- accept s
    h <- socketToHandle child ReadWriteMode
    hSetBuffering h (BlockBuffering Nothing)
    forkIO $ f h from

-- 사용하지는 않지만 핸들 외에 SockAddr 도 받았다. 어쨌거나 peer 정보를
-- 알수 있다는거.
log :: Handle -> SockAddr -> IO ()
log h from = (forever $ hGetLine h >>= print) `finally` hClose h

main = withSocketsDo $ serveTcp 1818 log

이건 클라이언트쪽 소스

      펼쳐두기..
  
import Network.Socket
import Control.Monad(liftM,forever)
import Control.Exception(finally)
import Control.Concurrent(threadDelay)
import System.IO

withTcp :: (String,PortNumber) -> (Handle->IO a) -> IO a
withTcp (ip,port) f = do
  a <- liftM (SockAddrInet port) (inet_addr ip)
  s <- socket AF_INET Stream defaultProtocol
  connect s a
  h <- socketToHandle s ReadWriteMode -- 소켓을 직접 다루는건 좀 빡시네. 핸들로 바꿔서 움직이는게 좀더 나은 방법인갑다
  hSetBuffering h (BlockBuffering Nothing) -- 버퍼링 모드.. 일단 블럭모드로
  f h                                      -- 핸들(소켓) 을 닫는것을 f 의 책임으로 넘겼다.

withServer = withTcp ("127.0.0.1",1818)

shootPackets :: Handle -> IO ()
shootPackets h = forever (shoot >> sleep) `finally` finalize
    where shoot    = hPutStrLn h "Hello" >> hFlush h
          sleep    = threadDelay 1000000
          finalize = hClose h
                      
main = withSocketsDo $ withServer shootPackets