iptables-helpers 0.4.2 → 0.5.0
raw patch · 6 files changed
+337/−89 lines, 6 filesdep +QuickCheckdep +sybdep +utf8-stringnew-component:exe:iptables-helpers-test
Dependencies added: QuickCheck, syb, utf8-string
Files
- iptables-helpers.cabal +24/−13
- src/Iptables.hs +6/−0
- src/Iptables/Parser.hs +93/−27
- src/Iptables/Print.hs +61/−48
- src/Iptables/Types.hs +4/−1
- src/Test.hs +149/−0
iptables-helpers.cabal view
@@ -1,15 +1,16 @@-Name: iptables-helpers-Version: 0.4.2-Synopsis: Static checking of iptables rules-License: BSD3-License-file: LICENSE-Author: Evgeny Tarasov-Maintainer: etarasov.ekb@gmail.com-Category: Text-Build-type: Simple--Cabal-version: >=1.2-+Name: iptables-helpers+Version: 0.5.0+Synopsis: iptables rules parser/printer library+License: BSD3+License-file: LICENSE+Author: Evgeny Tarasov+Maintainer: etarasov.ekb@gmail.com+Category: Text+Build-type: Simple+Cabal-version: >=1.6+Source-repository head+ type: git+ location: https://github.com/etarasov/iptables-helpers.git Library Exposed-modules:@@ -23,10 +24,20 @@ parsec >= 2.1, mtl >= 1.1, safe >= 0.3,- containers >= 0.4 && < 0.6+ containers >= 0.4 && < 0.6,+ utf8-string >=0.3 && < 0.4 -- Other-modules: Hs-Source-Dirs: src Ghc-options: -Wall -fno-warn-unused-do-bind++executable iptables-helpers-test+ main-is: Test.hs+ Build-depends:+ base >= 4 && < 5,+ QuickCheck >= 2.5 && < 2.6,+ syb >= 0.3 && < 0.4+ HS-Source-Dirs: src+ ghc-options: -Wall -fno-warn-unused-do-bind
src/Iptables.hs view
@@ -227,6 +227,12 @@ let chainType' = guessNatChainType chain table in chainType == chainType' +sortIptables :: Iptables -> Iptables+sortIptables (Iptables filter nat mangle raw) = Iptables (sortFilterTable filter)+ (sortNatTable nat)+ (sortMangleTable mangle)+ raw+ sortFilterTable :: [Chain] -> [Chain] sortFilterTable table = let userChains = filter (not . isFilterBuiltinChain . cName) table
src/Iptables/Parser.hs view
@@ -7,6 +7,7 @@ import Data.Bits import Data.Set (fromList) import Data.Word+import Numeric import Safe import Text.ParserCombinators.Parsec @@ -128,14 +129,14 @@ ruleOption :: GenParser Char [Chain] RuleOption ruleOption = choice [ oProtocol, oSource, oDest, oInput, oOutput, oModule, oSrcPort, oDstPort, oState- , oPhysDevIsBridged, oUnknown]+ , oPhysDevIsBridged, oComment, oMacSource, oUnknown] where oProtocol = try $ do bool_ <- option True (char '!' >> char ' ' >> return False) try (string "-p") <|> string "--protocol" char ' ' protocol <- many1 (letter <|> char '-')- char ' '+ many $ char ' ' return $ OProtocol bool_ protocol oSource = try $ do@@ -143,7 +144,7 @@ try (string "-s") <|> try (string "--src") <|> string "--source" char ' ' address <- ipAddressParser- char ' '+ many $ char ' ' return $ OSource bool_ address oDest = try $ do@@ -151,7 +152,7 @@ try (string "-d") <|> try (string "--dst") <|> string "--destination" char ' ' address <- ipAddressParser- char ' '+ many $ char ' ' return $ ODest bool_ address oInput = try $ do@@ -159,7 +160,7 @@ try (string "-i") <|> string "--in-interface" char ' ' interf <- interfaceParser- char ' '+ many $ char ' ' return $ OInInt bool_ $ Interface interf oOutput = try $ do@@ -167,27 +168,28 @@ try (string "-o") <|> string "--out-interface" char ' ' interf <- interfaceParser- char ' '+ many $ char ' ' return $ OOutInt bool_ $ Interface interf - oModule = try $ do- try (string "-m") <|> string "--match"+ oModule = do+ try (try (string "-m") <|> string "--match") char ' ' mod_ <- many1 alphaNum- char ' '+ many $ char ' ' case mod_ of "tcp" -> return $ OModule ModTcp "udp" -> return $ OModule ModUdp "state" -> return $ OModule ModState "physdev" -> return $ OModule ModPhysDev- a -> fail $ "unknown module: " ++ a+ "comment" -> return $ OModule ModComment+ a -> return $ OModule $ ModOther a oSrcPort = try $ do bool_ <- option True (char '!' >> char ' ' >> return False) try (string "--sport") <|> string "--source-port" char ' ' port <- ipPortParser- char ' '+ many $ char ' ' return $ OSourcePort bool_ port oDstPort = try $ do@@ -195,7 +197,7 @@ try (string "--dport") <|> string "--destination-port" char ' ' port <- ipPortParser- char ' '+ many $ char ' ' return $ ODestPort bool_ port oState = try $ do@@ -210,56 +212,76 @@ parseState "UNTRACKED" = return CStUntracked parseState a = fail $ "There is no state " ++ a states <- mapM parseState statesS- char ' '+ many $ char ' ' return $ OState $ fromList states oPhysDevIsBridged = try $ do bool_ <- option True (char '!' >> char ' ' >> return False) string "--physdev-is-bridged"- char ' '+ many $ many $ char ' ' return $ OPhysDevIsBridged bool_ + oComment = do+ try (string "--comment")+ many1 $ char ' '+ comment <- commentParser+ many $ char ' '+ return $ OComment comment++ oMacSource = do+ positive <- try $ do+ bool_ <- option True (char '!' >> char ' ' >> return False)+ string "--mac-source"+ return bool_+ char ' '+ address <- macAddressParser+ many $ char ' '+ return $ OMacSource positive address+ oUnknown = try $ do bool_ <- option True (char '!' >> char ' ' >> return False) oN <- char '-' ame <- many1 (alphaNum <|> char '-') when (oN:ame == "-j") $ fail "Option list is over"- -- Option parameters - all words before next option- oParams <- fmap words $ manyTill anyChar (try $ lookAhead $ string " -")- char ' '+ -- Option parameters - all words before next option or eol+ oParams <- fmap words $ manyTill anyChar ( try (lookAhead $ string " -")+ <|> try (lookAhead $ string "\n")+ <|> try (lookAhead $ string " !")+ )+ many $ char ' ' return $ OUnknown (oN:ame) bool_ oParams ruleTarget :: GenParser Char [Chain] RuleTarget ruleTarget =- choice [rAccept, rDrop, rMasquerade, rRedirect, rReject, rSNat, rDNat, rUChain, rUnknown]+ choice [tAccept, tDrop, tMasquerade, tRedirect, tReject, tSNat, tDNat, tReturn, tUChain, tUnknown] where- rAccept = do+ tAccept = do try $ string "ACCEPT" return TAccept - rDrop = do+ tDrop = do try $ string "DROP" return TDrop - rMasquerade = do+ tMasquerade = do try $ string "MASQUERADE" ports <- option NatPortDefault (try (string " --to-ports ") >> natPortParser) rand <- option False (try (char ' ' >> string "--random") >> return True) return $ TMasquerade ports rand - rRedirect = do+ tRedirect = do try $ string "REDIRECT" ports <- option NatPortDefault (try (string " --to-ports ") >> natPortParser) rand <- option False (try (char ' ' >> string "--random") >> return True) return $ TRedirect ports rand - rReject = do+ tReject = do try $ string "REJECT" rejectWith <- option RTPortUnreachable (try (string " --reject-with ") >> rejectTypeParser) return $ TReject rejectWith - rSNat = try $ do+ tSNat = try $ do string "SNAT" char ' ' string "--to-source"@@ -269,7 +291,7 @@ persist <- option False (try (char ' ' >> string "--persistent") >> return True) return $ TSNat addr rand persist - rDNat = try $ do+ tDNat = try $ do string "DNAT" char ' ' string "--to-destination"@@ -279,14 +301,18 @@ persist <- option False (try (char ' ' >> string "--persistent") >> return True) return $ TDNat addr rand persist - rUChain = try $ do+ tReturn = do+ try $ string "RETURN"+ return TReturn++ tUChain = try $ do chainName <- chainNameParser chains_ <- getState when (not $ chainName `elem` map cName chains_) $ fail $ chainName ++ " is not name of real chain" return $ TUChain chainName - rUnknown = do+ tUnknown = do targetName <- chainNameParser opts <- option [] (char ' ' >> fmap words (many $ noneOf "\n")) return $ TUnknown targetName opts@@ -333,6 +359,33 @@ <|> try (ipPref <?> "ip address with prefix") <|> ((AddrIP <$> ipAddr) <?> "ip address") +macAddressParser :: GenParser Char st MacAddr+macAddressParser = do+ a1 <- hexDigit+ a2 <- hexDigit+ let a = fst $ head $ readHex $ a1 : a2 : []+ char ':'+ b1 <- hexDigit+ b2 <- hexDigit+ let b = fst $ head $ readHex $ b1 : b2 : []+ char ':'+ c1 <- hexDigit+ c2 <- hexDigit+ let c = fst $ head $ readHex $ c1 : c2 : []+ char ':'+ d1 <- hexDigit+ d2 <- hexDigit+ let d = fst $ head $ readHex $ d1 : d2 : []+ char ':'+ e1 <- hexDigit+ e2 <- hexDigit+ let e = fst $ head $ readHex $ e1 : e2 : []+ char ':'+ f1 <- hexDigit+ f2 <- hexDigit+ let f = fst $ head $ readHex $ f1 : f2 : []+ return $ MacAddr a b c d e f + checkPort :: Int -> GenParser Char st () checkPort a = when ( a < 0 || a > 65535) $@@ -427,3 +480,16 @@ chainNameParser :: GenParser Char st String chainNameParser = many1 (alphaNum <|> char '-' <|> char '_')++commentParser :: GenParser Char st String+commentParser =+ try ( do+ char '\''+ manyTill anyChar (try $ char '\'')+ )+ <|>+ try ( do+ char '"'+ manyTill anyChar (try $ char '"')+ )+ <|> many1 (noneOf " \n\r\t")
src/Iptables/Print.hs view
@@ -1,45 +1,44 @@ module Iptables.Print where +import Codec.Binary.UTF8.String import Data.Bits import Data.List import Data.Set (toList) import Data.Word import Iptables.Types+import Numeric+import Safe printIptables :: Iptables -> String printIptables (Iptables f n m r) =- printTable "Filter" f- ++ printTable "Nat" n- ++ printTable "Mangle" m- ++ printTable "Raw" r+ (if null f then "" else printTable "filter" f)+ ++ (if null n then "" else printTable "nat" n)+ ++ (if null m then "" else printTable "mangle" m)+ ++ (if null r then "" else printTable "raw" r) where printTable :: String -> [Chain] -> String printTable tableName chains =- "Table " ++ tableName ++ "\n" ++ unlines (map printChain chains)+ "*" ++ tableName ++ "\n"+ ++ unlines (map printChainCaption chains)+ ++ concat (map printChain chains)+ ++ "COMMIT\n" -{--printIptables (t:ts) =- let (tableName, chains) = case t of- TableFilter chs -> ("Filter",chs)- TableNat chs -> ("Nat", chs)- TableMangle chs -> ("Mangle", chs)- in "Table " ++ tableName ++ "\n" ++ (unlines $ map printChain chains)- ++ printIptables ts- -}+ printChainCaption :: Chain -> String+ printChainCaption (Chain name policy counters _) =+ ":" ++ name ++ " "+ ++ printPolicy policy ++ " "+ ++ printCounters counters -printChain :: Chain -> String-printChain (Chain name policy counters rules) =- "Chain: " ++ name- ++ " ; Policy: "- ++ printPolicy policy- ++ " counters: " ++ printCounters counters ++ "\n"- ++ unlines (map printRule $ zip rules [1 ..])+ printPolicy :: Policy -> String+ printPolicy p = case p of+ ACCEPT -> "ACCEPT"+ DROP -> "DROP"+ PUNDEFINED -> "-" -printPolicy :: Policy -> String-printPolicy ACCEPT = "ACCEPT"-printPolicy DROP = "DROP"-printPolicy PUNDEFINED = "UNDEFINED"+printChain :: Chain -> String+printChain (Chain name _ _ rules) =+ unlines (map (printRule name) rules) printCounters :: Counters -> String printCounters (Counters a b) = "[" ++ show a ++ ":" ++ show b ++ "]"@@ -49,9 +48,10 @@ unwords (map printOption ruleOpts) ++ " " ++ printTarget target -printRule :: (Rule, Int) -> String-printRule (Rule _ ruleOpts target, lineNum) =- show lineNum ++ ". "+printRule :: String -> Rule -> String+printRule chainName (Rule counters ruleOpts target) =+ printCounters counters ++ " "+ ++ "-A " ++ chainName ++ " " ++ unwords (map printOption ruleOpts) ++ " " ++ printTarget target @@ -62,31 +62,13 @@ (ODest b addr) -> unwords $ printInv b ++ ["-d"] ++ [printAddress addr] (OInInt b int) -> unwords $ printInv b ++ ["-i"] ++ [printInterface int] (OOutInt b int) -> unwords $ printInv b ++ ["-o"] ++ [printInterface int]- (OFragment b) -> undefined b (OSourcePort b p) -> unwords $ printInv b ++ ["--sport"] ++ [printPort p] (ODestPort b p) -> unwords $ printInv b ++ ["--dport"] ++ [printPort p]- (OTcpFlags b fs) -> undefined b fs- (OSyn b) -> undefined b- (OTcpOption b o) -> undefined b o- (OIcmpType b t) -> undefined b t (OModule m) -> unwords $ "-m" : [printModule m]- (OLimit b l) -> undefined b l- (OLimitBurst b) -> undefined b- (OMacSource b m) -> undefined b m- (OMark a b) -> undefined a b- (OPort b p) -> undefined b p- (OUidOwner b u) -> undefined b u- (OGidOwner b g) -> undefined b g- (OSidOwner b s) -> undefined b s+ (OMacSource b m) -> unwords $ printInv b ++ ["--mac-source"] ++ [printMacAddress m] (OState s) -> unwords $ "--state" : [printStates $ toList s]- (OTos t) -> undefined t- (OTtl t) -> undefined t- (OPhysDevIn b int) -> undefined b int- (OPhysDevOut b int) -> undefined b int- (OPhysDevIsIn b) -> undefined b- (OPhysDevIsOut b) -> undefined b (OPhysDevIsBridged b) -> unwords $ printInv b ++ ["--physdev-is-bridged"]- (OComment c) -> undefined c+ (OComment c) -> "--comment" ++ " " ++ printComment c (OUnknown oName b opts) -> unwords $ printInv b ++ [oName] ++ opts printInv :: Bool -> [String]@@ -146,6 +128,18 @@ oct4 = show $ shiftR (shiftL ip 24) 24 in oct1 ++ "." ++ oct2 ++ "." ++ oct3 ++ "." ++ oct4 +printMacAddress :: MacAddr -> String+printMacAddress (MacAddr a b c d e f) = showHex2 a $ showChar ':'+ $ showHex2 b $ showChar ':'+ $ showHex2 c $ showChar ':'+ $ showHex2 d $ showChar ':'+ $ showHex2 e $ showChar ':'+ $ showHex2 f $ ""+ where+ showHex2 :: Word8 -> ShowS+ showHex2 a = if a < 16 then showChar '0' . showHex a+ else showHex a+ printInterface :: Interface -> String printInterface (Interface str) = str @@ -214,3 +208,22 @@ RTHostProhibited -> "icmp-host-prohibited" RTAdminProhibited -> "icmp-admin-prohibited" RTTcpReset -> "tcp-reset"++-- | Iptables doesn't work correctly with russian chars.+-- It's working only if a comment is enclosed with single quotes and it doesn't include spaces.+-- Let's assume that this happens with all multibyte chars.+printComment :: String -> String+printComment com =+ let onlyOneByteChars :: String -> Bool+ onlyOneByteChars [] = True+ onlyOneByteChars (x:xs) = if length (encodeChar x) > 1 then True+ else onlyOneByteChars xs+ in+ if onlyOneByteChars com+ then "\"" ++ com ++ "\""+ else + let com' = if headMay com == Just '\'' then com+ else "'" ++ com ++ "'"+ com'' = if null (filter (== ' ') com') then com'+ else (map (\a -> if a == ' ' then '_' else a) com')+ in com''
src/Iptables/Types.hs view
@@ -89,7 +89,7 @@ | OModule Module | OLimit Bool Limit | OLimitBurst Int- | OMacSource Bool String+ | OMacSource Bool MacAddr | OMark Int Int | OPort Bool Port | OUidOwner Bool Int@@ -171,3 +171,6 @@ | NatDNatChain | NatSNatChain deriving (Show, Eq, Ord)++data MacAddr = MacAddr Word8 Word8 Word8 Word8 Word8 Word8+ deriving (Show, Eq, Ord)
+ src/Test.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE DeriveDataTypeable#-}++module Main where++import Control.Monad+import Data.Generics+import Data.List+import Iptables+import Iptables.Parser+import Iptables.Print+import Iptables.Types+import Iptables.Types.Arbitrary+import System.Console.GetOpt+import System.Environment+import System.Exit+import Test.QuickCheck hiding (Result())+import Test.QuickCheck.Property++-- GetOpt stuff --------------------------------------++data GOFlag = Version+ | Help+ | ParseFile FilePath+ | Test+ | Gen+ deriving (Eq, Ord, Show, Typeable, Data)++options = [ Option ['h'] ["help"] (NoArg Help) "Print this help message"+ , Option [] ["parse"] (ReqArg (\a -> ParseFile a) "<file>") "Parse file. Example: test --parse ./iptables-save.dat"+ , Option [] ["test"] (NoArg Test) "Run tests"+ , Option [] ["generate"] (NoArg Gen) "Generate example iptables config in iptables-save -c format"+ ]++------------------------------------------------------++main :: IO ()+main = do+ args <- getArgs+ let (opts, params, errs) = getOpt RequireOrder options args++ when (not $ null errs) $ do+ putStr $ concat $ nub errs+ exitFailure++ when (Help `elem` opts) $ do+ putStrLn "Iptables-helpers testing utility"+ putStr $ usageInfo "Usage:" options+ exitSuccess++ let getParseFile :: GOFlag -> Maybe FilePath+ getParseFile (ParseFile a) = Just a+ getParseFile _ = Nothing++ case everything mplus (mkQ Nothing getParseFile) opts of+ Just file -> do+ -- putStrLn $ "Trying to open '" ++ file ++ "' ..."+ a <- readFile file+ let b = parseIptables a+ case b of+ Left er -> do+ putStrLn "Decoding failed:"+ putStrLn $ show er+ Right res -> do+ -- putStrLn "Iptables config has been parsed:"+ putStrLn $ printIptables $ sortIptables res+ exitSuccess+ Nothing -> return ()++ when ( Gen `elem` opts) $ do+ testData <- sample' (arbitrary :: Gen Iptables)+ putStr $ printIptables $ sortIptables $ testData !! 6+ exitSuccess++ when (Test `elem` opts) $ do+ quickCheck tryToParsePrint+ exitSuccess++tryToParsePrint :: Iptables -> Result+tryToParsePrint a = case parseIptables $ printIptables $ sortIptables a of+ Left err -> MkResult (Just False) True+ (show err ++ "\n" ++ printIptables (sortIptables a))+ False False [] []+ Right res ->+ let a' = sortIptables a+ res' = sortIptables res+ in+ if a' == res' then MkResult (Just True) True "" False False [] []+ else MkResult (Just False) True+ ( printIptables a' ++ "\n" ++ printIptables res'+ ++ iptablesDiff a' res'+ )+ False False [] []++iptablesDiff :: Iptables -> Iptables -> String+iptablesDiff ip1 ip2 =+ if map cName (tFilter ip1) /= map cName (tFilter ip2)+ then+ "1: \n" ++ show (map cName $ tFilter ip1)+ ++ "\n" ++ show (map cName $ tFilter ip2)+ else ""+ ++ if map cName (tNat ip1) /= map cName (tNat ip2)+ then+ "1: \n" ++ show (map cName $ tNat ip1)+ ++ "\n" ++ show (map cName $ tNat ip2)+ else ""+ ++ if map cName (tMangle ip1) /= map cName (tMangle ip2)+ then+ "1: \n" ++ show (map cName $ tMangle ip1)+ ++ "\n" ++ show (map cName $ tMangle ip2)+ else ""+ ++ if map cName (tRaw ip1) /= map cName (tRaw ip2)+ then+ "1: \n" ++ show (map cName $ tRaw ip1)+ ++ "\n" ++ show (map cName $ tRaw ip2)+ else ""+ ++ tableDiff (tFilter ip1) (tFilter ip2)+ ++ tableDiff (tNat ip1) (tNat ip2)+ ++ tableDiff (tMangle ip1) (tMangle ip2)+ ++ tableDiff (tRaw ip1) (tRaw ip2)++tableDiff :: [Chain] -> [Chain] -> String+tableDiff [] (c:cx) = "Table 2 has more chains: " ++ show (map cName (c:cx))+tableDiff (c:cx) [] = "Table 1 has more chains: " ++ show (map cName (c:cx))+tableDiff [] [] = ""+tableDiff (c1:cx1) (c2:cx2) = chainDiff c1 c2 ++ tableDiff cx1 cx2++chainDiff :: Chain -> Chain -> String+chainDiff c1 c2 =+ if cName c1 /= cName c2+ then+ "Chains have different names: " ++ cName c1 ++ "/" ++ cName c2 ++ "\n"+ else+ if cPolicy c1 /= cPolicy c2+ then "Chains nave different policy:\n" ++ (show $ cPolicy c1) ++ "/" ++ (show $ cPolicy c2) ++ "\n"+ else ""+ ++ rulesDiff (cRules c1) (cRules c2)++rulesDiff :: [Rule] -> [Rule] -> String+rulesDiff rs1 rs2 =+ concat $ zipWith (\ r1 r2 -> + let equal = r1 == r2+ in+ if equal+ then ""+ else+ show equal ++ "\n"+ ++ show r1 ++ "\n"+ ++ show r2+ ) rs1 rs2