propellor/src/Propellor/Property/Firewall.hs

87 lines
2.6 KiB
Haskell
Raw Normal View History

2014-10-30 21:11:14 +00:00
-- |Properties for configuring firewall (iptables) rules
2014-10-31 06:55:03 +00:00
--
-- Copyright 2014 Arnaud Bailly <arnaud.oqube@gmail.com>
-- License: BSD-2-Clause
2014-10-30 21:32:18 +00:00
module Propellor.Property.Firewall(
rule,
installed,
2014-10-30 21:34:44 +00:00
Chain(..),Target(..),Proto(..),Rules(..),ConnectionState(..)) where
2014-10-30 21:11:14 +00:00
import Data.Monoid
import Data.Char
import Data.List
import Propellor
import Utility.SafeCommand
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Network as Network
installed :: Property
installed = Apt.installed ["iptables"]
2014-10-30 21:32:18 +00:00
rule :: Chain -> Target -> Rules -> Property
rule c t rs = property ("firewall rule: " <> show r) addIpTable
2014-10-30 21:11:14 +00:00
where
2014-10-30 21:32:18 +00:00
r = Rule c t rs
2014-10-30 21:11:14 +00:00
addIpTable = liftIO $ do
2014-10-30 21:32:18 +00:00
let args = toIpTable r
exist <- boolSystem "/sbin/iptables" (chk args)
2014-10-30 21:11:14 +00:00
if exist then
return NoChange
2014-10-30 21:32:18 +00:00
else ifM (boolSystem "/sbin/iptables" (add args))
2014-10-30 21:11:14 +00:00
( return MadeChange , return FailedChange)
add params = (Param "-A") : params
chk params = (Param "-C") : params
toIpTable :: Rule -> [CommandParam]
2014-10-30 21:32:18 +00:00
toIpTable r = map Param ((show $ ruleChain r) :
(toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ])
2014-10-30 21:11:14 +00:00
toIpTableArg :: Rules -> [String]
2014-10-30 21:32:18 +00:00
toIpTableArg Everything = []
2014-10-30 21:11:14 +00:00
toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
toIpTableArg (Port port) = ["--dport", show port]
toIpTableArg (PortRange (f,t)) = ["--dport", show f ++ ":" ++ show t]
2014-10-30 21:32:18 +00:00
toIpTableArg (IFace iface) = ["-i", iface]
2014-10-30 21:11:14 +00:00
toIpTableArg (Ctstate states) = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)]
toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
data Rule = Rule {
ruleChain :: Chain
,ruleTarget :: Target
,ruleRules :: Rules
} deriving (Eq, Show, Read)
data Chain = INPUT | OUTPUT | FORWARD
deriving (Eq,Show,Read)
data Target = ACCEPT | REJECT | DROP | LOG
deriving (Eq,Show,Read)
data Proto = TCP | UDP | ICMP
deriving (Eq,Show,Read)
type Port = Int
data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID
deriving (Eq,Show,Read)
2014-10-30 21:32:18 +00:00
data Rules = Everything
2014-10-30 21:11:14 +00:00
| Proto Proto
-- ^There is actually some order dependency between proto and port so this should be a specific
-- data type with proto + ports
| Port Port
| PortRange (Port,Port)
| IFace Network.Interface
| Ctstate [ ConnectionState ]
| Rules :- Rules -- ^Combine two rules
deriving (Eq,Show,Read)
infixl 0 :-
instance Monoid Rules where
2014-10-30 21:32:18 +00:00
mempty = Everything
2014-10-30 21:11:14 +00:00
mappend = (:-)