diff --git a/Config.hs b/Config.hs
new file mode 100644
--- /dev/null
+++ b/Config.hs
@@ -0,0 +1,124 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Config (Option(..), parseOption, defaultOption) where
+
+import Text.ParserCombinators.Parsec
+import Data.List (isPrefixOf)
+
+----------------------------------------------------------------
+
+defaultOption :: Option
+defaultOption = Option {
+    opt_port = 8080
+  , opt_prefork_process_number = 20
+  , opt_thread_number_per_process = 500
+  , opt_connection_timer = 10
+  , opt_sleep_timer = 2
+  , opt_debug_mode = True
+  , opt_user = "nobody"
+  , opt_group = "nobody"
+  , opt_syslog_facility = "local5"
+  , opt_log_level = "info"
+  , opt_pid_file = "/var/run/pbws.pid"
+}
+
+data Option = Option {
+    opt_port :: Int
+  , opt_prefork_process_number :: Int
+  , opt_thread_number_per_process :: Int
+  , opt_connection_timer :: Int
+  , opt_sleep_timer :: Int
+  , opt_debug_mode :: Bool
+  , opt_user :: String
+  , opt_group :: String
+  , opt_syslog_facility :: String
+  , opt_log_level :: String
+  , opt_pid_file :: String
+} deriving Show
+
+----------------------------------------------------------------
+
+parseOption :: String -> Option
+parseOption = makeOpt defaultOption . parseConfig
+
+----------------------------------------------------------------
+
+makeOpt :: Option -> [Conf] -> Option
+makeOpt def conf = Option {
+    opt_port = get "Port" opt_port
+  , opt_prefork_process_number = get "Prefork_Process_Number" opt_prefork_process_number
+  , opt_thread_number_per_process = get "Thread_Number_Per_Process" opt_thread_number_per_process
+  , opt_connection_timer = get "Connection_Timer" opt_connection_timer
+  , opt_sleep_timer      = get "Sleep_Timer" opt_sleep_timer
+  , opt_debug_mode       = get "Debug_Mode" opt_debug_mode
+  , opt_user             = get "User" opt_user
+  , opt_group            = get "Group" opt_group
+  , opt_syslog_facility  = get "Syslog_Facility" opt_syslog_facility
+  , opt_log_level        = get "Log_Level" opt_log_level
+  , opt_pid_file         = get "Pid_File" opt_pid_file
+  }
+    where
+      get key func = case lookup key conf of
+                       Nothing -> func def
+                       Just x  -> fromConf x
+
+----------------------------------------------------------------
+
+type Conf = (String, ConfValue)
+
+data ConfValue = CV_Int Int | CV_Bool Bool | CV_String String deriving Show
+
+class FromConf a where
+    fromConf :: ConfValue -> a
+
+instance FromConf Int where
+    fromConf (CV_Int n) = n
+    fromConf _ = error "fromConf int"
+
+instance FromConf Bool where
+    fromConf (CV_Bool b) = b
+    fromConf _ = error "fromConf bool"
+
+instance FromConf String where
+    fromConf (CV_String s) = s
+    fromConf _ = error "fromConf string"
+
+----------------------------------------------------------------
+
+parseConfig :: String -> [Conf]
+parseConfig cs = let css = filter (not.isPrefixOf "#") $ lines cs
+                 in map parseConf css
+    where
+      parseConf xs = case parse config "config" xs of
+                       Right cnf -> cnf
+                       Left  err -> error $ "parseConfig " ++ show err
+
+----------------------------------------------------------------
+
+config :: Parser Conf
+config = do nm <- name
+            spaces
+            char ':'
+            spaces
+            vl <- value
+            return (nm,vl)
+
+name :: Parser String
+name = many1.oneOf $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"
+
+value :: Parser ConfValue
+value = choice [try cv_int, try cv_bool, cv_string]
+
+cv_int :: Parser ConfValue
+cv_int = do ns <- many1 digit
+            spaces
+            eof
+            return $ CV_Int $ read ns
+
+cv_bool :: Parser ConfValue
+cv_bool = do { string "Yes"; spaces; eof; return (CV_Bool True)  } <|>
+          do { string "No";  spaces; eof; return (CV_Bool False) }
+
+cv_string :: Parser ConfValue
+cv_string = do ss <- many1 (noneOf " \t\n")
+               return $ CV_String ss
diff --git a/File.hs b/File.hs
new file mode 100644
--- /dev/null
+++ b/File.hs
@@ -0,0 +1,83 @@
+module File (mighty, progName) where
+
+import Control.Applicative
+import Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as LBS
+import Data.List
+import Data.Time
+import Data.Time.Clock.POSIX
+import IO
+import Network.TCPInfo
+import Network.URI
+import Network.Web.Server
+import Network.Web.Server.Basic
+import Network.Web.Utils
+import System.Directory
+import System.FilePath
+import System.Posix.Files
+import URLMap
+
+progName :: String
+progName = "Mighttpd"
+
+progVersion :: String
+progVersion = "0.1.0"
+
+progNameVersion :: String
+progNameVersion = progName ++ " " ++ progVersion
+
+----------------------------------------------------------------
+
+mighty :: WebConfig -> URLMap -> Handle -> TCPInfo -> IO ()
+mighty wcnf umap hdl tcpinfo = do
+  let bcnf = BasicConfig { obtain = fileGet
+                         , info   = fileInfo
+                         , mapper = fileMapper umap
+                         , serverName = progNameVersion
+                         , tcpInfo = tcpinfo
+                         }
+  connection hdl (basicServer bcnf) wcnf
+
+----------------------------------------------------------------
+
+lookupFileMap :: URLMap -> URL -> Path
+lookupFileMap [] _          = None
+lookupFileMap ((from,to):xs) url
+    | from `isPrefixOf` url = toPath to $ drop (length from) url
+    | otherwise             = lookupFileMap xs url
+  where
+    toPath (File dir) restPath = File $ dir </> restPath
+    toPath (CGI dir _ urlPath) progParam = CGI prog param scriptName
+      where
+        (prog',param) = break (\x -> x == '?' || x == '/') progParam
+        prog = dir </> prog'
+        scriptName = urlPath </> prog'
+    toPath _ _ = error "toPath"
+
+fileMapper :: URLMap -> URI -> Path
+fileMapper umap uri = fileMapper' (lookupFileMap umap url)
+  where
+    url = unEscapeString $ toURLwoPort uri
+    fileMapper' None                  = None
+    fileMapper' cgi@(CGI _ _ _)       = cgi
+    fileMapper' (File file)
+      | hasTrailingPathSeparator file = File $ file </> "index.html"
+      | otherwise                     = File file
+
+fileGet :: FilePath -> Maybe (Integer,Integer) -> IO ByteString
+fileGet file Nothing = openFile file ReadMode >>= LBS.hGetContents
+fileGet file (Just (skip,len)) = do
+    h <- openFile file ReadMode
+    hSeek h AbsoluteSeek skip
+    LBS.take (fromIntegral len) <$> LBS.hGetContents h
+
+fileInfo :: FilePath -> IO (Maybe (Integer, UTCTime))
+fileInfo file = do
+    exist <- doesFileExist file
+    if exist
+       then do
+         fs <- getFileStatus file
+         let size = fromIntegral . fileSize $ fs
+             mtime = posixSecondsToUTCTime . realToFrac . modificationTime $ fs
+         return $ Just (size, mtime)
+       else return Nothing
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+Copyright (c) 2009, IIJ Innovation Institute Inc.
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+  * Redistributions of source code must retain the above copyright
+    notice, this list of conditions and the following disclaimer.
+  * Redistributions in binary form must reproduce the above copyright
+    notice, this list of conditions and the following disclaimer in
+    the documentation and/or other materials provided with the
+    distribution.
+  * Neither the name of the copyright holders nor the names of its
+    contributors may be used to endorse or promote products derived
+    from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/LogMsg.hs b/LogMsg.hs
new file mode 100644
--- /dev/null
+++ b/LogMsg.hs
@@ -0,0 +1,87 @@
+module LogMsg (initLog,
+               FacilityString, LevelString, LogSystem(..),
+               errorMsg, warnMsg, noticeMsg,
+               infoMsg, debugMsg) where
+
+import Data.Maybe
+import System.Log.Logger
+import System.Log.Handler.Syslog
+
+errorMsg :: String -> IO ()
+errorMsg = errorM rootLoggerName
+
+warnMsg :: String -> IO ()
+warnMsg = warningM rootLoggerName
+
+noticeMsg :: String -> IO ()
+noticeMsg = noticeM rootLoggerName
+
+infoMsg :: String -> IO ()
+infoMsg = infoM rootLoggerName
+
+debugMsg :: String -> IO ()
+debugMsg = debugM rootLoggerName
+
+type FacilityString = String
+type LevelString = String
+
+data LogSystem = StdErr | SysLog
+
+initLog :: String
+        -> FacilityString
+        -> LevelString
+        -> LogSystem
+        -> IO ()
+
+initLog name fcl lvl SysLog = do
+    let level = toLevel lvl
+        facility = toFacility fcl
+    s <- openlog name [PID] facility level
+    updateGlobalLogger rootLoggerName (setLevel level . setHandlers [s])
+initLog _ _ lvl StdErr = do
+    let level = toLevel lvl
+    updateGlobalLogger rootLoggerName (setLevel level)
+
+toLevel :: String -> Priority
+toLevel str = maybe (error ("Unknown level " ++ show str))
+                     id (lookup str levelDB)
+
+toFacility :: String -> Facility
+toFacility str = maybe (error ("Unknown facility " ++ show str))
+                        id (lookup str facilityDB)
+
+levelDB :: [(String, Priority)]
+levelDB = [
+    ("debug",DEBUG)
+  , ("info",INFO)
+  , ("notice",NOTICE)
+  , ("warning",WARNING)
+  , ("error",ERROR)
+  , ("critical",CRITICAL)
+  , ("alert",ALERT)
+  , ("emergency",EMERGENCY)
+  ]
+
+facilityDB :: [(String, Facility)]
+facilityDB = [
+    ("kern",KERN)
+  , ("use",USER)
+  , ("mail",MAIL)
+  , ("daemon",DAEMON)
+  , ("auth",AUTH)
+  , ("syslog",SYSLOG)
+  , ("lpr",LPR)
+  , ("news",NEWS)
+  , ("uucp",UUCP)
+  , ("cron",CRON)
+  , ("authpriv",AUTHPRIV)
+  , ("ftp",FTP)
+  , ("local0",LOCAL0)
+  , ("local1",LOCAL1)
+  , ("local2",LOCAL2)
+  , ("local3",LOCAL3)
+  , ("local4",LOCAL4)
+  , ("local5",LOCAL5)
+  , ("local6",LOCAL6)
+  , ("local7",LOCAL7)
+  ]
diff --git a/Mighttpd.hs b/Mighttpd.hs
new file mode 100644
--- /dev/null
+++ b/Mighttpd.hs
@@ -0,0 +1,83 @@
+{-# LANGUAGE BangPatterns#-}
+
+module Main where
+
+import Config
+import Control.Monad
+import File
+import IO
+import LogMsg
+import Network.C10kServer
+import Network.Web.Server
+import System.Environment
+import System.Exit
+import System.Posix.Daemonize
+import URLMap
+
+----------------------------------------------------------------
+
+main :: IO ()
+main = do
+    conf <- readFile =<< fileName 0
+    mapf <- readFile =<< fileName 1
+    let !opt        = parseOption conf
+        !webConfig  = toWebConfig opt
+        !c10kConfig = toC10kConfig opt
+        !uriMap     = parseURLMap mapf
+        !prog       = mighty webConfig uriMap
+    if opt_debug_mode opt
+       then runC10kServer prog c10kConfig
+       else daemonize $ runC10kServer prog c10kConfig
+  where
+    fileName n = do
+        args <- getArgs
+        when (length args /= 2) $ do
+            hPutStrLn stderr "Usage: pbws config_file uri_map"
+            exitFailure
+        return $ args !! n
+
+----------------------------------------------------------------
+
+toWebConfig :: Option -> WebConfig
+toWebConfig opt = WebConfig {
+    closedHook = debugMsg
+  , accessHook = noticeMsg
+  , errorHook  = warnMsg
+  , fatalErrorHook = errorMsg
+  , connectionTimer = opt_connection_timer opt
+}
+
+toC10kConfig :: Option -> C10kConfig
+toC10kConfig opt = C10kConfig {
+    initHook = makeInitHook opt
+  , exitHook = makeExitHook
+  , parentStartedHook = makeParentHook
+  , startedHook = makeStartedHook opt
+  , sleepTimer = opt_sleep_timer opt
+  , preforkProcessNumber = opt_prefork_process_number opt
+  , threadNumberPerProcess = opt_thread_number_per_process opt
+  , portName = show $ opt_port opt
+  , pidFile = opt_pid_file opt
+  , user = opt_user opt
+  , group = opt_group opt
+}
+
+makeInitHook :: Option -> IO ()
+makeInitHook opt =
+  if opt_debug_mode opt == True
+  then initLog progName "" (opt_log_level opt) StdErr
+  else initLog progName (opt_syslog_facility opt) (opt_log_level opt) SysLog
+
+makeExitHook :: String -> IO ()
+makeExitHook = errorMsg
+
+makeParentHook :: IO ()
+makeParentHook = infoMsg $ progName ++ " started"
+
+makeStartedHook :: Option -> IO ()
+makeStartedHook opt =
+  if opt_debug_mode opt == True
+  then do
+    initLog progName "" (opt_log_level opt) StdErr
+  else do
+    initLog progName (opt_syslog_facility opt) (opt_log_level opt) SysLog
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/URLMap.hs b/URLMap.hs
new file mode 100644
--- /dev/null
+++ b/URLMap.hs
@@ -0,0 +1,59 @@
+module URLMap (parseURLMap, URL, URLMap) where
+
+import Control.Applicative ((<$>),(<$),(<*),(<*>),(*>),pure)
+import Network.URI
+import Network.Web.Server.Basic
+import Text.Parsec
+import Text.Parsec.String
+
+type URL = String
+type URLMap = [(URL,Path)]
+
+parseURLMap :: String -> URLMap
+parseURLMap cs = either (fail . show) (map fixCGI) (parse umap "umap" cs)
+  where
+    fixCGI (k, CGI prog param _) = (k, CGI prog param (scriptDir k))
+    fixCGI x                     = x
+    scriptDir x = maybe "" uriPath (parseURI x)
+
+umap :: Parser [(URL,Path)]
+umap =  comments *> many (line <* comments)
+
+comments :: Parser ()
+comments = () <$ many comment
+
+comment :: Parser ()
+comment = () <$ char '#' >> many (noneOf "\n") >> eol
+
+line :: Parser (URL,Path)
+line = (,) <$> uri <*> (fileOrCGI <* eol)
+
+uri :: Parser URL
+uri = spcs *> (str <* spcs)
+
+fileOrCGI :: Parser Path
+fileOrCGI = file <|> cgi
+
+file :: Parser Path
+file = File <$> (arrow *> dir)
+
+cgi :: Parser Path
+cgi = CGI <$> (darrow *> dir) <*> pure "" <*> pure ""
+
+arrow :: Parser ()
+arrow = () <$ string "->" >> spcs
+
+darrow :: Parser ()
+darrow = () <$ string "=>" >> spcs
+
+dir :: Parser FilePath
+dir =  str <* spcs
+
+str :: Parser String
+str = many1 (noneOf " \t\n")
+
+eol :: Parser ()
+eol = () <$ char '\n'
+
+spcs :: Parser ()
+spcs = () <$ many (oneOf " \t")
diff --git a/mighttpd.cabal b/mighttpd.cabal
new file mode 100644
--- /dev/null
+++ b/mighttpd.cabal
@@ -0,0 +1,25 @@
+Name:                   mighttpd
+Version:                0.1.0
+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
+License:                BSD3
+License-File:           LICENSE
+Synopsis:               Simple Web Server in Haskell
+Description:            A simple but practical HTTP server in Haskell.
+                        'mighttpd' should be called 'mighty'.
+Homepage:               http://www.mew.org/~kazu/proj/mighttpd/
+Category:               Network
+Cabal-Version:          >= 1.6
+Build-Type:             Simple
+Extra-Source-Files:     Config.hs, LogMsg.hs, Setup.hs, File.hs, URLMap.hs
+Data-Files:             sample.conf, sample.map
+Executable mighttpd
+    Main-Is:            Mighttpd.hs
+    GHC-Options:        -Wall -O2
+    Build-Depends:      base >= 4 && < 10, parsec >= 3,
+                        c10k, hslogger, webserver, bytestring, filepath,
+                        haskell98, hdaemonize, directory, unix, time, network
+Executable mkindex
+    Main-Is:            mkindex.hs
+    GHC-Options:        -Wall -O2
+    Build-Depends:      base >= 4
diff --git a/mkindex.hs b/mkindex.hs
new file mode 100644
--- /dev/null
+++ b/mkindex.hs
@@ -0,0 +1,95 @@
+{-
+  mkindex :: Making index.html for the current directory.
+-}
+import Control.Applicative
+import Data.Time
+import Data.Time.Clock.POSIX
+import Locale
+import System.Directory
+import System.Posix.Files
+import Text.Printf
+import Data.Bits
+
+indexFile :: String
+indexFile = "index.html"
+
+main :: IO ()
+main = do
+    contents <- mkContents
+    writeFile indexFile $ header ++ contents ++ tailer
+    setFileMode indexFile mode
+  where
+    mode = ownerReadMode .|. ownerWriteMode .|. groupReadMode .|. otherReadMode
+
+mkContents :: IO String
+mkContents = do
+    fileNames <- filter dotAndIndex <$> getDirectoryContents "."
+    stats <- mapM getFileStatus fileNames
+    let fmsls = map pp $ zip fileNames stats
+        maxLen = maximum $ map (\(_,_,_,x) -> x) fmsls
+        contents = concatMap (content maxLen) fmsls
+    return contents
+  where
+    dotAndIndex x = head x /= '.' && x /= indexFile
+
+pp :: (String,FileStatus) -> (String,String,String,Int)
+pp (f,st) = (file,mtime,size,flen)
+  where
+    file = ppFile f st
+    flen = length file
+    mtime = ppMtime st
+    size = ppSize st
+
+ppFile :: String -> FileStatus -> String
+ppFile f st
+  | isDirectory st = f ++ "/"
+  | otherwise      = f
+
+ppMtime :: FileStatus -> String
+ppMtime st = dateFormat . epochTimeToUTCTime $ st
+  where
+    epochTimeToUTCTime = posixSecondsToUTCTime . realToFrac . modificationTime
+    dateFormat = formatTime defaultTimeLocale "%d-%b-%Y %H:%M"
+
+ppSize :: FileStatus -> String
+ppSize st
+  | isDirectory st = "  - "
+  | otherwise      = sizeFormat . fromIntegral . fileSize $ st
+  where
+    sizeFormat siz = unit siz [' ','K','M','G','T']
+    unit _ []  = undefined
+    unit s [u] = format s u
+    unit s (u:us)
+      | s >= 1024 = unit (s `div` 1024) us
+      | otherwise = format s u
+    format :: Integer -> Char -> String
+    format = printf "%3d%c"
+
+header :: String
+header = "\
+\<html>\n\
+\<head>\n\
+\<style type=\"text/css\">\n\
+\<!--\n\
+\body { padding-left: 10%; }\n\
+\h1 { font-size: x-large; }\n\
+\pre { font-size: large; }\n\
+\hr { text-align: left; margin-left: 0px; width: 80% }\n\
+\--!>\n\
+\</style>\n\
+\</head>\n\
+\<title>Directory contents</title>\n\
+\<body>\n\
+\<h1>Directory contents</h1>\n\
+\<hr>\n\
+\<pre>\n"
+
+content :: Int -> (String,String,String,Int) -> String
+content lim (f,m,s,len) = "<a href=\"" ++ f ++ "\">" ++ f ++ "</a>  " ++ replicate (lim - len) ' ' ++ m ++ "  " ++ s ++ "\n"
+
+tailer :: String
+tailer = "\
+\</pre>\n\
+\<hr>\n\
+\</body>\n\
+\</html>\n"
diff --git a/sample.conf b/sample.conf
new file mode 100644
--- /dev/null
+++ b/sample.conf
@@ -0,0 +1,11 @@
+Port: 80
+Prefork_Process_Number: 20
+Thread_Number_Per_Process: 300
+Connection_Timer: 10
+Sleep_Timer: 2
+Debug_Mode: No
+User: nobody
+Group: nobody
+Syslog_Facility: local6
+Log_Level: info
+Pid_File: /tmp/mighttpd.pid
diff --git a/sample.map b/sample.map
new file mode 100644
--- /dev/null
+++ b/sample.map
@@ -0,0 +1,8 @@
+# CGI directory mapping
+http://example.org/ja/cgi-bin/ => /export/www/cgi-bin/
+http://example.org/mailman/    => /usr/local/mailman/cgi-bin/
+# Directory mapping
+http://example.org/pipermail/  -> /usr/local/mailman/archives/public/
+http://example.org/icons/      -> /usr/local/mailman/icons/
+http://example.org/~user/      -> /home/user/public_html/
+http://example.org/            -> /export/www/