From a6e712a6457638a3ea8c653357d06fd4fbb3d5f3 Mon Sep 17 00:00:00 2001 From: FĂ©lix Sipma Date: Thu, 30 Oct 2014 21:10:23 +0100 Subject: basic nginx support --- src/Propellor/Property/Nginx.hs | 47 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 47 insertions(+) create mode 100644 src/Propellor/Property/Nginx.hs (limited to 'src') diff --git a/src/Propellor/Property/Nginx.hs b/src/Propellor/Property/Nginx.hs new file mode 100644 index 00000000..97792fcc --- /dev/null +++ b/src/Propellor/Property/Nginx.hs @@ -0,0 +1,47 @@ +module Propellor.Property.Nginx where + +import Propellor +import qualified Propellor.Property.File as File +import qualified Propellor.Property.Apt as Apt +import qualified Propellor.Property.Service as Service + +type ConfigFile = [String] + +siteEnabled :: HostName -> ConfigFile -> RevertableProperty +siteEnabled hn cf = RevertableProperty enable disable + where + enable = trivial (cmdProperty "ln" ["-s", siteValRelativeCfg hn, siteVal hn]) + `describe` ("nginx site enabled " ++ hn) + `requires` siteAvailable hn cf + `requires` installed + `onChange` reloaded + disable = trivial $ + ("nginx site disabled " ++ hn) ==> + File.notPresent (siteCfg hn) + `onChange` cmdProperty "rm" [siteVal hn] + `requires` installed + `onChange` reloaded + +siteAvailable :: HostName -> ConfigFile -> Property +siteAvailable hn cf = ("nginx site available " ++ hn) ==> + siteCfg hn `File.hasContent` (comment : cf) + where + comment = "# deployed with propellor, do not modify" + +siteCfg :: HostName -> FilePath +siteCfg hn = "/etc/nginx/sites-available/" ++ hn + +siteVal :: HostName -> FilePath +siteVal hn = "/etc/nginx/sites-enabled/" ++ hn + +siteValRelativeCfg :: HostName -> FilePath +siteValRelativeCfg hn = "../sites-available/" ++ hn + +installed :: Property +installed = Apt.installed ["nginx"] + +restarted :: Property +restarted = Service.restarted "nginx" + +reloaded :: Property +reloaded = Service.reloaded "nginx" -- cgit v1.2.3 From 90bec1e9593c7d0f99204d6a6ef8682672018ccb Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Thu, 30 Oct 2014 22:11:14 +0100 Subject: added firewall properties --- propellor.cabal | 1 + src/Propellor/Property/Firewall.hs | 79 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 80 insertions(+) create mode 100644 src/Propellor/Property/Firewall.hs (limited to 'src') diff --git a/propellor.cabal b/propellor.cabal index c63bed37..43f098a8 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -78,6 +78,7 @@ Library Propellor.Property.Dns Propellor.Property.Docker Propellor.Property.File + Propellor.Property.Firewall Propellor.Property.Git Propellor.Property.Gpg Propellor.Property.Grub diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs new file mode 100644 index 00000000..1e8eb815 --- /dev/null +++ b/src/Propellor/Property/Firewall.hs @@ -0,0 +1,79 @@ +-- |Properties for configuring firewall (iptables) rules +module Propellor.Property.Firewall 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"] + +addRule :: Rule -> Property +addRule rule = property ("adding firewall rule: " <> show rule) addIpTable + where + addIpTable = liftIO $ do + let r = toIpTable rule + exist <- boolSystem "/sbin/iptables" (chk r) + if exist then + return NoChange + else ifM (boolSystem "/sbin/iptables" (add r)) + ( return MadeChange , return FailedChange) + add params = (Param "-A") : params + chk params = (Param "-C") : params + +toIpTable :: Rule -> [CommandParam] +toIpTable rule = map Param ((show $ ruleChain rule) : + (toIpTableArg (ruleRules rule)) ++ [ "-j" , show $ ruleTarget rule ]) + +toIpTableArg :: Rules -> [String] +toIpTableArg NoRule = [] +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", show 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 = NoRule + | 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 = NoRule + mappend = (:-) + + -- cgit v1.2.3 From 63c92aa7fb2de41b6f0e56bfdd7c6aef61bcbeda Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Thu, 30 Oct 2014 22:32:18 +0100 Subject: smarter constructor for rule --- src/Propellor/Property/Firewall.hs | 31 +++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index 1e8eb815..55bd4e89 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -1,5 +1,11 @@ -- |Properties for configuring firewall (iptables) rules -module Propellor.Property.Firewall where +module Propellor.Property.Firewall( + rule, + installed, + Chain(..), + Target(..), + Proto(..), + Rules(..)) where import Data.Monoid import Data.Char @@ -13,29 +19,30 @@ import qualified Propellor.Property.Network as Network installed :: Property installed = Apt.installed ["iptables"] -addRule :: Rule -> Property -addRule rule = property ("adding firewall rule: " <> show rule) addIpTable +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 r = toIpTable rule - exist <- boolSystem "/sbin/iptables" (chk r) + let args = toIpTable r + exist <- boolSystem "/sbin/iptables" (chk args) if exist then return NoChange - else ifM (boolSystem "/sbin/iptables" (add r)) + 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 rule = map Param ((show $ ruleChain rule) : - (toIpTableArg (ruleRules rule)) ++ [ "-j" , show $ ruleTarget rule ]) +toIpTable r = map Param ((show $ ruleChain r) : + (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ]) toIpTableArg :: Rules -> [String] -toIpTableArg NoRule = [] +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", show iface] +toIpTableArg (IFace iface) = ["-i", iface] toIpTableArg (Ctstate states) = ["-m", "conntrack","--ctstate", concat $ intersperse "," (map show states)] toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r' @@ -59,7 +66,7 @@ type Port = Int data ConnectionState = ESTABLISHED | RELATED | NEW | INVALID deriving (Eq,Show,Read) -data Rules = NoRule +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 @@ -73,7 +80,7 @@ data Rules = NoRule infixl 0 :- instance Monoid Rules where - mempty = NoRule + mempty = Everything mappend = (:-) -- cgit v1.2.3 From 4ce5e26ec87061b76c77857b81012d404eb5b35a Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Thu, 30 Oct 2014 22:34:44 +0100 Subject: missing export --- src/Propellor/Property/Firewall.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index 55bd4e89..b598865f 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -2,10 +2,7 @@ module Propellor.Property.Firewall( rule, installed, - Chain(..), - Target(..), - Proto(..), - Rules(..)) where + Chain(..),Target(..),Proto(..),Rules(..),ConnectionState(..)) where import Data.Monoid import Data.Char -- cgit v1.2.3 From 63560cde90691dbd51d1bdf0b484d0ff0bc9a763 Mon Sep 17 00:00:00 2001 From: Arnaud Bailly Date: Fri, 31 Oct 2014 07:55:03 +0100 Subject: added licensing header --- src/Propellor/Property/Firewall.hs | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index b598865f..68e9e9f8 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -1,4 +1,7 @@ -- |Properties for configuring firewall (iptables) rules +-- +-- Copyright 2014 Arnaud Bailly +-- License: BSD-2-Clause module Propellor.Property.Firewall( rule, installed, -- cgit v1.2.3 From 3a1f058c64dd073e6326f8a8f1755e6892ab127a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 31 Oct 2014 10:20:34 -0400 Subject: changed indentation for consistency with the rest of propellor --- src/Propellor/Property/Firewall.hs | 87 ++++++++++++++++++++------------------ 1 file changed, 46 insertions(+), 41 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index 68e9e9f8..e1570175 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -2,10 +2,15 @@ -- -- Copyright 2014 Arnaud Bailly -- License: BSD-2-Clause -module Propellor.Property.Firewall( - rule, - installed, - Chain(..),Target(..),Proto(..),Rules(..),ConnectionState(..)) where +module Propellor.Property.Firewall ( + rule, + installed, + Chain(..), + Target(..), + Proto(..), + Rules(..), + ConnectionState(..) +) where import Data.Monoid import Data.Char @@ -22,20 +27,21 @@ 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 + 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 ]) +toIpTable r = map Param $ + (show $ ruleChain r) : + (toIpTableArg (ruleRules r)) ++ [ "-j" , show $ ruleTarget r ] toIpTableArg :: Rules -> [String] toIpTableArg Everything = [] @@ -46,41 +52,40 @@ 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 Rule = Rule + { ruleChain :: Chain + , ruleTarget :: Target + , ruleRules :: Rules + } deriving (Eq, Show, Read) + data Chain = INPUT | OUTPUT | FORWARD - deriving (Eq,Show,Read) + deriving (Eq,Show,Read) data Target = ACCEPT | REJECT | DROP | LOG - deriving (Eq,Show,Read) + deriving (Eq,Show,Read) data Proto = TCP | UDP | ICMP - deriving (Eq,Show,Read) + 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) + 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 = (:-) - - + mempty = Everything + mappend = (:-) -- cgit v1.2.3 From 2766558d61e4d6bfc27a1fa7a0e9c746f836b603 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 31 Oct 2014 10:20:56 -0400 Subject: remove hardcoded path propellor runs as root, and /sbin should always be in root's path --- src/Propellor/Property/Firewall.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs index e1570175..b660207b 100644 --- a/src/Propellor/Property/Firewall.hs +++ b/src/Propellor/Property/Firewall.hs @@ -30,10 +30,10 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable r = Rule c t rs addIpTable = liftIO $ do let args = toIpTable r - exist <- boolSystem "/sbin/iptables" (chk args) + exist <- boolSystem "iptables" (chk args) if exist then return NoChange - else ifM (boolSystem "/sbin/iptables" (add args)) + else ifM (boolSystem "iptables" (add args)) ( return MadeChange , return FailedChange) add params = (Param "-A") : params chk params = (Param "-C") : params -- cgit v1.2.3