rpf 0.2.4 → 0.2.5

raw patch · 6 files changed

+41/−40 lines, 6 files

Files

• Main.hs +4/−4
• Milter/Base.hs +2/−5
• Milter/Switch.hs +5/−4
• RPF/Parser.hs +4/−4
• Test.hs +11/−18
• rpf.cabal +15/−5

@@ -120,17 +120,17 @@  daemonize :: IO () -> IO () daemonize program = ensureDetachTerminalCanWork $ do-    detachTerminal+    void detachTerminal     ensureNeverAttachTerminal $ do         changeWorkingDirectory "/"-        setFileCreationMask 0+        void $ setFileCreationMask 0         mapM_ closeFd [stdInput, stdOutput, stdError]         program   where     ensureDetachTerminalCanWork p = do-        forkProcess p+        void $ forkProcess p         exitImmediately ExitSuccess     ensureNeverAttachTerminal p = do-        forkProcess p+        void $ forkProcess p         exitImmediately ExitSuccess     detachTerminal = createSession

@@ -51,7 +51,7 @@ putPacket :: Handle -> Packet -> IO () putPacket hdl (Packet c bs) = do     let len = BS.length bs + 1-        pkt = intToFourBytes len +++ fromChar c +++ fromByteString bs+        pkt = intToFourBytes len <> fromChar c <> fromByteString bs     BS.hPut hdl $ toByteString pkt  safePutPacket :: Handle -> Packet -> IO ()@@ -93,7 +93,7 @@ negotiate hdl =  putPacket hdl negoPkt -- do NOT use safePutPacket  negoPkt :: Packet-negoPkt = Packet 'O' $ toByteString $ ver +++ act +++ pro+negoPkt = Packet 'O' $ toByteString $ ver <> act <> pro   where     ver = intToFourBytes 2 -- Sendmail 8.13.8, sigh     act = intToFourBytes 0@@ -129,6 +129,3 @@     (q3,r3) = q2 `divMod` 256     r4 = q3 `mod` 256 -}--(+++) :: Builder -> Builder -> Builder-(+++) = mappend

@@ -3,6 +3,7 @@ module Milter.Switch (milter) where  import Control.Applicative+import Control.Exception import Control.Monad (unless) import Data.ByteString.Char8 (ByteString) import Data.IORef@@ -19,16 +20,16 @@  milter :: Env -> Handle -> IORef State -> IO () milter env hdl ref = withValidHandleDo $-    flip catch errorHandle $ do+    handle 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+    errorHandle (SomeException e) = logDebug env ref $ show e+    withValidHandleDo blk = do         closed <- hIsClosed hdl         eof <- hIsEOF hdl-        unless (eof || closed) block+        unless (eof || closed) blk  switch :: Env -> Handle -> IORef State -> Packet -> IO () switch env hdl ref (Packet 'O' bs) = open env hdl ref bs

@@ -53,7 +53,7 @@     cst <- identifier -- $foo     reservedOp "="     dat <- ipList <|> domainList <|> resultList-    semi+    void semi     define cst dat     return ()   where@@ -95,13 +95,13 @@     let l = sourceLine pos     act <- action     cnd <- option Nothing condition-    semi+    void semi     return $ ActionCond l cnd act   where     action :: Parser Action     action = sym2enum actionWords [minBound..maxBound]     condition = do-        colon+        void colon         cnd <- cond         return $ Just cnd @@ -114,7 +114,7 @@  term :: Parser Cond term = do-    char '#'+    void $ char '#'     var@(vtyp,vid) <- variable     checkVar vid     opr <- opMatch <|> opNotMatch

@@ -1,31 +1,28 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}  module Test where  import Control.Applicative-import Data.Map as M import Data.IP import Data.IP.RouteTable as T+import Data.Map as M import Network.DomainAuth+import RPF.IP 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)+import Test.Framework.TH.Prime+import Test.HUnit -tests :: [Test]-tests = [-    testGroup "Policy" [-         testCase "policy1" test_policy1---       , testCase "policy2" test_policy2-       ]-  ]+---------------------------------------------------------------- +main :: IO ()+main = $(defaultMainGenerator)+ ---------------------------------------------------------------- -test_policy1 :: Assertion-test_policy1 = do+case_policy1 :: Assertion+case_policy1 = do     plcy <- parsePolicy <$> readFile "config/rpf.policy"     plcy @?= res   where@@ -38,7 +35,3 @@           [IPTable (T.fromList [(makeAddrRange (toIPv4 [127,0,0,1]) 32,True)]) T.empty]           [M.fromList [("yahoo.com",True)]] -------------------------------------------------------------------main :: IO ()-main = defaultMain tests

@@ -1,5 +1,5 @@ Name:                   rpf-Version:                0.2.4+Version:                0.2.5 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -16,12 +16,22 @@ Data-Files:             rpf.conf, rpf.policy Data-Dir:               config Extra-Source-Files:     README Test.hs+ Executable rpf   Main-Is:              Main.hs-  GHC-Options:          -Wall -fno-warn-unused-do-bind -threaded-  Build-Depends:        base >= 4.0 && < 5, containers, bytestring,-                        hslogger, parsec, unix, blaze-builder,-                        appar, c10k, iproute, dns, domain-auth+  GHC-Options:          -Wall -threaded+  Build-Depends:        base >= 4.0 && < 5+                      , appar+                      , blaze-builder+                      , bytestring+                      , c10k+                      , containers+                      , dns+                      , domain-auth+                      , hslogger+                      , iproute+                      , parsec+                      , unix   Other-Modules:        Config                         LogMsg                         Milter