메신저 서버와 클라이언트

 우리 팀에 irtiger 님과 메신저 중 "erlang 으로는 간단한 콘솔 기반 메신저 서버/클라이언트 100줄이면 만들지롱~" 이란 말에 발끈! 해서 만든 초간단 메신저...90줄이다. 86줄이다...

 간단한 로그인/아웃, 접속자 리스트 보기, 대화하기, 에러처리 기능들이 구현되어 있다.

1. import System.IO.Unsafe
   import Control.Concurrent
   import Control.Concurrent.MVar
   import Control.Exception hiding (catch)
   import Network
   import List
   import IO
   import Monad
2.   
3. friends :: MVar [(String, Handle)]
   friends = unsafePerformIO $ newMVar []
4.   
5. talking :: MVar [(Handle,Handle)]
   talking = unsafePerformIO $ newMVar []
6.   
7. server port = withSocketsDo $ listenOn (PortNumber port) >>= serverLoop
   serverLoop sock = do
       (h,name,_) <- accept sock
       putStrLn $ name ++ " is connected"
       forkIO $ logIn h
       serverLoop sock
      
   sendMessage h msg = hPutStrLn h msg >> hFlush h
8. 
   logIn h = do
       user <- hGetLine h
       userList <- takeMVar friends
       if (user `elem` (map fst userList))
           then sendMessage h "sorry, user name already exist!"
               >> putMVar friends userList >> logIn h
           else putMVar friends ((user,h):userList)
               >> sendMessage h ("Hello " ++ user)
               >> catch (cmdLoop h `finally` quit (user,h))
                        (\_-> putStrLn $ user ++ " is out")
       where quit v = modifyMVar_ friends $ return . delete v
9.   
10. cmdLoop h = do
        msg@(m:ms) <- hGetLine h
        if (m == ':') then parsingCmd h $ ms
            else do
                list <- readMVar talking
                case find (\(h1,h2)->h==h1 || h==h2) list of
                    Just (h1,h2) -> sendMessage to msg
                        where to = if (h == h1) then h2 else h1
                    Nothing -> sendMessage h "Invalid command format(start with ':')"
        cmdLoop h
11.          
12. parsingCmd h1 ('s':name) = do
        list <- readMVar friends
        case find (\(n,h)->n==name && h /= h1) list of
            Just (_,h2) -> do
                putStrLn $ "start to talk with " ++ name
                modifyMVar_ talking (return . ((h1,h2):))
            Nothing -> sendMessage h1 "invalid user"
           
    parsingCmd h "e" = do
        putStrLn "end to talk"
        list <- takeMVar talking
        case find (\(h1,h2)->h==h1 || h==h2) list of
            Just v -> putMVar talking $ delete v list
            Nothing -> putMVar talking list >> putStrLn "no effect"
13.        
14. parsingCmd h "l" = putStrLn "show friend's list"
        >> sendMessage h ("*** friend's list ***\n" ++ friends' ++ "*********************")
        where friends' = unlines $ map fst $ unsafePerformIO $ readMVar friends
        
    
15. parsingCmd h "d" = putStrLn "disconnect"
    parsingCmd h _ = sendMessage h "Invalid command"
16.       
17. client host port = withSocketsDo $ connectTo host (PortNumber port)
        >>= (\h -> catch (clientLogin h `finally` hClose h) print)
       
    clientLogin h = do
        putStr "Login:" >> getLine >>= sendMessage h
        rep <- hGetLine h
        putStrLn $ ">" ++ rep
        if ("Hello" /= take 5 rep) then clientLogin h
            else forkIO (catch (recvMsgLoop h) (\_->return()))
                >> clientCmdLoop h
        putStrLn "disconnected"
18.       
19. clientCmdLoop h = getLine >>= (\msg -> do
        when (length msg > 0) (sendMessage h msg)
        when (msg /= ":d") (clientCmdLoop h))
20.       
21. recvMsgLoop h = hGetLine h >>= putStrLn . (">"++) >> recvMsgLoop h
    
22.