cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

smarter constructor for rule

This commit is contained in:
Arnaud Bailly 2014-10-30 22:32:18 +01:00 committed by Joey Hess
parent 90bec1e959
commit 63c92aa7fb
1 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
src/Propellor/Property/Firewall.hs
View File

@ -1,5 +1,11 @@
-- |Properties for configuring firewall (iptables) rules -- |Properties for configuring firewall (iptables) rules
module Propellor.Property.Firewall where module Propellor.Property.Firewall(
rule,
installed,
Chain(..),
Target(..),
Proto(..),
Rules(..)) where
import Data.Monoid import Data.Monoid
import Data.Char import Data.Char
@ -13,29 +19,30 @@ import qualified Propellor.Property.Network as Network
installed :: Property installed :: Property
installed = Apt.installed ["iptables"] installed = Apt.installed ["iptables"]
addRule :: Rule -> Property rule :: Chain -> Target -> Rules -> Property
addRule rule = property ("adding firewall rule: " <> show rule) addIpTable rule c t rs = property ("firewall rule: " <> show r) addIpTable
where where
r = Rule c t rs
addIpTable = liftIO $ do addIpTable = liftIO $ do
let r = toIpTable rule let args = toIpTable r
exist <- boolSystem "/sbin/iptables" (chk r) exist <- boolSystem "/sbin/iptables" (chk args)
if exist then if exist then
return NoChange return NoChange
else ifM (boolSystem "/sbin/iptables" (add r)) else ifM (boolSystem "/sbin/iptables" (add args))
( return MadeChange , return FailedChange) ( return MadeChange , return FailedChange)
add params = (Param "-A") : params add params = (Param "-A") : params
chk params = (Param "-C") : params chk params = (Param "-C") : params
toIpTable :: Rule -> [CommandParam] toIpTable :: Rule -> [CommandParam]
toIpTable rule = map Param ((show $ ruleChain rule) : toIpTable r = map Param ((show $ ruleChain r) :
(toIpTableArg (ruleRules rule)) ++ [ "-j" , show $ ruleTarget rule ]) (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ])
toIpTableArg :: Rules -> [String] toIpTableArg :: Rules -> [String]
toIpTableArg NoRule = [] toIpTableArg Everything = []
toIpTableArg (Proto proto) = ["-p", map toLower $ show proto] toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
toIpTableArg (Port port) = ["--dport", show port] toIpTableArg (Port port) = ["--dport", show port]
toIpTableArg (PortRange (f,t)) = ["--dport", show f ++ ":" ++ show t] toIpTableArg (PortRange (f,t)) = ["--dport", show f ++ ":" ++ show t]
toIpTableArg (IFace iface) = ["-i", show iface] toIpTableArg (IFace iface) = ["-i", iface]
toIpTableArg (Ctstate states) = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)] toIpTableArg (Ctstate states) = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)]
toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
@ -59,7 +66,7 @@ type Port = Int
data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
deriving (Eq,Show,Read) deriving (Eq,Show,Read)
data Rules = NoRule data Rules = Everything
| Proto Proto | Proto Proto
-- ^There is actually some order dependency between proto and port so this should be a specific -- ^There is actually some order dependency between proto and port so this should be a specific
-- data type with proto + ports -- data type with proto + ports
@ -73,7 +80,7 @@ data Rules = NoRule
infixl 0 :- infixl 0 :-
instance Monoid Rules where instance Monoid Rules where
mempty = NoRule mempty = Everything
mappend = (:-) mappend = (:-)