module Propellor.Property.Firewall (
rule,
installed,
Chain(..),
Table(..),
Target(..),
Proto(..),
Rules(..),
ConnectionState(..),
ICMPTypeMatch(..),
TCPFlag(..),
Frequency(..),
IPWithMask(..),
) where
import Data.Monoid
import Data.Char
import Data.List
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Network as Network
installed :: Property DebianLike
installed = Apt.installed ["iptables"]
rule :: Chain -> Table -> Target -> Rules -> Property Linux
rule c tb tg rs = property ("firewall rule: " <> show r) addIpTable
where
r = Rule c tb tg rs
addIpTable = liftIO $ do
let args = toIpTable r
exist <- boolSystem "iptables" (chk args)
if exist
then return NoChange
else toResult <$> boolSystem "iptables" (add args)
add params = Param "-A" : params
chk params = Param "-C" : params
toIpTable :: Rule -> [CommandParam]
toIpTable r = map Param $
val (ruleChain r) :
toIpTableArg (ruleRules r) ++
["-t", val (ruleTable r), "-j", val (ruleTarget r)]
toIpTableArg :: Rules -> [String]
toIpTableArg Everything = []
toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
toIpTableArg (DPort port) = ["--dport", val port]
toIpTableArg (DPortRange (portf, portt)) =
["--dport", val portf ++ ":" ++ val portt]
toIpTableArg (InIFace iface) = ["-i", iface]
toIpTableArg (OutIFace iface) = ["-o", iface]
toIpTableArg (Ctstate states) =
[ "-m"
, "conntrack"
, "--ctstate", intercalate "," (map show states)
]
toIpTableArg (ICMPType i) =
[ "-m"
, "icmp"
, "--icmp-type", val i
]
toIpTableArg (RateLimit f) =
[ "-m"
, "limit"
, "--limit", val f
]
toIpTableArg (TCPFlags m c) =
[ "-m"
, "tcp"
, "--tcp-flags"
, intercalate "," (map show m)
, intercalate "," (map show c)
]
toIpTableArg TCPSyn = ["--syn"]
toIpTableArg (GroupOwner (Group g)) =
[ "-m"
, "owner"
, "--gid-owner"
, g
]
toIpTableArg (Source ipwm) =
[ "-s"
, intercalate "," (map val ipwm)
]
toIpTableArg (Destination ipwm) =
[ "-d"
, intercalate "," (map val ipwm)
]
toIpTableArg (NotDestination ipwm) =
[ "!"
, "-d"
, intercalate "," (map val ipwm)
]
toIpTableArg (NatDestination ip mport) =
[ "--to-destination"
, val ip ++ maybe "" (\p -> ":" ++ val p) mport
]
toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
deriving (Eq, Show)
instance ConfigurableValue IPWithMask where
val (IPWithNoMask ip) = val ip
val (IPWithIPMask ip ipm) = val ip ++ "/" ++ val ipm
val (IPWithNumMask ip m) = val ip ++ "/" ++ val m
data Rule = Rule
{ ruleChain :: Chain
, ruleTable :: Table
, ruleTarget :: Target
, ruleRules :: Rules
} deriving (Eq, Show)
data Table = Filter | Nat | Mangle | Raw | Security
deriving (Eq, Show)
instance ConfigurableValue Table where
val Filter = "filter"
val Nat = "nat"
val Mangle = "mangle"
val Raw = "raw"
val Security = "security"
data Target = ACCEPT | REJECT | DROP | LOG | TargetCustom String
deriving (Eq, Show)
instance ConfigurableValue Target where
val ACCEPT = "ACCEPT"
val REJECT = "REJECT"
val DROP = "DROP"
val LOG = "LOG"
val (TargetCustom t) = t
data Chain = INPUT | OUTPUT | FORWARD | PREROUTING | POSTROUTING | ChainCustom String
deriving (Eq, Show)
instance ConfigurableValue Chain where
val INPUT = "INPUT"
val OUTPUT = "OUTPUT"
val FORWARD = "FORWARD"
val PREROUTING = "PREROUTING"
val POSTROUTING = "POSTROUTING"
val (ChainCustom c) = c
data Proto = TCP | UDP | ICMP
deriving (Eq, Show)
data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
deriving (Eq, Show)
data ICMPTypeMatch = ICMPTypeName String | ICMPTypeCode Int
deriving (Eq, Show)
instance ConfigurableValue ICMPTypeMatch where
val (ICMPTypeName t) = t
val (ICMPTypeCode c) = val c
data Frequency = NumBySecond Int
deriving (Eq, Show)
instance ConfigurableValue Frequency where
val (NumBySecond n) = val n ++ "/second"
type TCPFlagMask = [TCPFlag]
type TCPFlagComp = [TCPFlag]
data TCPFlag = SYN | ACK | FIN | RST | URG | PSH | ALL | NONE
deriving (Eq, Show)
data Rules
= Everything
| Proto Proto
| DPort Port
| DPortRange (Port, Port)
| InIFace Network.Interface
| OutIFace Network.Interface
| Ctstate [ ConnectionState ]
| ICMPType ICMPTypeMatch
| RateLimit Frequency
| TCPFlags TCPFlagMask TCPFlagComp
| TCPSyn
| GroupOwner Group
| Source [ IPWithMask ]
| Destination [ IPWithMask ]
| NotDestination [ IPWithMask ]
| NatDestination IPAddr (Maybe Port)
| Rules :- Rules
deriving (Eq, Show)
infixl 0 :-
instance Monoid Rules where
mempty = Everything
mappend = (:-)