summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Firewall.hs
blob: 55bd4e89634dc20b33a3ac701d7ddff805c37ca9 (plain)
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 = (:-)