summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Firewall.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Propellor/Property/Firewall.hs')
-rw-r--r--src/Propellor/Property/Firewall.hs115
1 files changed, 102 insertions, 13 deletions
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index 20b44845..eefc8342 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -1,15 +1,22 @@
-- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>
---
+--
-- Properties for configuring firewall (iptables) rules
module Propellor.Property.Firewall (
rule,
installed,
Chain(..),
- Target(..),
+ Table(..),
+ TargetFilter(..),
+ TargetNat(..),
+ TargetMangle(..),
+ TargetRaw(..),
+ TargetSecurity(..),
Proto(..),
Rules(..),
- ConnectionState(..)
+ ConnectionState(..),
+ IPWithMask(..),
+ fromIPWithMask
) where
import Data.Monoid
@@ -23,7 +30,7 @@ import qualified Propellor.Property.Network as Network
installed :: Property NoInfo
installed = Apt.installed ["iptables"]
-rule :: Chain -> Target -> Rules -> Property NoInfo
+rule :: Chain -> Table -> Rules -> Property NoInfo
rule c t rs = property ("firewall rule: " <> show r) addIpTable
where
r = Rule c t rs
@@ -33,13 +40,13 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable
if exist
then return NoChange
else toResult <$> boolSystem "iptables" (add args)
- add params = (Param "-A") : params
- chk params = (Param "-C") : params
+ add params = Param "-A" : params
+ chk params = Param "-C" : params
toIpTable :: Rule -> [CommandParam]
toIpTable r = map Param $
- (show $ ruleChain r) :
- (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ]
+ show (ruleChain r) :
+ toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r)
toIpTableArg :: Rules -> [String]
toIpTableArg Everything = []
@@ -47,26 +54,105 @@ toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
toIpTableArg (DPort (Port port)) = ["--dport", show port]
toIpTableArg (DPortRange (Port f, Port t)) =
["--dport", show f ++ ":" ++ show t]
-toIpTableArg (IFace iface) = ["-i", iface]
+toIpTableArg (InIFace iface) = ["-i", iface]
+toIpTableArg (OutIFace iface) = ["-o", iface]
toIpTableArg (Ctstate states) =
[ "-m"
, "conntrack"
- , "--ctstate", concat $ intersperse "," (map show states)
+ , "--ctstate", intercalate "," (map show states)
+ ]
+toIpTableArg (Source ipwm) =
+ [ "-s"
+ , intercalate "," (map fromIPWithMask ipwm)
+ ]
+toIpTableArg (Destination ipwm) =
+ [ "-d"
+ , intercalate "," (map fromIPWithMask ipwm)
]
toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
+data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
+ deriving (Eq, Show)
+
+fromIPWithMask :: IPWithMask -> String
+fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip
+fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm
+fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m
+
data Rule = Rule
{ ruleChain :: Chain
- , ruleTarget :: Target
+ , ruleTable :: Table
, ruleRules :: Rules
} deriving (Eq, Show)
+data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity
+ deriving (Eq, Show)
+
+toIpTableTable :: Table -> [String]
+toIpTableTable f = ["-t", table, "-j", target]
+ where
+ (table, target) = toIpTableTable' f
+
+toIpTableTable' :: Table -> (String, String)
+toIpTableTable' (Filter target) = ("filter", fromTarget target)
+toIpTableTable' (Nat target) = ("nat", fromTarget target)
+toIpTableTable' (Mangle target) = ("mangle", fromTarget target)
+toIpTableTable' (Raw target) = ("raw", fromTarget target)
+toIpTableTable' (Security target) = ("security", fromTarget target)
+
data Chain = INPUT | OUTPUT | FORWARD
deriving (Eq, Show)
-data Target = ACCEPT | REJECT | DROP | LOG
+data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String
+ deriving (Eq, Show)
+
+class FromTarget a where
+ fromTarget :: a -> String
+
+instance FromTarget TargetFilter where
+ fromTarget ACCEPT = "ACCEPT"
+ fromTarget REJECT = "REJECT"
+ fromTarget DROP = "DROP"
+ fromTarget LOG = "LOG"
+ fromTarget (FilterCustom f) = f
+
+data TargetNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String
+ deriving (Eq, Show)
+
+instance FromTarget TargetNat where
+ fromTarget NatPREROUTING = "PREROUTING"
+ fromTarget NatOUTPUT = "OUTPUT"
+ fromTarget NatPOSTROUTING = "POSTROUTING"
+ fromTarget (NatCustom f) = f
+
+data TargetMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String
+ deriving (Eq, Show)
+
+instance FromTarget TargetMangle where
+ fromTarget ManglePREROUTING = "PREROUTING"
+ fromTarget MangleOUTPUT = "OUTPUT"
+ fromTarget MangleINPUT = "INPUT"
+ fromTarget MangleFORWARD = "FORWARD"
+ fromTarget ManglePOSTROUTING = "POSTROUTING"
+ fromTarget (MangleCustom f) = f
+
+data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String
+ deriving (Eq, Show)
+
+instance FromTarget TargetRaw where
+ fromTarget RawPREROUTING = "PREROUTING"
+ fromTarget RawOUTPUT = "OUTPUT"
+ fromTarget (RawCustom f) = f
+
+data TargetSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String
deriving (Eq, Show)
+instance FromTarget TargetSecurity where
+ fromTarget SecurityINPUT = "INPUT"
+ fromTarget SecurityOUTPUT = "OUTPUT"
+ fromTarget SecurityFORWARD = "FORWARD"
+ fromTarget (SecurityCustom f) = f
+
data Proto = TCP | UDP | ICMP
deriving (Eq, Show)
@@ -80,8 +166,11 @@ data Rules
-- data type with proto + ports
| DPort Port
| DPortRange (Port,Port)
- | IFace Network.Interface
+ | InIFace Network.Interface
+ | OutIFace Network.Interface
| Ctstate [ ConnectionState ]
+ | Source [ IPWithMask ]
+ | Destination [ IPWithMask ]
| Rules :- Rules -- ^Combine two rules
deriving (Eq, Show)