diff --git a/iptables-helpers.cabal b/iptables-helpers.cabal --- a/iptables-helpers.cabal +++ b/iptables-helpers.cabal @@ -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 diff --git a/src/Iptables.hs b/src/Iptables.hs --- a/src/Iptables.hs +++ b/src/Iptables.hs @@ -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 diff --git a/src/Iptables/Parser.hs b/src/Iptables/Parser.hs --- a/src/Iptables/Parser.hs +++ b/src/Iptables/Parser.hs @@ -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") diff --git a/src/Iptables/Print.hs b/src/Iptables/Print.hs --- a/src/Iptables/Print.hs +++ b/src/Iptables/Print.hs @@ -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'' diff --git a/src/Iptables/Types.hs b/src/Iptables/Types.hs --- a/src/Iptables/Types.hs +++ b/src/Iptables/Types.hs @@ -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) diff --git a/src/Test.hs b/src/Test.hs new file mode 100644 --- /dev/null +++ b/src/Test.hs @@ -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) "") "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