summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Firewall.hs
diff options
context:
space:
mode:
authorArnaud Bailly2014-10-30 22:32:18 +0100
committerJoey Hess2014-10-31 10:15:10 -0400
commit63c92aa7fb2de41b6f0e56bfdd7c6aef61bcbeda (patch)
treea4d8b93c5246772f37c804b94070b49b042bbc70 /src/Propellor/Property/Firewall.hs
parent90bec1e9593c7d0f99204d6a6ef8682672018ccb (diff)
smarter constructor for rule
Diffstat (limited to 'src/Propellor/Property/Firewall.hs')
-rw-r--r--src/Propellor/Property/Firewall.hs31
1 files changed, 19 insertions, 12 deletions
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index 1e8eb815..55bd4e89 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -1,5 +1,11 @@
-- |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.Char
@@ -13,29 +19,30 @@ import qualified Propellor.Property.Network as Network
installed :: Property
installed = Apt.installed ["iptables"]
-addRule :: Rule -> Property
-addRule rule = property ("adding firewall rule: " <> show rule) addIpTable
+rule :: Chain -> Target -> Rules -> Property
+rule c t rs = property ("firewall rule: " <> show r) addIpTable
where
+ r = Rule c t rs
addIpTable = liftIO $ do
- let r = toIpTable rule
- exist <- boolSystem "/sbin/iptables" (chk r)
+ let args = toIpTable r
+ exist <- boolSystem "/sbin/iptables" (chk args)
if exist then
return NoChange
- else ifM (boolSystem "/sbin/iptables" (add r))
+ else ifM (boolSystem "/sbin/iptables" (add args))
( return MadeChange , return FailedChange)
add params = (Param "-A") : params
chk params = (Param "-C") : params
toIpTable :: Rule -> [CommandParam]
-toIpTable rule = map Param ((show $ ruleChain rule) :
- (toIpTableArg (ruleRules rule)) ++ [ "-j" , show $ ruleTarget rule ])
+toIpTable r = map Param ((show $ ruleChain r) :
+ (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ])
toIpTableArg :: Rules -> [String]
-toIpTableArg NoRule = []
+toIpTableArg Everything = []
toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
toIpTableArg (Port port) = ["--dport", show port]
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 (r :- r') = toIpTableArg r <> toIpTableArg r'
@@ -59,7 +66,7 @@ type Port = Int
data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
deriving (Eq,Show,Read)
-data Rules = NoRule
+data Rules = Everything
| Proto Proto
-- ^There is actually some order dependency between proto and port so this should be a specific
-- data type with proto + ports
@@ -73,7 +80,7 @@ data Rules = NoRule
infixl 0 :-
instance Monoid Rules where
- mempty = NoRule
+ mempty = Everything
mappend = (:-)