在深入haskell的Network
库时,我正在基于this link中的信息创建一个非常简单的http服务器。
import Control.Concurrent
import Control.Monad
import Network
import System.IO
main = withSocketsDo $ listenOn (PortNumber 8080) >>= loop
loop :: Socket -> IO ()
loop sock = do
(h,_,_) <- accept sock
forkIO $ handleRequest h
loop sock
handleRequest :: Handle -> IO ()
handleRequest h = do
hPutStr h $ httpRequest "Pong!\n"
hFlush h
hClose h
httpRequest :: String -> String
httpRequest body = "HTTP/1.0 200 OK\r\n"
++ "Content-Length: " ++ (show.length) body ++ "\r\n"
++ "\r\n" ++ body ++ "\r\n"
然而,即使我设法得到一些响应,句柄似乎很快(有时?)正如curl告诉我的:
$ curl localhost:8080
Pong!
curl: (56) Recv failure: Connection reset by peer
注:有时我甚至没有收到消息(
Pong!
)或只是其中的一部分。有时,它会起作用…但如果我连续运行100curl
s,我最终会得到一些连接重置。为什么要重置连接?我试过和没有试过都没有成功。我错过了一些关于Haskell的IO流的基本信息了吗?谢谢!
操作系统:最近的ubuntu;ghc:7.8.4
---编辑:---
jozefg发现问题来自于耗尽请求的内容!但是,我希望将此内容发送回客户端,并且在使用以下代码时挂起:
handleRequest :: Handle -> IO ()
handleRequest h = do
contents <- getHandleContents h
hPutStr h $ httpRequest contents
hFlush h
hClose h
getHandleContents :: Handle -> IO String
getHandleContents h = do
iseof <- hIsEOF h
if iseof
then return []
else do
newLine <- hGetLine h
nextLines <- getHandleContents h
return $ newLine ++ '\n' : nextLines
此外,我没有成功地使用
forkIO
排出全部内容。知道为什么吗? 最佳答案
错误似乎是您没有完全读取客户机发出get请求时发送的数据,如answer for Rust中所述。这里提出的解决方案基本上是编写一个小循环,在响应之前从句柄中排出头。haskell版本是
drainHeaders :: Handle -> IO ()
drainHeaders h = do
line <- hGetLine h
if line == "\r" then return () else drainHeaders h
那么你的代码就可以写了
import Control.Concurrent
import Control.Exception (bracket)
import Control.Monad
import Network
import System.IO
main = withSocketsDo $
bracket (listenOn (PortNumber 8080)) sClose loop
loop :: Socket -> IO ()
loop sock = do
(handle, _host, _port) <- accept sock
-- Handle is automatically closed now even in the face of async exns
forkFinally (handleRequest handle) (const $ hClose handle)
loop sock
drainHeaders :: Handle -> IO ()
drainHeaders h = do
line <- hGetLine h -- Strips off a trailing \n
if line == "\r" then return () else drainHeaders h
handleRequest :: Handle -> IO ()
handleRequest h = do
drainHeaders h
hPutStr h $ httpRequest "Pong!\n"
hFlush h
httpRequest :: String -> String
httpRequest body =
mconcat [ "HTTP/1.0 200 OK\r\nContent-Length: "
, (show . length) body
, "\r\n\r\n"
, body
, "\r\n" ]
我还冒昧地调整了代码,使用
forkFinally
和bracket
处理异常情况下的关闭操作,使其更安全一些:我怀疑它是100%完美的,但现在有点干净了。