[Real World Haskell翻译]第27章 网络通信和系统日志 Sockets and Syslog

第27章 网络通信和系统日志 Sockets and Syslog

基础网络

在本书的前面几章，我们讨论了运转在网络上的服务。其中的两个例子是客户端/服务器架构的数据库和Web服务。当需要制定一个新的协议或者是和一个没有现成库的协议通信时，你就需要使用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服务器。您可以使用本章中展示的syslog服务器或者你可以找到的Linux或其他POSIX系统现存的典型的syslog服务器。需要注意的是这些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.1 ... linking ... done.
Loading package network-2.2.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服务器，它会使用plainHandlerto打印出每个在该端口上传入的UDP包。按Ctrl-C将终止程序。

%可能出现的一些问题
%绑定错误：测试这个的时候出现permission denied，请确保您使用的端口号大于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'所定义。任何给定的客户可以通过给定的连接发送零个或多个消息给服务器。我们可能像下面这样写：

-- 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的实现，请参阅第612页上的“UDP客户端的例子：syslog”。
让我们来看看这段代码。我们的主循环在procRequests中，在这里我们永远循环等待新的客户端连接。accept调用被阻塞直到客户端连接。当一个客户端连接，我们可以得到一个新的socket和客户端的地址。我们传递消息给handler，然后使用forkIO创建一个线程来处理来自客户端的数据。这个线程运行procMessages。
当处理TCP数据时，通常可以很方便地将socket转换成一个Haskell处理。这里我们就是这样做的，并且明确地设置了缓冲buffering，对于TCP通信这是很重要的一点。接下来，我们设置了lazy read从套接字的Handle。对于每一个进入的连接，我们把它传递给handle。直到远端关闭套接字而没有更多的数据，我们便输出相关消息。
因为我们可能会一次处理多个传入的消息，我们需要确保没有在handler中一次写出多个消息。这可能会导致输出乱码。我们用一个简单的锁使得对handler的访问有顺序，并写了一个简单的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是流协议，我们可以使用Handler发送数据，而不是使用低级的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类似。