diff --git a/Config.hs b/Config.hs
new file mode 100644
--- /dev/null
+++ b/Config.hs
@@ -0,0 +1,128 @@
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Config (Option(..), getOption, defaultOption) where
+
+import Data.List (isPrefixOf)
+import Parsec
+
+----------------------------------------------------------------
+
+defaultOption :: Option
+defaultOption = Option {
+    opt_addr = "127.0.0.1"
+  , opt_port = 10025
+  , opt_reject_plus_all = True
+  , opt_minimum_ipv4_mask_length = 24
+  , opt_minimum_ipv6_mask_length = 48
+  , opt_include_redirect_limit = 10
+  , opt_syslog_facility = "local4"
+  , opt_log_level = "info"
+  , opt_logonly = False
+  , opt_debug_mode = False
+  , opt_prefork_process_number = 20
+  , opt_thread_number_per_process = 500
+  , opt_sleep_timer = 2
+  , opt_user = "nobody"
+  , opt_group = "nobody"
+  , opt_pid_file = "/var/run/rpf.pid"
+  }
+
+data Option = Option {
+    opt_addr :: String
+  , opt_port :: Int
+  , opt_reject_plus_all :: Bool
+  , opt_minimum_ipv4_mask_length :: Int
+  , opt_minimum_ipv6_mask_length :: Int
+  , opt_include_redirect_limit :: Int
+  , opt_syslog_facility :: String
+  , opt_log_level :: String
+  , opt_logonly :: Bool
+  , opt_debug_mode :: Bool
+  , opt_prefork_process_number :: Int
+  , opt_thread_number_per_process :: Int
+  , opt_sleep_timer :: Int
+  , opt_user :: String
+  , opt_group :: String
+  , opt_pid_file :: String
+  } deriving Show
+
+----------------------------------------------------------------
+
+getOption :: String -> Option
+getOption = makeOpt defaultOption . parseConfig
+
+----------------------------------------------------------------
+
+makeOpt :: Option -> [Conf] -> Option
+makeOpt def conf = Option {
+    opt_addr = get "Address" opt_addr
+  , opt_port = get "Port" opt_port
+  , opt_reject_plus_all = get "Reject_Plus_All" opt_reject_plus_all
+  , opt_minimum_ipv4_mask_length = get "Minimum_IPv4_Mask_Length" opt_minimum_ipv4_mask_length
+  , opt_minimum_ipv6_mask_length = get "Minimum_IPv6_Mask_Length" opt_minimum_ipv6_mask_length
+  , opt_include_redirect_limit = get "Include_Redirect_Limit" opt_include_redirect_limit
+  , opt_syslog_facility = get "Syslog_Facility" opt_syslog_facility
+  , opt_log_level = get "Log_Level" opt_log_level
+  , opt_logonly = get "Logonly" opt_logonly
+  , opt_debug_mode = get "Debug" opt_debug_mode
+  , 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_sleep_timer      = get "Sleep_Timer" opt_sleep_timer
+  , opt_user             = get "User" opt_user
+  , opt_group            = get "Group" opt_group
+  , opt_pid_file         = get "Pid_File" opt_pid_file
+  }
+    where
+      get key func = maybe (func def) fromConf $ lookup key conf
+
+----------------------------------------------------------------
+
+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 = map parseConf css
+    where
+      css = filter (not.isPrefixOf "#") . lines $ cs
+      parseConf xs = case parse config "config" xs of
+                       Right cnf -> cnf
+                       Left  err -> error $ show err
+
+----------------------------------------------------------------
+
+config :: Parser Conf
+config = (,) <$> name <*> (spaces >> char ':' >> spaces *> value)
+
+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 = CV_Int . read <$> (many1 digit <* (spaces >> eof))
+
+cv_bool :: Parser ConfValue
+cv_bool = CV_Bool True  <$ (string "Yes" >> spaces >> eof) <|>
+          CV_Bool False <$ (string "No"  >> spaces >> eof)
+
+cv_string :: Parser ConfValue
+cv_string = CV_String <$> many1 (noneOf " \t\n")
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,85 @@
+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 = fromMaybe (error $ "Unknown level " ++ show str) (lookup str levelDB)
+
+toFacility :: String -> Facility
+toFacility str = fromMaybe (error $ "Unknown facility " ++ show str) (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/MailSpec.hs b/MailSpec.hs
new file mode 100644
--- /dev/null
+++ b/MailSpec.hs
@@ -0,0 +1,56 @@
+module MailSpec where
+
+import Data.IP
+import Network.DNS.Types (Domain)
+import Network.DomainAuth
+
+----------------------------------------------------------------
+
+data MailSpec = MailSpec {
+    msPeerIP         :: IP           -- #ip
+  , msMailFrom       :: Maybe Domain -- #mail_from
+  , msFrom           :: Maybe Domain -- #from
+  , msPRA            :: Maybe Domain -- #pra
+  , msDKIMFrom       :: Maybe Domain -- #dkim_from
+  , msDKFrom         :: Maybe Domain -- #domainkeys_from
+  , msSPFResult      :: DAResult     -- #spf
+  , msSenderIDResult :: DAResult     -- #sender_id
+  , msDKIMResult     :: DAResult     -- #dkim
+  , msDKResult       :: DAResult     -- #domainkeys
+  , msADSPResult     :: DAResult     -- #adsp
+  , msSigDKIM        :: Bool         -- #sig_dkim
+  , msSigDK          :: Bool         -- #sig_domainkeys
+  }
+
+instance Show MailSpec where
+    show ms = "{#ip=" ++ show (msPeerIP ms)
+           ++ ",#mail_from=" ++ show (msMailFrom ms)
+           ++ ",#from=" ++ show (msFrom ms)
+           ++ ",#pra=" ++ show (msPRA ms)
+           ++ ",#dkim_from=" ++ show (msDKIMFrom ms)
+           ++ ",#domainkeys_from=" ++ show (msDKFrom ms)
+           ++ ",#spf=" ++ show (msSPFResult ms)
+           ++ ",#sender_id=" ++ show (msSenderIDResult ms)
+           ++ ",#dkim=" ++ show (msDKIMResult ms)
+           ++ ",#domainkeys=" ++ show (msDKResult ms)
+--           ++ ",#adsp=" ++ show (msADSPResult ms)
+           ++ ",#sig_dkim=" ++ show (msSigDKIM ms)
+           ++ ",#sig_domainkyes=" ++ show (msSigDK ms)
+           ++ "}"
+
+initialMailSpec :: MailSpec
+initialMailSpec = MailSpec {
+    msPeerIP         = IPv4 $ read "127.0.0.1" -- xxx
+  , msMailFrom       = Nothing
+  , msFrom           = Nothing
+  , msPRA            = Nothing
+  , msDKIMFrom       = Nothing
+  , msDKFrom         = Nothing
+  , msSPFResult      = DANone
+  , msSenderIDResult = DANone
+  , msDKIMResult     = DANone
+  , msDKResult       = DANone
+  , msADSPResult     = DANone
+  , msSigDKIM        = False
+  , msSigDK          = False
+  }
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE BangPatterns#-}
+
+module Main where
+
+import Config
+import Control.Monad
+import Data.IORef
+import LogMsg
+import Milter
+import Network.C10kServer
+import Network.DNS
+import Network.DomainAuth
+import Network.TCPInfo
+import RPF
+import System.Environment
+import System.Exit
+import System.IO
+import System.Posix.Daemonize (daemonize)
+
+progName :: String
+progName = "rpf 0.2.0"
+
+----------------------------------------------------------------
+
+main :: IO ()
+main = do
+    resSeed <- makeResolvSeed defaultResolvConf
+    conf <- readFile =<< fileName 0
+    polf <- readFile =<< fileName 1
+    let !opt        = getOption conf
+        !plcy       = parsePolicy polf
+        !c10kConfig = toC10kConfig opt
+        !lim        = toLimit opt
+        !env        = toEnv opt plcy
+        !prog       = milterWapper resSeed lim env
+    if opt_debug_mode opt
+       then runC10kServerH prog c10kConfig
+       else daemonize $ runC10kServerH prog c10kConfig
+  where
+    fileName n = do
+        args <- getArgs
+        when (length args /= 2) $ do
+            hPutStrLn stderr "Usage: rpf config_file policy_file"
+            exitFailure
+        return $ args !! n
+
+milterWapper :: ResolvSeed -> Limit -> Env -> Handle -> TCPInfo -> IO ()
+milterWapper rs lim env hdl _ = do
+    hSetBuffering hdl NoBuffering
+    st <- newIORef initialState
+    withResolver rs $ \resolver -> do
+        let env' = env {
+                spf  = runSPF lim resolver
+              , dk   = runDK' resolver
+              , dkim = runDKIM' resolver
+              }
+        milter env' hdl st
+
+----------------------------------------------------------------
+
+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
+  , ipAddr = Just $ opt_addr opt
+  , pidFile = opt_pid_file opt
+  , user = opt_user opt
+  , group = opt_group opt
+}
+
+makeInitHook :: Option -> IO ()
+makeInitHook opt =
+  if opt_debug_mode opt
+  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
+  then initLog progName "" (opt_log_level opt) StdErr
+  else initLog progName (opt_syslog_facility opt) (opt_log_level opt) SysLog
+
+----------------------------------------------------------------
+
+toLimit :: Option -> Limit
+toLimit opt = Limit {
+    limit = opt_include_redirect_limit opt
+  , ipv4_masklen = opt_minimum_ipv4_mask_length opt
+  , ipv6_masklen = opt_minimum_ipv6_mask_length opt
+  , reject_plus_all = opt_reject_plus_all opt
+  }
+
+toEnv :: Option -> Policy -> Env
+toEnv opt plcy = defaultEnv {
+    policy  = plcy
+  , logonly = opt_logonly opt
+  , debug   = opt_debug_mode opt
+  , errorHook   = warnMsg
+  , resultHook  = noticeMsg
+  , monitorHook = infoMsg
+  , debugHook   = debugMsg
+  }
diff --git a/Milter.hs b/Milter.hs
new file mode 100644
--- /dev/null
+++ b/Milter.hs
@@ -0,0 +1,9 @@
+module Milter (
+    Env(..), defaultEnv
+  , initialState
+  , milter
+  ) where
+
+import Milter.Env
+import Milter.Types
+import Milter.Switch
diff --git a/Milter/Base.hs b/Milter/Base.hs
new file mode 100644
--- /dev/null
+++ b/Milter/Base.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Milter.Base (
+    Packet (..)
+  , getPacket
+  , getIP
+  , getKeyVal
+  , getBody
+  , negoticate
+  , accept, discard, hold, reject, continue
+  ) where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString.Lazy.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as L hiding (ByteString)
+import Data.Char
+import Data.IP
+import Data.List (foldl')
+import System.IO
+
+----------------------------------------------------------------
+
+accept :: Handle -> IO ()
+accept hdl   = safePutPacket hdl $ Packet 'a' ""
+
+discard :: Handle -> IO ()
+discard hdl  = safePutPacket hdl $ Packet 'd' ""
+
+hold :: Handle -> IO ()
+hold hdl     = safePutPacket hdl $ Packet 't' ""
+
+reject :: Handle -> IO ()
+reject hdl   = safePutPacket hdl $ Packet 'r' ""
+
+continue :: Handle -> IO ()
+continue hdl = safePutPacket hdl $ Packet 'c' ""
+
+----------------------------------------------------------------
+
+data Packet = Packet Char ByteString
+
+getPacket :: Handle -> IO Packet
+getPacket hdl = do
+    n <- fourBytesToInt <$> getNByte hdl 4
+    Packet <$> getCmd hdl <*> getNByte hdl (n - 1)
+
+putPacket :: Handle -> Packet -> IO ()
+putPacket hdl (Packet c bs) = do
+    let len = fromIntegral (L.length bs) + 1
+    L.hPut hdl $ intToFourBytes len
+    L.hPut hdl $ c `L.cons` bs
+
+safePutPacket :: Handle -> Packet -> IO ()
+safePutPacket hdl pkt = withOpenedHandleDo hdl $ putPacket hdl pkt
+
+withOpenedHandleDo :: Handle -> IO () -> IO ()
+withOpenedHandleDo hdl block = do
+  closed <- hIsClosed hdl
+  unless closed block
+
+----------------------------------------------------------------
+
+getKeyVal :: ByteString -> (ByteString, ByteString)
+getKeyVal bs = (key,val)
+  where
+    kv = L.split '\0' bs
+    key = kv !! 0
+    val = kv !! 1
+
+----------------------------------------------------------------
+
+getBody :: ByteString -> ByteString
+getBody = L.init -- removing the last '\0'
+
+----------------------------------------------------------------
+
+getIP :: ByteString -> IP
+getIP bs
+  | fam == '4' = IPv4 . read $ adr
+  | otherwise  = IPv6 . read $ adr
+  where
+    ip  = L.split '\0' bs !! 1
+    fam = L.head ip
+    adr = L.unpack $ L.drop 3 ip
+
+----------------------------------------------------------------
+
+negoticate :: Handle -> IO ()
+negoticate hdl =  putPacket hdl negoPkt -- do NOT use safePutPacket
+
+negoPkt :: Packet
+negoPkt = Packet 'O' $ ver +++ act +++ pro
+  where
+    ver = intToFourBytes 2 -- Sendmail 8.13.8, sigh
+    act = intToFourBytes 0
+    pro = intToFourBytes noRcpt
+
+noRcpt :: Int
+noRcpt    = 0x8
+{- version 2 does not support, sigh
+noUnknown = 0x100
+noData    = 0x200
+-}
+
+----------------------------------------------------------------
+
+getNByte :: Handle -> Int -> IO ByteString
+getNByte = L.hGet
+
+getCmd :: Handle -> IO Char
+getCmd hdl = L.head <$> L.hGet hdl 1
+
+fourBytesToInt :: ByteString -> Int
+fourBytesToInt = foldl' (\a b -> a * 256 + b) 0 . map ord . L.unpack
+
+intToFourBytes :: Int -> ByteString
+intToFourBytes = L.pack. reverse . map chr . moddiv 4
+
+moddiv :: Int -> Int -> [Int]
+moddiv 0 _ = []
+moddiv i m = (m `mod` 256) : moddiv (i - 1) (m `div` 256)
+
+----------------------------------------------------------------
+
+(+++) :: ByteString -> ByteString -> ByteString
+(+++) = L.append
diff --git a/Milter/Env.hs b/Milter/Env.hs
new file mode 100644
--- /dev/null
+++ b/Milter/Env.hs
@@ -0,0 +1,33 @@
+module Milter.Env where
+
+import Data.IP
+import Network.DNS
+import Network.DomainAuth
+import RPF
+
+data Env = Env {
+    policy   :: Policy
+  , logonly  :: Bool
+  , debug    :: Bool
+  , spf      :: Domain -> IP -> IO DAResult
+  , dk       :: Mail -> DK -> IO DAResult
+  , dkim     :: Mail -> DKIM -> IO DAResult
+  , errorHook   :: String -> IO ()
+  , resultHook  :: String -> IO ()
+  , monitorHook :: String -> IO ()
+  , debugHook   :: String -> IO ()
+  }
+
+defaultEnv :: Env
+defaultEnv = Env {
+    policy  = undefined
+  , logonly = undefined
+  , debug   = undefined
+  , spf     = undefined
+  , dk      = undefined
+  , dkim    = undefined
+  , errorHook   = undefined
+  , resultHook  = undefined
+  , monitorHook = undefined
+  , debugHook   = undefined
+  }
diff --git a/Milter/Log.hs b/Milter/Log.hs
new file mode 100644
--- /dev/null
+++ b/Milter/Log.hs
@@ -0,0 +1,35 @@
+module Milter.Log where
+
+import Control.Applicative
+import Data.IORef
+import MailSpec
+import Milter.Env
+import Milter.Types
+
+----------------------------------------------------------------
+
+logError :: Env -> IORef State -> String -> IO ()
+logError env st msg = do
+    msg' <- addIP st msg
+    errorHook env msg'
+
+logResult :: Env -> IORef State -> String -> IO ()
+logResult env st msg = do
+    msg' <- addIP st msg
+    let msg'' = msg' ++ if logonly env then " (log only)" else ""
+    resultHook env msg''
+
+logMonitor :: Env -> IORef State -> String -> IO ()
+logMonitor env st msg = do
+    msg' <- addIP st msg
+    monitorHook env msg'
+
+logDebug :: Env -> IORef State -> String -> IO ()
+logDebug env st msg = do
+    msg' <- addIP st msg
+    debugHook env msg'
+
+addIP :: IORef State -> String -> IO String
+addIP st msg = do
+    ip <- msPeerIP . mailspec <$> readIORef st
+    return $ show ip ++ " " ++ msg
diff --git a/Milter/Switch.hs b/Milter/Switch.hs
new file mode 100644
--- /dev/null
+++ b/Milter/Switch.hs
@@ -0,0 +1,192 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Milter.Switch (milter) where
+
+import Control.Applicative
+import Control.Monad
+import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.IORef
+import MailSpec
+import Milter.Base
+import Milter.Env
+import Milter.Log
+import Milter.Types
+import Network.DomainAuth
+import RPF
+import System.IO
+
+----------------------------------------------------------------
+
+milter :: Env -> Handle -> IORef State -> IO ()
+milter env hdl ref = withValidHandleDo $
+    flip catch errorHandle $ do
+      rpkt <- getPacket hdl
+      switch env hdl ref rpkt
+      milter env hdl ref
+  where
+    errorHandle e = logDebug env ref $ show e
+    withValidHandleDo block = do
+        closed <- hIsClosed hdl
+        eof <- hIsEOF hdl
+        unless (eof || closed) block
+
+switch :: Env -> Handle -> IORef State -> Packet -> IO ()
+switch env hdl ref (Packet 'O' bs) = open env hdl ref bs
+switch env hdl ref (Packet 'C' bs) = conn env hdl ref bs
+switch env hdl ref (Packet 'H' bs) = helo env hdl ref bs
+switch env hdl ref (Packet 'M' bs) = mfro env hdl ref bs
+switch _   hdl _   (Packet 'R' _ ) = continue hdl
+switch _   hdl _   (Packet 'A' _ ) = continue hdl -- xxx
+switch env hdl ref (Packet 'L' bs) = hedr env hdl ref bs
+switch env hdl ref (Packet 'N' bs) = eohd env hdl ref bs
+switch env hdl ref (Packet 'B' bs) = body env hdl ref bs
+switch env hdl ref (Packet 'E' bs) = eoms env hdl ref bs
+switch _   _   _   (Packet 'D'  _) = return ()
+switch _   _   _   (Packet 'Q'  _) = return ()
+switch env _   ref (Packet x    _) = logError env ref $ "Switch: " ++ [x]
+
+----------------------------------------------------------------
+
+mfilter :: Env -> Handle -> IORef State -> MailSpec -> BlockName -> IO ()
+mfilter env hdl ref ms bn =
+    let ply = policy env
+    in case evalRPF ms ply bn of
+         (l,A_Accept)   -> doit accept  "Accepted"  l
+         (l,A_Discard)  -> doit discard "Discarded" l
+         (l,A_Hold)     -> doit hold    "Held"      l
+         (l,A_Reject)   -> doit reject  "Rejected"  l
+         (_,A_Continue) -> logMonitor env ref "continue" >> continue hdl
+  where
+    doit act m l = do
+        logResult env ref $ m ++ " in line " ++ show l
+        if logonly env
+           then accept hdl
+           else act hdl
+
+----------------------------------------------------------------
+
+type Filter = Env -> Handle -> IORef State -> ByteString -> IO ()
+
+----------------------------------------------------------------
+
+open :: Filter
+open env hdl ref _ = do
+    logMonitor env ref "Milter opened:"
+    negoticate hdl
+
+----------------------------------------------------------------
+
+conn :: Filter
+conn env hdl ref bs = do
+    logMonitor env ref "SMTP Connected:"
+    st <- readIORef ref
+    let ip = getIP bs
+        ms = (mailspec st) { msPeerIP = ip }
+    writeIORef ref st { mailspec = ms }
+    -- after IP set
+    logDebug env ref $ '\t' : show ms
+    mfilter env hdl ref ms B_Connect
+
+----------------------------------------------------------------
+
+helo :: Filter
+helo env hdl ref _ = do
+  logMonitor env ref "HELO:"
+  continue hdl
+
+----------------------------------------------------------------
+
+mfro :: Filter
+mfro env hdl ref bs = do
+    logMonitor env ref "MAIL FROM:"
+    let jmailfrom = extractDomain bs
+    case jmailfrom of
+      Nothing -> continue hdl -- xxx
+      Just dom  -> do
+          st <- readIORef ref
+          xspf <- getSPF dom st
+          let ms = (mailspec st) { msSPFResult = xspf, msMailFrom = jmailfrom }
+          writeIORef ref st { mailspec = ms }
+          logDebug env ref $ '\t' : show ms
+          mfilter env hdl ref ms B_MailFrom
+  where
+    getSPF dom st = do
+        let ip = msPeerIP (mailspec st)
+        spf env dom ip
+
+----------------------------------------------------------------
+
+hedr :: Filter
+hedr env hdl ref bs = do
+    logMonitor env ref "DATA HEADER FIELD:"
+    st <- readIORef ref
+    let (key,val) = getKeyVal bs
+        ckey = canonicalizeKey key
+        xm = pushField key val (xmail st)
+        prd = pushPRD key val (prdspec st)
+        (pv,ms) = checkField ckey val (parsedv st) (mailspec st)
+    writeIORef ref $ st { xmail = xm, mailspec = ms, prdspec = prd, parsedv = pv}
+    logDebug env ref $ "\t" ++ show xm ++ "\n\t" ++ show ms ++ "\n\t" ++ show prd
+    continue hdl
+  where
+    checkField ckey val pv ms
+      | ckey == dkFieldKey   = case parseDK val of
+          Nothing -> (pv, ms)
+          x@(Just pdk) -> (pv { mpdk = x},
+                           ms { msSigDK = True
+                              , msDKFrom = Just (dkDomain pdk) })
+      | ckey == dkimFieldKey = case parseDKIM val of
+          Nothing -> (pv, ms)
+          x@(Just pdkim) -> (pv { mpdkim = x},
+                             ms { msSigDKIM = True
+                                , msDKIMFrom = Just (dkimDomain pdkim) })
+      | otherwise = (pv, ms)
+
+----------------------------------------------------------------
+
+eohd :: Filter
+eohd env hdl ref _ = do
+    logMonitor env ref "DATA HEADER END:"
+    st <- readIORef ref
+    let jfrom = getFrom st
+        jprd  = decidePRD (prdspec st)
+    sid <- getSenderID jprd
+    let ms = (mailspec st) { msSenderIDResult = sid, msFrom = jfrom, msPRA = jprd }
+    writeIORef ref st { mailspec = ms }
+    mfilter env hdl ref ms B_Header
+  where
+    getFrom = decideFrom . prdspec
+    getSenderID jprd =
+        case jprd of
+          Nothing  -> return DAPermError
+          Just dom -> do
+              ms <- mailspec <$> readIORef ref
+              if jprd == msMailFrom ms
+                 then return $ msSPFResult ms
+                 else let ip = msPeerIP ms
+                      in spf env dom ip
+
+----------------------------------------------------------------
+
+body :: Filter
+body env hdl ref bs = do
+    logMonitor env ref "DATA BODY:"
+    st <- readIORef ref
+    let bc = getBody bs
+        xm = pushBody bc (xmail st)
+    writeIORef ref st { xmail = xm }
+    continue hdl
+
+----------------------------------------------------------------
+
+eoms :: Filter
+eoms env hdl ref _ = do
+  logMonitor env ref "DATA BODY END:"
+  st <- readIORef ref
+  let mail = finalizeMail (xmail st)
+      mdk = mpdk (parsedv st)
+      mdkim = mpdkim (parsedv st)
+  xdk <- maybe (return DANone) (dk env mail) mdk
+  xdkim <- maybe (return DANone) (dkim env mail) mdkim
+  let ms = (mailspec st) { msDKResult = xdk, msDKIMResult = xdkim }
+  mfilter env hdl ref ms B_Body
diff --git a/Milter/Types.hs b/Milter/Types.hs
new file mode 100644
--- /dev/null
+++ b/Milter/Types.hs
@@ -0,0 +1,34 @@
+module Milter.Types where
+
+import MailSpec
+import Network.DomainAuth
+
+----------------------------------------------------------------
+
+data State = State {
+    xmail    :: XMail
+  , mailspec :: MailSpec
+  , prdspec  :: PRD
+  , parsedv  :: ParsedValue
+  } deriving Show
+
+initialState :: State
+initialState = State {
+    xmail    = initialXMail
+  , mailspec = initialMailSpec
+  , prdspec  = initialPRD
+  , parsedv  = initialParsedValue
+  }
+
+----------------------------------------------------------------
+
+data ParsedValue = ParsedValue {
+    mpdk   :: Maybe DK
+  , mpdkim :: Maybe DKIM
+  } deriving Show
+
+initialParsedValue :: ParsedValue
+initialParsedValue = ParsedValue {
+    mpdk   = Nothing
+  , mpdkim = Nothing
+  }
diff --git a/Parsec.hs b/Parsec.hs
new file mode 100644
--- /dev/null
+++ b/Parsec.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef MIN_VERSION_parsec
+#define MIN_VERSION_parsec(x,y,z) 0
+#endif
+
+#if MIN_VERSION_parsec(3,0,0)
+module Parsec (
+      module Control.Applicative
+    , module Text.Parsec
+    , module Text.Parsec.String
+    ) where
+
+import Control.Applicative hiding (many,optional,(<|>))
+import Text.Parsec
+import Text.Parsec.String
+#else
+module Parsec (
+      module Text.ParserCombinators.Parsec
+    , (<$>), (<$), (<*>), (<*), (*>), pure
+    ) where
+
+import Control.Monad (ap, liftM)
+import Text.ParserCombinators.Parsec
+
+{-
+  GenParser cannot be an instance of Applicative and Alternative
+  due to the overlapping instances error, sigh!
+-}
+
+(<$>) :: Monad m => (a -> b) -> m a -> m b
+(<$>) = liftM
+
+(<$) :: Monad m => a -> m b -> m a
+a <$ m = m >> return a
+
+(<*>) :: Monad m => m (a -> b) -> m a -> m b
+(<*>) = ap
+
+(*>) :: Monad m => m a -> m b -> m b
+(*>) = (>>)
+
+(<*) :: Monad m => m a -> m b -> m a
+m1 <* m2 = do x <- m1
+              m2
+              return x
+
+pure :: Monad m => a -> m a
+pure = return
+
+infixl 4 <$>, <$, <*>, <*, *>
+#endif
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,4 @@
+This is RPF version 0.2.0.
+
+Please read:
+	 http://www.mew.org/~kazu/proj/rpf/
diff --git a/RPF.hs b/RPF.hs
new file mode 100644
--- /dev/null
+++ b/RPF.hs
@@ -0,0 +1,9 @@
+module RPF (
+    Policy, parsePolicy
+  , Action(..), BlockName(..)
+  , evalRPF
+  ) where
+
+import RPF.Eval
+import RPF.Parser
+import RPF.Types
diff --git a/RPF/Domain.hs b/RPF/Domain.hs
new file mode 100644
--- /dev/null
+++ b/RPF/Domain.hs
@@ -0,0 +1,17 @@
+module RPF.Domain where
+
+import Data.Map (Map)
+import qualified Data.Map as M hiding (Map)
+import Data.Maybe
+import Network.DNS.Types (Domain)
+
+type DomainTable = Map Domain Bool
+
+domainMatch :: Domain -> DomainTable -> Bool
+domainMatch dom = fromMaybe False . M.lookup dom
+
+makeDomainTable :: [Domain] -> DomainTable
+makeDomainTable ds = M.fromList $ zip ds (repeat True)
+
+
+
diff --git a/RPF/Eval.hs b/RPF/Eval.hs
new file mode 100644
--- /dev/null
+++ b/RPF/Eval.hs
@@ -0,0 +1,71 @@
+module RPF.Eval (evalRPF) where
+
+import Control.Monad
+import Data.List (foldl')
+import Data.Maybe
+import MailSpec
+import RPF.Domain
+import RPF.IP
+import RPF.Types
+
+----------------------------------------------------------------
+
+evalRPF :: MailSpec -> Policy -> BlockName -> (Pline, Action)
+evalRPF ms (Policy bs is ds) bn = evalBlock ms is ds (bs !! fromEnum bn)
+
+----------------------------------------------------------------
+
+evalBlock :: MailSpec -> [IPTable] -> [DomainTable] -> Block -> (Pline, Action)
+evalBlock ms is ds (Block _ as) =
+    fromJust $ foldl' mplus mzero (map (evalAction ms is ds) as)
+
+----------------------------------------------------------------
+
+evalAction :: MailSpec -> [IPTable] -> [DomainTable] -> ActionCond -> Maybe (Pline, Action)
+evalAction _ _ _ (ActionCond l Nothing act) = Just (l, act)
+evalAction ms is ds (ActionCond l (Just cnd) act) =
+    if evalCnd ms is ds cnd
+    then Just (l, act)
+    else Nothing
+
+----------------------------------------------------------------
+
+evalCnd :: MailSpec -> [IPTable] -> [DomainTable] -> Cond -> Bool
+evalCnd ms is ds (v :== d) = include ms is ds v d
+evalCnd ms is ds (v :!= d) = exclude ms is ds v d
+evalCnd ms is ds (c1 :&& c2) = evalCnd ms is ds c1 && evalCnd ms is ds c2
+
+----------------------------------------------------------------
+
+include :: MailSpec -> [IPTable] -> [DomainTable] -> Variable -> Constant -> Bool
+include ms is _ (DT_IP,  _) (_, CV_Index n) = ipMatch (msPeerIP ms) (is!!n)
+include ms _ ds (DT_Dom, vid) (_, CV_Index n) =
+    case getDom vid of
+      Nothing -> False
+      Just dom -> domainMatch dom (ds!!n)
+  where
+    getDom V_PRA      = msPRA ms
+    getDom V_MAILFROM = msMailFrom ms
+    getDom V_FROM     = msFrom ms
+    getDom V_DKIMFROM = msDKIMFrom ms
+    getDom V_DKFROM   = msDKFrom ms
+    getDom _          = error "getDom"
+include ms _ _ (DT_Res, vid) (_, CV_Result rs) = getRes vid `elem` rs
+  where
+    getRes V_SPF  = msSPFResult ms
+    getRes V_SID  = msSenderIDResult ms
+    getRes V_ADSP = msADSPResult ms
+    getRes V_DKIM = msDKIMResult ms
+    getRes V_DK   = msDKResult ms
+    getRes _      = error "getRes"
+include ms _ _ (DT_Sig, vid) (_, CV_Sig b) = getSig vid == b
+  where
+    getSig V_SIGDKIM = msSigDKIM ms
+    getSig V_SIGDK   = msSigDK ms
+    getSig _         = error "getSig"
+include _ _ _ _ _ = error "include"
+
+----------------------------------------------------------------
+
+exclude :: MailSpec -> [IPTable] -> [DomainTable] -> Variable -> Constant -> Bool
+exclude a b c d e = not (include a b c d e)
diff --git a/RPF/IP.hs b/RPF/IP.hs
new file mode 100644
--- /dev/null
+++ b/RPF/IP.hs
@@ -0,0 +1,50 @@
+module RPF.IP where
+
+import Data.IP
+import Data.IP.RouteTable (IPRTable)
+import qualified Data.IP.RouteTable as T hiding (IPRTable)
+import Data.Maybe
+
+----------------------------------------------------------------
+
+data IPTable = IPTable {
+    ipv4table :: IPRTable IPv4 Bool -- Bool is dummy
+  , ipv6table :: IPRTable IPv6 Bool -- Bool is dummy
+  } deriving (Eq,Show)
+
+----------------------------------------------------------------
+
+ipMatch :: IP -> IPTable -> Bool
+ipMatch (IPv4 ip) tbl = fromMaybe False $ T.lookup ir (ipv4table tbl)
+  where
+    ir = makeAddrRange ip 32
+ipMatch (IPv6 ip) tbl = fromMaybe False $ T.lookup ir (ipv6table tbl)
+  where
+    ir = makeAddrRange ip 128
+
+----------------------------------------------------------------
+
+makeIPTable :: [IPRange] -> IPTable
+makeIPTable is = IPTable {
+    ipv4table = T.fromList $ zip ipv4addrRange (repeat True)
+  , ipv6table = T.fromList $ zip ipv6addrRange (repeat True)
+  }
+  where
+    ipv4addrRange = map toIPv4AddrRange $ filter isIPv4Range is
+    ipv6addrRange = map toIPv6AddrRange $ filter isIPv6Range is
+
+isIPv4Range :: IPRange -> Bool
+isIPv4Range (IPv4Range _) = True
+isIPv4Range _             = False
+
+toIPv4AddrRange :: IPRange -> AddrRange IPv4
+toIPv4AddrRange (IPv4Range x) = x
+toIPv4AddrRange _             = error "toIPv4AddrRange"
+
+isIPv6Range :: IPRange -> Bool
+isIPv6Range (IPv6Range _) = True
+isIPv6Range _             = False
+
+toIPv6AddrRange :: IPRange -> AddrRange IPv6
+toIPv6AddrRange (IPv6Range x) = x
+toIPv6AddrRange _             = error "toIPv6AddrRange"
diff --git a/RPF/Lexer.hs b/RPF/Lexer.hs
new file mode 100644
--- /dev/null
+++ b/RPF/Lexer.hs
@@ -0,0 +1,70 @@
+module RPF.Lexer where
+
+import Parsec
+import Text.ParserCombinators.Parsec.Language
+import Text.ParserCombinators.Parsec.Token as P
+import RPF.Types
+
+----------------------------------------------------------------
+
+type Lexer st a = GenParser Char st a
+
+----------------------------------------------------------------
+
+rpfStyle :: LanguageDef st
+rpfStyle = emptyDef {
+    commentStart   = "/*"
+  , commentEnd     = "*/"
+  , commentLine    = "//"
+  , nestedComments = True
+  , identStart     = char '$'
+  , identLetter    = alphaNum <|> oneOf "_-"
+  , reservedOpNames= ["&&", "==", "!=", "="]
+  , reservedNames  = actionWords ++ variableNames
+                  ++ resultWords ++ blockNames ++ noyes
+  , caseSensitive  = True
+  }
+
+lexer :: P.TokenParser a
+lexer  = P.makeTokenParser rpfStyle
+
+----------------------------------------------------------------
+
+whiteSpace :: Lexer st ()
+whiteSpace = P.whiteSpace lexer
+
+----------------------------------------------------------------
+
+semi :: Lexer st String
+semi       = P.semi lexer
+
+comma :: Lexer st String
+comma      = P.comma lexer
+
+colon :: Lexer st String
+colon      = P.colon lexer
+
+identifier :: Lexer st String
+identifier = P.identifier lexer
+
+----------------------------------------------------------------
+
+symbol :: String -> Lexer st String
+symbol     = P.symbol lexer
+
+reserved :: String -> Lexer st ()
+reserved   = P.reserved lexer
+
+reservedOp :: String -> Lexer st ()
+reservedOp = P.reservedOp lexer
+
+----------------------------------------------------------------
+
+braces :: Lexer st a -> Lexer st a
+braces     = P.braces lexer
+
+lexeme :: Lexer st a -> Lexer st a
+lexeme     = P.lexeme lexer
+
+commaSep1 :: Lexer st a -> Lexer st [a]
+commaSep1  = P.commaSep1 lexer
diff --git a/RPF/Parser.hs b/RPF/Parser.hs
new file mode 100644
--- /dev/null
+++ b/RPF/Parser.hs
@@ -0,0 +1,268 @@
+module RPF.Parser where
+
+import Control.Monad
+import Data.IP
+import Data.List
+import Data.Maybe
+import Network.DNS.Types (Domain)
+import Network.DomainAuth
+import Parsec hiding (Parser)
+import RPF.Domain
+import RPF.IP
+import RPF.Lexer
+import RPF.State
+import RPF.Types
+import Text.ParserCombinators.Parsec.Expr
+
+{-
+import Debug.Trace
+infixr 0 .$.
+(.$.) :: Show a => (a -> b) -> a -> b
+f .$. x = trace (show x) f x
+-}
+
+----------------------------------------------------------------
+
+type Parser a = Lexer ParserState a
+
+----------------------------------------------------------------
+
+parsePolicy :: String -> Policy
+parsePolicy cs = case runParser config initialState "" cs of
+                   Left  err -> error $ show err
+                   Right rs  -> rs
+
+----------------------------------------------------------------
+
+config :: Parser Policy
+config = do
+    whiteSpace
+    blks <- many1 defBlock
+    eof
+    st <- getState
+    checkUnused (unused st)
+    return $ Policy blks (iptbls st) (domtbls st)
+  where
+    iptbls = map makeIPTable . reverse . iplol
+    domtbls = map makeDomainTable . reverse . domlol
+    checkUnused [] = return ()
+    checkUnused us = unexpected $ ": Not used -- " ++ concat (intersperse ", " us)
+
+----------------------------------------------------------------
+
+defBlock :: Parser Block
+defBlock = many definition >> block
+
+definition :: Parser ()
+definition = do
+    cst <- identifier -- $foo
+    reservedOp "="
+    dat <- ipList <|> domainList <|> resultList
+    semi
+    define cst dat
+    return ()
+  where
+    define cst dat = do
+        st <- getState
+        let ent = lookup cst (consttbl st)
+        when (isJust ent) $ unexpected $ ": Multiple declarations of '" ++ cst ++ "'"
+        setState st {
+            consttbl = (cst, dat) : consttbl st
+          , unused = cst : unused st
+          }
+
+block :: Parser Block
+block = do
+    blknm <- blockname
+    checkBlock blknm
+    cs <- braces (many actionCond)
+    check blknm cs
+    nextBlock
+    return $ Block blknm cs
+  where
+    blockname :: Parser BlockName
+    blockname = sym2enum blockNames [minBound..maxBound]
+    checkBlock blknm = do
+        st <- getState
+        let cblknm = head $ blocks st
+        when (blknm /= cblknm) $ unexpected $ ": " ++ show cblknm ++ "{} is expected"
+    nextBlock = do st <- getState
+                   setState st { blocks = tail $ blocks st }
+    check blknm cs = case last cs of
+      ActionCond _ Nothing _ -> return ()
+      _                      -> unexpected $ ": action without condition must exist in " ++ show blknm ++ "{}"
+
+----------------------------------------------------------------
+
+actionCond :: Parser ActionCond
+actionCond = do
+    pos <- getPosition
+    let l = sourceLine pos
+    act <- action
+    cnd <- option Nothing condition
+    semi
+    return $ ActionCond l cnd act
+  where
+    action :: Parser Action
+    action = sym2enum actionWords [minBound..maxBound]
+    condition = do
+        colon
+        cnd <- cond
+        return $ Just cnd
+
+----------------------------------------------------------------
+
+cond :: Parser Cond
+cond = buildExpressionParser table term
+    where
+      table = [[Infix opAnd AssocRight]]
+
+term :: Parser Cond
+term = do
+    char '#'
+    var@(vtyp,vid) <- variable
+    checkVar vid
+    opr <- opMatch <|> opNotMatch
+    cst@(ctyp,cval) <- constant
+    when (vtyp /= ctyp) $ unexpected ": Data type mismatch"
+    when (vtyp == DT_Res) $ checkResult vid cval
+    return $ var `opr` cst
+  where
+    variable :: Parser Variable
+    variable = var2enum variableNames [minBound..maxBound] variableTypes
+    checkVar vid = do
+        st <- getState
+        let blknm = head $ blocks st
+            sanity = fromJust $ lookup blknm varSanity
+        unless (vid `elem` sanity) $ unexpected $ ": #" ++ show vid ++ " cannot be used in " ++ show blknm ++ "{}"
+    checkResult vid (CV_Result cval) = do
+        let sanity = fromJust $ lookup vid resultSanity
+        mapM_ (test vid sanity) cval
+    checkResult _ _ = return ()
+    test vid rs r = unless (r `elem` rs) $ unexpected $ ": '" ++ show r ++ "' cannot be used for #" ++ show vid
+
+----------------------------------------------------------------
+
+constant :: Parser Constant
+constant = ipList <|> domainList <|> resultList2
+       <|> definedConstant <|> yesOrNo
+
+definedConstant :: Parser Constant
+definedConstant = identifier >>= resolve
+  where
+    resolve cst = do
+        st <- getState
+        let ent = lookup cst $ consttbl st
+        when (isNothing ent) $ unexpected $ ": No definition of '" ++ cst ++ "'"
+        let cused = cst : used st
+            cunused = delete cst $ unused st
+        setState st { used = cused, unused = cunused }
+        let cd@(typ, CV_Index n) = fromJust ent
+        if typ == DT_Res then return (typ, CV_Result (reslol st !! n))
+                         else return cd
+
+yesOrNo :: Parser Constant
+yesOrNo = do
+    b <- yesno
+    return (DT_Sig, CV_Sig b)
+  where
+    yesno :: Parser Bool
+    yesno = sym2enum noyes [minBound..maxBound]
+
+----------------------------------------------------------------
+
+op :: String -> a -> Parser a
+op str opr = do reservedOp str
+                return opr
+opAnd :: Parser (Cond -> Cond -> Cond)
+opAnd      = op "&&" (:&&)
+
+opMatch :: Parser (Variable -> Constant -> Cond)
+opMatch    = op "==" (:==)
+
+opNotMatch :: Parser (Variable -> Constant -> Cond)
+opNotMatch = op "!=" (:!=)
+
+----------------------------------------------------------------
+
+ip4range :: Parser IPRange
+ip4range = IPv4Range . read <$> many1 (oneOf $ ['0'..'9'] ++ "./")
+ip6range :: Parser IPRange
+ip6range = IPv6Range . read <$> many1 (oneOf $ ['0'..'9'] ++ ['a'..'f']  ++ ['A'..'F'] ++ ".:/")
+
+ipList :: Parser Constant
+ipList = do
+    ips <- commaSep1 (try(lexeme ip4range) <|> lexeme ip6range)
+    n <- index ips
+    return (DT_IP, CV_Index n)
+  where
+    index ips = do
+        st <- getState
+        let n = ipcnt st
+        setState st {
+            iplol = ips : iplol st
+          , ipcnt = n + 1
+          }
+        return n
+
+----------------------------------------------------------------
+
+domain :: Parser Domain
+domain = (char '"' >> many1 (noneOf "\"")) <* symbol "\""
+
+domainList :: Parser Constant
+domainList = do
+    dms <- commaSep1 (lexeme domain)
+    n <- index dms
+    return (DT_Dom, CV_Index n)
+  where
+    index dms = do
+        st <- getState
+        let n = domcnt st
+        setState st {
+            domlol = dms : domlol st
+          , domcnt = n + 1
+          }
+        return n
+
+----------------------------------------------------------------
+
+result :: Parser DAResult
+result = (char '\'' >> authResult) <* char '\''
+  where
+    authResult :: Parser DAResult
+    authResult = sym2enum resultWords [minBound..maxBound]
+
+resultList :: Parser Constant
+resultList = do
+    rs <- commaSep1 (lexeme result)
+    n <- index rs
+    return (DT_Res, CV_Index n)
+  where
+    index rs = do
+        st <- getState
+        let n = rescnt st
+        setState st {
+            reslol = rs : reslol st
+          , rescnt = n + 1
+          }
+        return n
+
+resultList2 :: Parser Constant
+resultList2 = do
+  rs <- commaSep1 (lexeme result)
+  return (DT_Res, CV_Result rs)
+
+----------------------------------------------------------------
+
+sym2enum :: [String] -> [a] -> Parser a
+sym2enum ss es = choice ps
+  where
+    func res sym = do {reserved res; return sym}
+    ps = zipWith func ss es
+
+var2enum :: [String] -> [VariableId] -> [DataType] -> Parser Variable
+var2enum ss ns ts = choice ps
+  where
+    func res nam typ = do {reserved res; return (typ,nam)}
+    ps = zipWith3 func ss ns ts
diff --git a/RPF/State.hs b/RPF/State.hs
new file mode 100644
--- /dev/null
+++ b/RPF/State.hs
@@ -0,0 +1,36 @@
+module RPF.State where
+
+import Data.IP
+import Network.DNS.Types (Domain)
+import Network.DomainAuth
+import RPF.Types
+
+type ConstName = String
+type ConstTable  = [(ConstName, Constant)]
+
+data ParserState = ParserState {
+    consttbl :: ConstTable
+  , used     :: [ConstName]
+  , unused   :: [ConstName]
+  , iplol    :: [[IPRange]]
+  , ipcnt    :: Int
+  , domlol   :: [[Domain]]
+  , domcnt   :: Int
+  , reslol   :: [[DAResult]]
+  , rescnt   :: Int
+  , blocks   :: [BlockName]
+  } deriving Show
+
+initialState :: ParserState
+initialState = ParserState {
+    consttbl = []
+  , used     = []
+  , unused   = []
+  , iplol    = []
+  , ipcnt    = 0
+  , domlol   = []
+  , domcnt   = 0
+  , reslol   = []
+  , rescnt   = 0
+  , blocks   = [minBound..maxBound]
+  }
diff --git a/RPF/Types.hs b/RPF/Types.hs
new file mode 100644
--- /dev/null
+++ b/RPF/Types.hs
@@ -0,0 +1,103 @@
+module RPF.Types where
+
+import Network.DomainAuth
+import RPF.IP
+import RPF.Domain
+
+type Pline = Int
+
+----------------------------------------------------------------
+
+data Action = A_Accept | A_Discard | A_Hold | A_Reject | A_Continue deriving (Eq, Enum, Bounded, Show)
+
+{-
+instance Show Action where
+    show act = "\"" ++ actionWords !! fromEnum act ++ "\""
+-}
+
+actionWords :: [String]
+actionWords = ["accept","discard","hold","reject","continue"]
+
+----------------------------------------------------------------
+
+data DataType = DT_Sig | DT_Res | DT_Dom | DT_IP deriving (Eq, Show)
+
+type Variable = (DataType, VariableId)
+
+data VariableId = V_SIGDKIM | V_SIGDK
+                | V_SPF | V_SID | V_DKIM | V_DK | V_ADSP
+                | V_MAILFROM | V_FROM | V_PRA | V_DKIMFROM | V_DKFROM
+                | V_IP
+                deriving (Eq, Enum, Bounded, Show)
+
+{-
+instance Show VariableId where
+    show vid = "\"" ++ variableNames !! fromEnum vid ++ "\""
+-}
+
+variableNames :: [String]
+variableNames = [ "sig_dkim", "sig_domainkeys"
+                , "spf", "sender_id", "dkim", "domainkeys", "adsp"
+                , "mail_from", "from", "pra", "dkim_from", "domainkeys_from"
+                , "ip"
+                ]
+
+variableTypes :: [DataType]
+variableTypes = [ DT_Sig, DT_Sig
+                , DT_Res, DT_Res, DT_Res, DT_Res, DT_Res
+                , DT_Dom, DT_Dom, DT_Dom, DT_Dom, DT_Dom
+                , DT_IP
+                ]
+
+varSanity :: [(BlockName, [VariableId])]
+varSanity = [(B_Connect,  [V_IP]),
+             (B_MailFrom, [V_IP, V_MAILFROM, V_SPF]),
+             (B_Header,   [V_IP, V_MAILFROM, V_SPF, V_FROM, V_PRA, V_SID, V_DKIMFROM, V_DKFROM, V_SIGDKIM, V_SIGDK]),
+             (B_Body,     [V_IP, V_MAILFROM, V_SPF, V_FROM, V_PRA, V_SID, V_DKIMFROM, V_DKFROM, V_SIGDKIM, V_SIGDK, V_DKIM, V_DK, V_ADSP])]
+
+resultSanity :: [(VariableId, [DAResult])]
+resultSanity =  [(V_SPF,  [DANone, DANeutral, DAPass, DAPolicy, DAHardFail, DASoftFail, DATempError, DAPermError]),
+                 (V_SID,  [DANone, DANeutral, DAPass, DAPolicy, DAHardFail, DASoftFail, DATempError, DAPermError]),
+                 (V_DKIM, [DANone, DAPass, DAFail, DAPolicy, DANeutral, DATempError, DAPermError]),
+                 (V_DK,   [DANone, DAPass, DAFail, DAPolicy, DANeutral, DATempError, DAPermError]),
+                 (V_ADSP, [DANone, DAPass, DAUnknown, DAFail, DADiscard, DANxDomain, DATempError, DAPermError])]
+
+
+----------------------------------------------------------------
+
+resultWords :: [String]
+resultWords = [
+    "pass", "hardfail", "softfail", "neutral"
+  , "fail", "temperror", "permerror", "none"
+  , "policy", "nxdomain", "discard", "unknown"
+  ]
+
+----------------------------------------------------------------
+
+data BlockName = B_Connect | B_MailFrom | B_Header | B_Body deriving (Eq, Enum, Bounded, Show)
+
+blockNames :: [String]
+blockNames = ["connect", "mail_from", "header", "body"]
+
+{-
+instance Show BlockName where
+    show blknm = "\"" ++ blockNames !! fromEnum blknm ++ "\""
+-}
+
+----------------------------------------------------------------
+
+noyes :: [String]
+noyes = ["No", "Yes"]
+
+----------------------------------------------------------------
+
+type Constant = (DataType, ConstantValue)
+data ConstantValue = CV_Index Int | CV_Result [DAResult] | CV_Sig Bool
+                     deriving (Eq, Show)
+
+----------------------------------------------------------------
+
+data Policy = Policy [Block] [IPTable] [DomainTable] deriving (Eq, Show)
+data Block = Block BlockName [ActionCond] deriving (Eq, Show)
+data ActionCond = ActionCond Pline (Maybe Cond) Action deriving (Eq, Show)
+data Cond = Variable :== Constant | Variable :!= Constant | Cond :&& Cond deriving (Eq, Show)
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/Test.hs b/Test.hs
new file mode 100644
--- /dev/null
+++ b/Test.hs
@@ -0,0 +1,44 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Test where
+
+import Control.Applicative
+import Data.Map as M
+import Data.IP
+import Data.IP.RouteTable as T
+import Network.DomainAuth
+import RPF.Parser
+import RPF.Types
+import RPF.IP
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit
+import Test.HUnit hiding (Test)
+
+tests :: [Test]
+tests = [
+    testGroup "Policy" [
+         testCase "policy1" test_policy1
+--       , testCase "policy2" test_policy2
+       ]
+  ]
+
+----------------------------------------------------------------
+
+test_policy1 :: Assertion
+test_policy1 = do
+    plcy <- parsePolicy <$> readFile "config/rpf.policy"
+    plcy @?= res
+  where
+    res = Policy [
+        Block B_Connect [ActionCond 3 (Just ((DT_IP,V_IP) :== (DT_IP,CV_Index 0))) A_Accept,ActionCond 4 Nothing A_Continue]
+      , Block B_MailFrom [ActionCond 9 (Just ((DT_Res,V_SPF) :== (DT_Res,CV_Result [DAPass]))) A_Accept,ActionCond 10 Nothing A_Continue]
+      , Block B_Header [ActionCond 15 (Just ((DT_Res,V_SID) :== (DT_Res,CV_Result [DAPass]))) A_Accept,ActionCond 16 (Just (((DT_Dom,V_MAILFROM) :== (DT_Dom,CV_Index 0)) :&& ((DT_Sig,V_SIGDK) :== (DT_Sig,CV_Sig False)))) A_Reject,ActionCond 17 Nothing A_Continue]
+      , Block B_Body [ActionCond 22 (Just ((DT_Res,V_DKIM) :== (DT_Res,CV_Result [DAPass]))) A_Accept,ActionCond 23 (Just ((DT_Res,V_DK) :== (DT_Res,CV_Result [DAPass]))) A_Accept,ActionCond 24 Nothing A_Continue]
+      ]
+          [IPTable (T.fromList [(makeAddrRange (toIPv4 [127,0,0,1]) 32,True)]) T.empty]
+          [M.fromList [("yahoo.com",True)]]
+
+----------------------------------------------------------------
+
+main :: IO ()
+main = defaultMain tests
diff --git a/config/rpf.conf b/config/rpf.conf
new file mode 100644
--- /dev/null
+++ b/config/rpf.conf
@@ -0,0 +1,10 @@
+#Port: 10025
+#Address: 127.0.0.1
+#Reject_Plus_All: Yes
+#Minimum_IPv4_Mask_Length: 24
+#Minimum_IPv6_Mask_Length: 48
+#Include_Redirect_Limit: 10
+#Syslog_Facility: local4
+#Log_Level: notice
+#Logonly: No
+#Debug: No
diff --git a/config/rpf.policy b/config/rpf.policy
new file mode 100644
--- /dev/null
+++ b/config/rpf.policy
@@ -0,0 +1,25 @@
+// #ip
+connect {
+	accept: #ip == 127.0.0.1;
+	continue;
+}
+
+// #spf, #mail_from
+mail_from {
+	accept: #spf == 'pass';
+	continue;
+}
+
+// #from, #pra, #sender_id, #dkim_from, #domainkeys_from, #sig_dkim, #sig_domainkeys
+header {
+	accept: #sender_id == 'pass';
+	reject: #mail_from == "yahoo.com" && #sig_domainkeys == No;
+	continue;
+}
+
+// #dkim, #domainkeys
+body {
+	accept: #dkim == 'pass';
+	accept: #domainkeys == 'pass';
+	continue;
+}
diff --git a/rpf.cabal b/rpf.cabal
new file mode 100644
--- /dev/null
+++ b/rpf.cabal
@@ -0,0 +1,45 @@
+Name:                   rpf
+Version:                0.2.0
+Author:                 Kazu Yamamoto <kazu@iij.ad.jp>
+Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp>
+License:                BSD3
+License-File:           LICENSE
+Homepage:               http://www.mew.org/~kazu/proj/rpf/
+Synopsis:               Receiver Policy Framework
+Description:            Receiver Policy Framework (RPF) is a Milter
+                        program to change actions of e-mail receiver
+                        side according to results of the anti-spam
+                        technologies.
+Category:               Network
+Cabal-Version:          >= 1.6
+Build-Type:             Simple
+Data-Files:             rpf.conf, rpf.policy
+Data-Dir:               config
+Extra-Source-Files:     README Test.hs
+Executable rpf
+  Main-Is:              Main.hs
+  if impl(ghc >= 6.12)
+    GHC-Options:        -Wall -fno-warn-unused-do-bind
+  else
+    GHC-Options:        -Wall
+  Build-Depends:        base >= 4.0 && < 5, containers, bytestring,
+                        hdaemonize, hslogger, parsec,
+                        appar, c10k, iproute, dns, domain-auth
+  Other-Modules:        Config
+                        LogMsg
+                        Milter
+                        Milter.Base
+                        Milter.Env
+                        Milter.Log
+                        Milter.Switch
+                        Milter.Types
+                        MailSpec
+                        Parsec
+                        RPF
+                        RPF.Domain
+                        RPF.Eval
+                        RPF.IP
+                        RPF.Lexer
+                        RPF.Parser
+                        RPF.State
+                        RPF.Types