# 第二七章：Socket 和 Syslog ## 基本網絡 本書的前幾張，我們討論了在網絡上進行操作的服務。其中兩個例子是數據庫客戶端/服務器和 web 服務。當需要設計新的協議，或者使用沒有現成 Haskell 庫的協議通信時，將需要使用 Haskell 庫函數提供的底層網絡工具。 本章中，我們將討論這些底層工具。網絡通訊是個大題目，可以用一整本書來討論。本章中，我們將展示如何使用 Haskell 應用你已經掌握的底層網絡知識。 Haskell 的網絡函數幾乎始終與常見的 C 函數調用相符。像其他在 C 上層的語言一樣，你將發現其接口很眼熟。 ## 使用 UDP 通信 UDP 將數據拆散為數據包。其不保證數據到達目的地，也不確保同一個數據包到達的次數。其用校驗和的方式確保到達的數據包沒有損壞。 UDP 適合用在對性能和延遲敏感的應用中，此類場景中系統的整體性能比單個數據包更重要。也可以用在 TCP 表現性能不高的場景，比如發送互不相關的短消息。適合使用 UDP 的系統的例子包括音頻和視頻會議、時間同步、網絡文件系統、以及日志系統。 ## UDP 客戶端例子：syslog 傳統 Unix syslog 服務允許程序通過網絡向某個負責記錄的中央服務器發送日志信息。某些程序對性能非常敏感，而且可能會生成大量日志消息。這樣的程序，將日志的開銷最小化比確保每條日志被記錄更重要。此外，在日志服務器無法訪問時，使程序依舊可以操作或許是一種可取的設計。因此，UDP 是一種 syslog 支持的日志傳輸協議。這種協議比較簡單，這里有一個 Haskell 實現的客戶端： ~~~ -- file: ch27/syslogclient.hs import Data.Bits import Network.Socket import Network.BSD import Data.List import SyslogTypes data SyslogHandle = SyslogHandle {slSocket :: Socket, slProgram :: String, slAddress :: SockAddr} openlog :: HostName -- ^ Remote hostname, or localhost -> String -- ^ Port number or name; 514 is default -> String -- ^ Name to log under -> IO SyslogHandle -- ^ Handle to use for logging openlog hostname port progname = do -- Look up the hostname and port. Either raises an exception -- or returns a nonempty list. First element in that list -- is supposed to be the best option. addrinfos <- getAddrInfo Nothing (Just hostname) (Just port) let serveraddr = head addrinfos -- Establish a socket for communication sock <- socket (addrFamily serveraddr) Datagram defaultProtocol -- Save off the socket, program name, and server address in a handle return $ SyslogHandle sock progname (addrAddress serveraddr) syslog :: SyslogHandle -> Facility -> Priority -> String -> IO () syslog syslogh fac pri msg = sendstr sendmsg where code = makeCode fac pri sendmsg = "<" ++ show code ++ ">" ++ (slProgram syslogh) ++ ": " ++ msg -- Send until everything is done sendstr :: String -> IO () sendstr [] = return () sendstr omsg = do sent <- sendTo (slSocket syslogh) omsg (slAddress syslogh) sendstr (genericDrop sent omsg) closelog :: SyslogHandle -> IO () closelog syslogh = sClose (slSocket syslogh) {- | Convert a facility and a priority into a syslog code -} makeCode :: Facility -> Priority -> Int makeCode fac pri = let faccode = codeOfFac fac pricode = fromEnum pri in (faccode `shiftL` 3) .|. pricode ~~~ 這段程序需要 SyslogTypes.hs ，代碼如下： ~~~ -- file: ch27/SyslogTypes.hs module SyslogTypes where {- | Priorities define how important a log message is. -} data Priority = DEBUG -- ^ Debug messages | INFO -- ^ Information | NOTICE -- ^ Normal runtime conditions | WARNING -- ^ General Warnings | ERROR -- ^ General Errors | CRITICAL -- ^ Severe situations | ALERT -- ^ Take immediate action | EMERGENCY -- ^ System is unusable deriving (Eq, Ord, Show, Read, Enum) {- | Facilities are used by the system to determine where messages are sent. -} data Facility = KERN -- ^ Kernel messages | USER -- ^ General userland messages | MAIL -- ^ E-Mail system | DAEMON -- ^ Daemon (server process) messages | AUTH -- ^ Authentication or security messages | SYSLOG -- ^ Internal syslog messages | LPR -- ^ Printer messages | NEWS -- ^ Usenet news | UUCP -- ^ UUCP messages | CRON -- ^ Cron messages | AUTHPRIV -- ^ Private authentication messages | FTP -- ^ FTP messages | LOCAL0 | LOCAL1 | LOCAL2 | LOCAL3 | LOCAL4 | LOCAL5 | LOCAL6 | LOCAL7 deriving (Eq, Show, Read) facToCode = [ (KERN, 0), (USER, 1), (MAIL, 2), (DAEMON, 3), (AUTH, 4), (SYSLOG, 5), (LPR, 6), (NEWS, 7), (UUCP, 8), (CRON, 9), (AUTHPRIV, 10), (FTP, 11), (LOCAL0, 16), (LOCAL1, 17), (LOCAL2, 18), (LOCAL3, 19), (LOCAL4, 20), (LOCAL5, 21), (LOCAL6, 22), (LOCAL7, 23) ] codeToFac = map (\(x, y) -> (y, x)) facToCode {- | We can't use enum here because the numbering is discontiguous -} codeOfFac :: Facility -> Int codeOfFac f = case lookup f facToCode of Just x -> x _ -> error $ "Internal error in codeOfFac" facOfCode :: Int -> Facility facOfCode f = case lookup f codeToFac of Just x -> x _ -> error $ "Invalid code in facOfCode" ~~~ 可以用 ghci 向本地的 syslog 服務器發送消息。服務器可以使用本章實現的例子，也可以使用其它的在 Linux 或者 POSIX 系統中的 syslog 服務器。注意，這些服務器默認禁用了 UDP 端口，你需要啟用 UDP 以使 syslog 接收 UDP 消息。 可以使用下面這樣的命令向本地 syslog 服務器發送一條消息： ~~~ ghci> :load syslogclient.hs [1 of 2] Compiling SyslogTypes ( SyslogTypes.hs, interpreted ) [2 of 2] Compiling Main ( syslogclient.hs, interpreted ) Ok, modules loaded: SyslogTypes, Main. ghci> h <- openlog "localhost" "514" "testprog" Loading package parsec-2.1.0.0 ... linking ... done. Loading package network-2.1.0.0 ... linking ... done. ghci> syslog h USER INFO "This is my message" ghci> closelog h ~~~ ## UDP Syslog 服務器 UDP 服務器會在服務器上綁定某個端口。其接收直接發到這個端口的包，并處理它們。UDP 是無狀態的，面向包的協議，程序員通常使用 recvFrom 這個調用接收消息和發送機信息，在發送響應時會用到發送機信息。 ~~~ -- file: ch27/syslogserver.hs import Data.Bits import Network.Socket import Network.BSD import Data.List type HandlerFunc = SockAddr -> String -> IO () serveLog :: String -- ^ Port number or name; 514 is default -> HandlerFunc -- ^ Function to handle incoming messages -> IO () serveLog port handlerfunc = withSocketsDo $ do -- Look up the port. Either raises an exception or returns -- a nonempty list. addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) Nothing (Just port) let serveraddr = head addrinfos -- Create a socket sock <- socket (addrFamily serveraddr) Datagram defaultProtocol -- Bind it to the address we're listening to bindSocket sock (addrAddress serveraddr) -- Loop forever processing incoming data. Ctrl-C to abort. procMessages sock where procMessages sock = do -- Receive one UDP packet, maximum length 1024 bytes, -- and save its content into msg and its source -- IP and port into addr (msg, _, addr) <- recvFrom sock 1024 -- Handle it handlerfunc addr msg -- And process more messages procMessages sock -- A simple handler that prints incoming packets plainHandler :: HandlerFunc plainHandler addr msg = putStrLn $ "From " ++ show addr ++ ": " ++ msg ~~~ 這段程序可以在 ghci 中執行。執行 serveLog"1514"plainHandler 將建立一個監聽 1514 端口的 UDP 服務器。其使用 plainHandler 將每條收到的 UDP 包打印出來。按下 Ctrl-C 可以終止這個程序。 Note 處理錯誤。執行時收到了 bind:permissiondenied 消息？要確保端口值比 1024 大。某些操作系統不允許 root 之外的用戶使用小于 1024 的端口。 ## 使用 TCP 通信 TCP 被設計為確保互聯網上的數據盡可能可靠地傳輸。 TCP 是數據流傳輸。雖然流在傳輸時會被操作系統拆散為一個個單獨的包，但是應用程序并不需要關心包的邊界。TCP 負責確保如果流被傳送到應用程序，它就是完整的、無改動、僅傳輸一次且保證順序。顯然，如果線纜被破壞會導致流量無法送達，任何協議都無法克服這類限制。 與 UDP 相比，這帶來一些折衷。首先，在 TCP 會話開始必須傳遞一些包以建立連接。其次，對于每個短會話，UDP 將有性能優勢。另外，TCP 會努力確保數據到達。如果會話的一端嘗試向遠端發送數據，但是沒有收到響應，它將周期性的嘗試重新傳輸數據直至放棄。這使得 TCP 面對丟包時比較健壯可靠。可是，它同樣意味著 TCP 不是實時傳輸協議（如實況音頻或視頻傳輸）的最佳選擇。 ## 處理多個 TCP 流 TCP 的連接是有狀態的。這意味著每個客戶機和服務器之間都有一條專用的邏輯“頻道”，而不是像 UDP 一樣只是處理一次性的數據包。這簡化了客戶端開發者的工作。服務器端程序幾乎總是需要同時處理多條 TCP 連接。如何做到這一點呢？ 在服務器端，首先需要創建一個 socket 并綁定到某個端口，就像 UDP 一樣。但這回不是重復監聽從任意地址發來的數據，取而代之，你的主循環將圍繞 accept 調用編寫。每當有一個客戶機連接，服務器操作系統為其分配一個新的 socket 。所以我們的主 socket 只用來監聽進來的連接，但從不發送數據。我們也獲得了多個子 socket 可以同時使用，每個子 socket 從屬于一個邏輯上的 TCP 會話。 在 Haskell 中，通常使用 forkIO 創建一個單獨的輕量級線程以處理與子 socket 的通信。對此， Haskell 擁有一個高效的內部實現，執行得非常好。 ## TCP Syslog 服務器 讓我們使用 TCP 的實現來替換 UDP 的 syslog 服務器。假設一條消息并不是定義為單獨的包，而是以一個尾部的字符 ‘n' 結束。任意客戶端可以使用 TCP 連接向服務器發送 0 或多條消息。我們可以像下面這樣實現： ~~~ -- file: ch27/syslogtcpserver.hs import Data.Bits import Network.Socket import Network.BSD import Data.List import Control.Concurrent import Control.Concurrent.MVar import System.IO type HandlerFunc = SockAddr -> String -> IO () serveLog :: String -- ^ Port number or name; 514 is default -> HandlerFunc -- ^ Function to handle incoming messages -> IO () serveLog port handlerfunc = withSocketsDo $ do -- Look up the port. Either raises an exception or returns -- a nonempty list. addrinfos <- getAddrInfo (Just (defaultHints {addrFlags = [AI_PASSIVE]})) Nothing (Just port) let serveraddr = head addrinfos -- Create a socket sock <- socket (addrFamily serveraddr) Stream defaultProtocol -- Bind it to the address we're listening to bindSocket sock (addrAddress serveraddr) -- Start listening for connection requests. Maximum queue size -- of 5 connection requests waiting to be accepted. listen sock 5 -- Create a lock to use for synchronizing access to the handler lock <- newMVar () -- Loop forever waiting for connections. Ctrl-C to abort. procRequests lock sock where -- | Process incoming connection requests procRequests :: MVar () -> Socket -> IO () procRequests lock mastersock = do (connsock, clientaddr) <- accept mastersock handle lock clientaddr "syslogtcpserver.hs: client connnected" forkIO $ procMessages lock connsock clientaddr procRequests lock mastersock -- | Process incoming messages procMessages :: MVar () -> Socket -> SockAddr -> IO () procMessages lock connsock clientaddr = do connhdl <- socketToHandle connsock ReadMode hSetBuffering connhdl LineBuffering messages <- hGetContents connhdl mapM_ (handle lock clientaddr) (lines messages) hClose connhdl handle lock clientaddr "syslogtcpserver.hs: client disconnected" -- Lock the handler before passing data to it. handle :: MVar () -> HandlerFunc -- This type is the same as -- handle :: MVar () -> SockAddr -> String -> IO () handle lock clientaddr msg = withMVar lock (\a -> handlerfunc clientaddr msg >> return a) -- A simple handler that prints incoming packets plainHandler :: HandlerFunc plainHandler addr msg = putStrLn $ "From " ++ show addr ++ ": " ++ msg ~~~ SyslogTypes 的實現，見 [*UDP 客戶端例子：syslog*](#) 。 讓我們讀一下源碼。主循環是 procRequests ，這是一個死循環，用于等待來自客戶端的新連接。 accept 調用將一直阻塞，直到一個客戶端來連接。當有客戶端連接，我們獲得一個新 socket 和客戶機地址。我們向處理函數發送一條關于新連接的消息，接著使用 forkIO 建立一個線程處理來自客戶機的數據。這條線程執行 procMessages 。 處理 TCP 數據時，為了方便，通常將 socket 轉換為 Haskell 句柄。我們也同樣處理，并明確設置了緩沖 – 一個 TCP 通信的要點。接著，設置惰性讀取 socket 句柄。對每個傳入的行，我們都將其傳給 handle 。當沒有更多數據時 – 遠端已經關閉了 socket – 我們輸出一條會話結束的消息。 因為可能同時收到多條消息，我們需要確保沒有將多條消息同時寫入一個處理函數。那將導致混亂的輸出。我們使用了一個簡單的鎖以序列化對處理函數的訪問，并且編寫了一個簡單的 handle 函數處理它。 你可以使用下面我們將展示的客戶機代碼測試，或者直接使用 telnet 程序來連接這個服務器。你向其發送的每一行輸入都將被服務器原樣返回。我們來試一下： ~~~ ghci> :load syslogtcpserver.hs [1 of 1] Compiling Main ( syslogtcpserver.hs, interpreted ) Ok, modules loaded: Main. ghci> serveLog "10514" plainHandler Loading package parsec-2.1.0.0 ... linking ... done. Loading package network-2.1.0.0 ... linking ... done. ~~~ 此處，服務器從 10514 端口監聽新連接。在有某個客戶機過來連接之前，它什么事兒都不做。我們可以使用 telnet 來連接這個服務器： ~~~ ~$ telnet localhost 10514 Trying 127.0.0.1... Connected to localhost. Escape character is '^]'. Test message ^] telnet> quit Connection closed. ~~~ 于此同時，在我們運行 TCP 服務器的終端上，你將看到如下輸出： ~~~ From 127.0.0.1:38790: syslogtcpserver.hs: client connnected From 127.0.0.1:38790: Test message From 127.0.0.1:38790: syslogtcpserver.hs: client disconnected ~~~ 其顯示一個客戶端從本機 (127.0.0.1) 的 38790 端口連上了主機。連接之后，它發送了一條消息，然后斷開。當你扮演一個 TCP 客戶端時，操作系統將分配一個未被使用的端口給你。通常這個端口在你每次運行程序時都不一樣。 ## TCP Syslog 客戶端 現在，為我們的 TCP syslog 協議編寫一個客戶端。這個客戶端與 UDP 客戶端類似，但是有一些變化。首先，因為 TCP 是流式協議，我們可以使用句柄傳輸數據而不需要使用底層的 socket 操作。其次，不在需要在 SyslogHandle 中保存目的地址，因為我們將使用 connect 建立 TCP 連接。最后，我們需要一個途徑，以區分不同的消息。UDP 中，這很容易，因為每條消息都是不相關的邏輯包。TCP 中，我們將僅使用換行符 ‘n' 來作為消息結尾的標識，盡管這意味著不能在單條消息中發送多行信息。這是代碼： ~~~ -- file: ch27/syslogtcpclient.hs import Data.Bits import Network.Socket import Network.BSD import Data.List import SyslogTypes import System.IO data SyslogHandle = SyslogHandle {slHandle :: Handle, slProgram :: String} openlog :: HostName -- ^ Remote hostname, or localhost -> String -- ^ Port number or name; 514 is default -> String -- ^ Name to log under -> IO SyslogHandle -- ^ Handle to use for logging openlog hostname port progname = do -- Look up the hostname and port. Either raises an exception -- or returns a nonempty list. First element in that list -- is supposed to be the best option. addrinfos <- getAddrInfo Nothing (Just hostname) (Just port) let serveraddr = head addrinfos -- Establish a socket for communication sock <- socket (addrFamily serveraddr) Stream defaultProtocol -- Mark the socket for keep-alive handling since it may be idle -- for long periods of time setSocketOption sock KeepAlive 1 -- Connect to server connect sock (addrAddress serveraddr) -- Make a Handle out of it for convenience h <- socketToHandle sock WriteMode -- We're going to set buffering to BlockBuffering and then -- explicitly call hFlush after each message, below, so that -- messages get logged immediately hSetBuffering h (BlockBuffering Nothing) -- Save off the socket, program name, and server address in a handle return $ SyslogHandle h progname syslog :: SyslogHandle -> Facility -> Priority -> String -> IO () syslog syslogh fac pri msg = do hPutStrLn (slHandle syslogh) sendmsg -- Make sure that we send data immediately hFlush (slHandle syslogh) where code = makeCode fac pri sendmsg = "<" ++ show code ++ ">" ++ (slProgram syslogh) ++ ": " ++ msg closelog :: SyslogHandle -> IO () closelog syslogh = hClose (slHandle syslogh) {- | Convert a facility and a priority into a syslog code -} makeCode :: Facility -> Priority -> Int makeCode fac pri = let faccode = codeOfFac fac pricode = fromEnum pri in (faccode `shiftL` 3) .|. pricode ~~~ 可以在 ghci 中試著運行它。如果還沒有關閉之前的 TCP 服務器，你的會話看上去可能會像是這樣： ~~~ ghci> :load syslogtcpclient.hs Loading package base ... linking ... done. [1 of 2] Compiling SyslogTypes ( SyslogTypes.hs, interpreted ) [2 of 2] Compiling Main ( syslogtcpclient.hs, interpreted ) Ok, modules loaded: Main, SyslogTypes. ghci> openlog "localhost" "10514" "tcptest" Loading package parsec-2.1.0.0 ... linking ... done. Loading package network-2.1.0.0 ... linking ... done. ghci> sl <- openlog "localhost" "10514" "tcptest" ghci> syslog sl USER INFO "This is my TCP message" ghci> syslog sl USER INFO "This is my TCP message again" ghci> closelog sl ~~~ 結束時，服務器上將看到這樣的輸出： ~~~ From 127.0.0.1:46319: syslogtcpserver.hs: client connnected From 127.0.0.1:46319: <9>tcptest: This is my TCP message From 127.0.0.1:46319: <9>tcptest: This is my TCP message again From 127.0.0.1:46319: syslogtcpserver.hs: client disconnected ~~~ <9> 是優先級和設施代碼，和之前 UDP 例子中的意思一樣。