1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
-- |Properties for configuring firewall (iptables) rules
module Propellor.Property.Firewall(
rule,
installed,
Chain(..),
Target(..),
Proto(..),
Rules(..)) where
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"]
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 args = toIpTable r
exist <- boolSystem "/sbin/iptables" (chk args)
if exist then
return NoChange
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 r = map Param ((show $ ruleChain r) :
(toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ])
toIpTableArg :: Rules -> [String]
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", iface]
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)
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
| 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
mempty = Everything
mappend = (:-)
|
