UNIX Domain Socket を使う (サーバ編)

HaskellUNIX Domain Socket を使ってみる。クライアントによってソケットに書き込まれた情報を、そのまま標準出力に出力するというアプリケーションを作ってみる。とりあえずサーバ。

import IO (try, hPutStrLn, stdout, hFlush, stderr)
import Control.Monad (when)
import System.Directory (doesFileExist, removeFile)
import System.Environment (getArgs)
import Network.Socket (Socket, socket, Family(AF_UNIX),
                       SocketType(Stream), bindSocket, accept, sClose,
                       recv, listen, SockAddr(SockAddrUnix))

-- アクションを指定の条件を満たす間繰り返す。アクションで IO エラーが発
-- 生した場合には、握りつぶして繰り返しを抜ける。
--
condLoop :: IO a -> (a -> Bool) -> IO ()
condLoop act tester =
    do v <- try act
       case v of
         (Left _) -> return ()
         (Right v) -> if tester v
                        then condLoop act tester
                        else return ()

-- アクションを永久に繰り返す。ただし IO エラーが発生した場合には終了す
-- る。
--
loop :: IO () -> IO ()
loop act = condLoop act (\_ -> True)


-- ファイルが存在する場合は削除する
--
clean :: FilePath -> IO ()
clean path = do exists <- doesFileExist path
                when exists (removeFile path)
                return ()

-- 指定パスの Unix Domain Socket を開く
--
open :: FilePath -> IO Socket
open path = do sock <- socket AF_UNIX Stream 0
               clean path
               ready sock
  where ready sock = do bindSocket sock (SockAddrUnix path)
                        listen sock 1
                        return sock

-- メインループ。ソケットを監視して、コネクションを処理する。コネクショ
-- ンから受信したメッセージは標準出力に書き出す。
--
run :: Socket -> IO ()
run sock = loop mainRoutine
  where
    mainRoutine = do (conn, _) <- accept sock
                     condLoop (procConn conn) (not . null)
                     sClose conn
    procConn conn = do msg <- recv conn 8192
                       when (not $ null msg)
			    (hPutStrLn stdout msg >> hFlush stdout)
                       return msg

main :: IO ()
main = do args <- getArgs
          case args of
            []       -> usage
            (path:_) -> start path
  where start path = do sock <- open path
                        run sock
                        tearDown path sock
        tearDown path sock = do clean path
                                sClose sock
        usage = hPutStrLn stderr "PROG <socket_file_path>"

Socket を使ったネットワークプログラムは IO バリバリになってしまう。この辺をキレイにするライブラリもありそうな気がする。

それからソケットファイルにリダイレクトできないことを知った。サーバだけ書いて echo でもすりゃいいやって思ってたのだけど、どうやらクライアントも書く必要があるぽい。