去年から,仕事の合間に時間を見つけてはちまちまと Haskell の勉強をしていました.
でも本を読むだけでは今一なので,ここら辺で一回まとまったものを書いてみようかと.初心者なのは承知の上でコードをさらそうかと.
あと Haskell 良いですね.まだうまく表現できませんがおもしろいです.
書いたコード
仕様は「HTTP リクエストの Request-Line を解釈*2し,要求されたファイルの内容を返す」だけです.セキュリティ関連も対応していません.大変に単純です.
{- thin HTTP server implementation -} module Main where import Prelude hiding (catch) import Network (listenOn, accept, sClose, Socket, withSocketsDo, PortID(..), PortNumber) import System.IO import System.Environment (getArgs) import Control.Exception (catch, finally, SomeException(..)) import Control.Concurrent (forkIO) import Control.Applicative ((*>)) import Control.Monad (forM_) import ThinHttpParser import Text.ParserCombinators.Parsec main :: IO () main = do (portStr:_) <- getArgs runServer $ fromIntegral (read portStr :: Int) runServer :: PortNumber -> IO () runServer port = withSocketsDo $ do lSock <- listenOn $ PortNumber port putStrLn $ "listening on: " ++ show port acceptLoop lSock `finally` (sClose lSock >> putStrLn "stopped.") acceptLoop :: Socket -> IO () acceptLoop lSock = do (cHandle, _, _) <- accept lSock forkIO $ clientHandler cHandle acceptLoop lSock clientHandler :: Handle -> IO () clientHandler handle = service handle `catch` (\(SomeException e) -> putStrLn $ show e) `finally` hClose handle service :: Handle -> IO () service handle = do rawReq <- hGetContents handle case parse parseRequest "parse http-request" rawReq of Right httpReq -> do let path = reqUrl httpReq -- putStrLn $ "request: " ++ (show $ reqMethod httpReq) ++ " " ++ path -- XXX debug (readFile ("./" ++ path) >>= responseOk handle (contentType $ fileExt path)) `catch` (\(SomeException _) -> responseError handle 404) hFlush handle Left err -> do putStrLn $ show err responseError handle 400 -- 成功 responseOk :: Handle -> String -> String -> IO () responseOk handle ctype content = forM_ [ "HTTP/1.1 200 OK\r\n" ++ "Content-Type: " ++ ctype ++ "\r\n" ++ "\r\n", content ] (hPutStr handle) -- XXX 失敗 responseError :: Handle -> Int -> IO () responseError handle scode = hPutStr handle $ "HTTP/1.1 " ++ show scode ++ " " ++ reasonPhrase scode ++ "\r\n\r\n" -- helper -- fileExt :: String -> String fileExt path = case parse parseExt "parse path" path of Right ext -> ext Left _ -> "" parseExt :: CharParser st String parseExt = manyTill anyChar (char '.') *> many anyChar -- XXX Map? contentType :: String -> String contentType "html" = "text/html" contentType _ = "text/plain" -- XXX Map? reasonPhrase :: Int -> String reasonPhrase 400 = "Bad Request" reasonPhrase 404 = "Not Found" reasonPhrase _ = error "unknown status code"
module ThinHttpParser ( HttpRequest(..), Method(..), parseRequest ) where import Control.Applicative import Control.Monad (MonadPlus(..), ap) import Text.ParserCombinators.Parsec hiding (many, optional, (<|>)) import Numeric (readHex) import Control.Monad (liftM4) import System.IO (Handle) instance Applicative (GenParser s a) where pure = return (<*>) = ap instance Alternative (GenParser s a) where empty = mzero (<|>) = mplus data Method = Get | Post deriving (Eq, Ord, Show) data HttpRequest = HttpRequest { reqMethod :: Method, reqUrl :: String, reqHeaders :: [(String, String)], reqBody :: Maybe String } deriving (Eq, Show) parseRequest :: CharParser () HttpRequest parseRequest = q "GET" Get (pure Nothing) <|> q "POST" Post (Just <$> many anyChar) where q name ctor body = liftM4 HttpRequest req url parseHeaders body where req = ctor <$ string name <* char ' ' url = optional (char '/') *> manyTill notEOL (try $ char ' ') <* (try $ string "HTTP/1." <* oneOf "01") <* crlf parseHeaders :: CharParser st [(String, String)] parseHeaders = pure [] -- XXX crlf :: CharParser st () crlf = () <$ string "\r\n" notEOL :: CharParser st Char notEOL = noneOf "\r\n"
gist はこちら → https://gist.github.com/1573839
ビルド&実行
***> ghc --make -Wall -fno-warn-unused-do-bind -o thin_http_server.exe Main.hs [2 of 2] Compiling Main ( Main.hs, Main.o ) Linking thin_http_server.exe ... ***>thin_http_server.exe 8888 listening on: 8888
疑問とかいろいろ
細かな疑問はもっといっぱいありますが...
- エラー処理のやり方あってるかなぁ...?
- 文字の扱いが雑すぎて反省
- スレッド間の通信はどうやるの?(STM?)
- I/O 多重化は?
- Parser Combinator はどのパッケージが流行なんだろう?
どんどんコード書いて探っていこうかな,と.
おわりに
最初から最後まで躓きっぱなしでした...orz
今回書いたコードが Haskell っぽいコードになっているかどうか,今はまだ正しく評価できません.
未来の自分がみたとき,何て思うのかなぁ...
参考
分からないことだらけだったので,様様なサイト・書籍を参考にさせていただきました.
- http://www.haskell.org/hoogle/
- http://sequence.complete.org/node/258
- http://book.realworldhaskell.org/read/using-parsec.html
- http://lab.klab.org/young/2009/10/haskell%E3%81%A7%E3%82%A8%E3%82%B3%E3%83%BC%E3%82%B5%E3%83%BC%E3%83%90%E3%83%BC/
- http://dev.ariel-networks.com/Members/mizyo/haskell306e30b930ec30c330b730b930c630e03068stml306b306430443066-305d306e1/
- http://d.hatena.ne.jp/kazu-yamamoto/20110826/1314352340
- http://www.kotha.net/ghcguide_ja/7.0.4/modes.html#make-mode