summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2016-02-26 10:55:21 -0400
committerJoey Hess2016-02-26 10:55:21 -0400
commit071921d11056527fc307e243b603bfc83d49555e (patch)
tree1fb5c8f7aeb4a1babbd13ca0622333fa5e8d5433 /src
parentc716d1a0d4b18737b133ba9cc23c97388f72f5c0 (diff)
parent0cba8dec39447f030c0f765d1d84a1c2466b9bfc (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property.hs2
-rw-r--r--src/Propellor/Property/Chroot.hs2
-rw-r--r--src/Propellor/Property/Debootstrap.hs6
-rw-r--r--src/Propellor/Property/Firewall.hs115
-rw-r--r--src/Propellor/Property/OS.hs2
-rw-r--r--src/Propellor/Property/Ssh.hs6
-rw-r--r--src/Propellor/Types/OS.hs2
7 files changed, 112 insertions, 23 deletions
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index eee1409c..fe99a3fd 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -255,7 +255,7 @@ isNewerThan x y = do
--
-- > myproperty = withOS "foo installed" $ \o -> case o of
-- > (Just (System (Debian suite) arch)) -> ...
--- > (Just (System (FooBuntu release) arch)) -> ...
+-- > (Just (System (Buntish release) arch)) -> ...
-- > Nothing -> ...
withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs
index 44d7036d..e0ff477d 100644
--- a/src/Propellor/Property/Chroot.hs
+++ b/src/Propellor/Property/Chroot.hs
@@ -90,7 +90,7 @@ data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig
instance ChrootBootstrapper Debootstrapped where
buildchroot (Debootstrapped cf) system loc = case system of
(Just s@(System (Debian _) _)) -> Right $ debootstrap s
- (Just s@(System (FooBuntu _) _)) -> Right $ debootstrap s
+ (Just s@(System (Buntish _) _)) -> Right $ debootstrap s
Nothing -> Left "Cannot debootstrap; `os` property not specified"
where
debootstrap s = Debootstrap.built loc s cf
diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs
index 445c0629..6a566853 100644
--- a/src/Propellor/Property/Debootstrap.hs
+++ b/src/Propellor/Property/Debootstrap.hs
@@ -91,7 +91,7 @@ built' installprop target system@(System _ arch) config =
extractSuite :: System -> Maybe String
extractSuite (System (Debian s) _) = Just $ Apt.showSuite s
-extractSuite (System (FooBuntu r) _) = Just r
+extractSuite (System (Buntish r) _) = Just r
-- | Ensures debootstrap is installed.
--
@@ -108,12 +108,12 @@ installed = install <!> remove
)
installon (Just (System (Debian _) _)) = aptinstall
- installon (Just (System (FooBuntu _) _)) = aptinstall
+ installon (Just (System (Buntish _) _)) = aptinstall
installon _ = sourceInstall
remove = withOS "debootstrap removed" $ ensureProperty . removefrom
removefrom (Just (System (Debian _) _)) = aptremove
- removefrom (Just (System (FooBuntu _) _)) = aptremove
+ removefrom (Just (System (Buntish _) _)) = aptremove
removefrom _ = sourceRemove
aptinstall = Apt.installed ["debootstrap"]
diff --git a/src/Propellor/Property/Firewall.hs b/src/Propellor/Property/Firewall.hs
index 20b44845..eefc8342 100644
--- a/src/Propellor/Property/Firewall.hs
+++ b/src/Propellor/Property/Firewall.hs
@@ -1,15 +1,22 @@
-- | Maintainer: Arnaud Bailly <arnaud.oqube@gmail.com>
---
+--
-- Properties for configuring firewall (iptables) rules
module Propellor.Property.Firewall (
rule,
installed,
Chain(..),
- Target(..),
+ Table(..),
+ TargetFilter(..),
+ TargetNat(..),
+ TargetMangle(..),
+ TargetRaw(..),
+ TargetSecurity(..),
Proto(..),
Rules(..),
- ConnectionState(..)
+ ConnectionState(..),
+ IPWithMask(..),
+ fromIPWithMask
) where
import Data.Monoid
@@ -23,7 +30,7 @@ import qualified Propellor.Property.Network as Network
installed :: Property NoInfo
installed = Apt.installed ["iptables"]
-rule :: Chain -> Target -> Rules -> Property NoInfo
+rule :: Chain -> Table -> Rules -> Property NoInfo
rule c t rs = property ("firewall rule: " <> show r) addIpTable
where
r = Rule c t rs
@@ -33,13 +40,13 @@ rule c t rs = property ("firewall rule: " <> show r) addIpTable
if exist
then return NoChange
else toResult <$> boolSystem "iptables" (add args)
- add params = (Param "-A") : params
- chk params = (Param "-C") : params
+ 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 ]
+ show (ruleChain r) :
+ toIpTableArg (ruleRules r) ++ toIpTableTable (ruleTable r)
toIpTableArg :: Rules -> [String]
toIpTableArg Everything = []
@@ -47,26 +54,105 @@ toIpTableArg (Proto proto) = ["-p", map toLower $ show proto]
toIpTableArg (DPort (Port port)) = ["--dport", show port]
toIpTableArg (DPortRange (Port f, Port t)) =
["--dport", show f ++ ":" ++ show t]
-toIpTableArg (IFace iface) = ["-i", iface]
+toIpTableArg (InIFace iface) = ["-i", iface]
+toIpTableArg (OutIFace iface) = ["-o", iface]
toIpTableArg (Ctstate states) =
[ "-m"
, "conntrack"
- , "--ctstate", concat $ intersperse "," (map show states)
+ , "--ctstate", intercalate "," (map show states)
+ ]
+toIpTableArg (Source ipwm) =
+ [ "-s"
+ , intercalate "," (map fromIPWithMask ipwm)
+ ]
+toIpTableArg (Destination ipwm) =
+ [ "-d"
+ , intercalate "," (map fromIPWithMask ipwm)
]
toIpTableArg (r :- r') = toIpTableArg r <> toIpTableArg r'
+data IPWithMask = IPWithNoMask IPAddr | IPWithIPMask IPAddr IPAddr | IPWithNumMask IPAddr Int
+ deriving (Eq, Show)
+
+fromIPWithMask :: IPWithMask -> String
+fromIPWithMask (IPWithNoMask ip) = fromIPAddr ip
+fromIPWithMask (IPWithIPMask ip ipm) = fromIPAddr ip ++ "/" ++ fromIPAddr ipm
+fromIPWithMask (IPWithNumMask ip m) = fromIPAddr ip ++ "/" ++ show m
+
data Rule = Rule
{ ruleChain :: Chain
- , ruleTarget :: Target
+ , ruleTable :: Table
, ruleRules :: Rules
} deriving (Eq, Show)
+data Table = Filter TargetFilter | Nat TargetNat | Mangle TargetMangle | Raw TargetRaw | Security TargetSecurity
+ deriving (Eq, Show)
+
+toIpTableTable :: Table -> [String]
+toIpTableTable f = ["-t", table, "-j", target]
+ where
+ (table, target) = toIpTableTable' f
+
+toIpTableTable' :: Table -> (String, String)
+toIpTableTable' (Filter target) = ("filter", fromTarget target)
+toIpTableTable' (Nat target) = ("nat", fromTarget target)
+toIpTableTable' (Mangle target) = ("mangle", fromTarget target)
+toIpTableTable' (Raw target) = ("raw", fromTarget target)
+toIpTableTable' (Security target) = ("security", fromTarget target)
+
data Chain = INPUT | OUTPUT | FORWARD
deriving (Eq, Show)
-data Target = ACCEPT | REJECT | DROP | LOG
+data TargetFilter = ACCEPT | REJECT | DROP | LOG | FilterCustom String
+ deriving (Eq, Show)
+
+class FromTarget a where
+ fromTarget :: a -> String
+
+instance FromTarget TargetFilter where
+ fromTarget ACCEPT = "ACCEPT"
+ fromTarget REJECT = "REJECT"
+ fromTarget DROP = "DROP"
+ fromTarget LOG = "LOG"
+ fromTarget (FilterCustom f) = f
+
+data TargetNat = NatPREROUTING | NatOUTPUT | NatPOSTROUTING | NatCustom String
+ deriving (Eq, Show)
+
+instance FromTarget TargetNat where
+ fromTarget NatPREROUTING = "PREROUTING"
+ fromTarget NatOUTPUT = "OUTPUT"
+ fromTarget NatPOSTROUTING = "POSTROUTING"
+ fromTarget (NatCustom f) = f
+
+data TargetMangle = ManglePREROUTING | MangleOUTPUT | MangleINPUT | MangleFORWARD | ManglePOSTROUTING | MangleCustom String
+ deriving (Eq, Show)
+
+instance FromTarget TargetMangle where
+ fromTarget ManglePREROUTING = "PREROUTING"
+ fromTarget MangleOUTPUT = "OUTPUT"
+ fromTarget MangleINPUT = "INPUT"
+ fromTarget MangleFORWARD = "FORWARD"
+ fromTarget ManglePOSTROUTING = "POSTROUTING"
+ fromTarget (MangleCustom f) = f
+
+data TargetRaw = RawPREROUTING | RawOUTPUT | RawCustom String
+ deriving (Eq, Show)
+
+instance FromTarget TargetRaw where
+ fromTarget RawPREROUTING = "PREROUTING"
+ fromTarget RawOUTPUT = "OUTPUT"
+ fromTarget (RawCustom f) = f
+
+data TargetSecurity = SecurityINPUT | SecurityOUTPUT | SecurityFORWARD | SecurityCustom String
deriving (Eq, Show)
+instance FromTarget TargetSecurity where
+ fromTarget SecurityINPUT = "INPUT"
+ fromTarget SecurityOUTPUT = "OUTPUT"
+ fromTarget SecurityFORWARD = "FORWARD"
+ fromTarget (SecurityCustom f) = f
+
data Proto = TCP | UDP | ICMP
deriving (Eq, Show)
@@ -80,8 +166,11 @@ data Rules
-- data type with proto + ports
| DPort Port
| DPortRange (Port,Port)
- | IFace Network.Interface
+ | InIFace Network.Interface
+ | OutIFace Network.Interface
| Ctstate [ ConnectionState ]
+ | Source [ IPWithMask ]
+ | Destination [ IPWithMask ]
| Rules :- Rules -- ^Combine two rules
deriving (Eq, Show)
diff --git a/src/Propellor/Property/OS.hs b/src/Propellor/Property/OS.hs
index 403b1df3..5678b818 100644
--- a/src/Propellor/Property/OS.hs
+++ b/src/Propellor/Property/OS.hs
@@ -85,7 +85,7 @@ cleanInstallOnce confirmation = check (not <$> doesFileExist flagfile) $
osbootstrapped = withOS (newOSDir ++ " bootstrapped") $ \o -> case o of
(Just d@(System (Debian _) _)) -> debootstrap d
- (Just u@(System (FooBuntu _) _)) -> debootstrap u
+ (Just u@(System (Buntish _) _)) -> debootstrap u
_ -> error "os is not declared to be Debian or *buntu"
debootstrap targetos = ensureProperty $
diff --git a/src/Propellor/Property/Ssh.hs b/src/Propellor/Property/Ssh.hs
index 9e1fb7af..c21f009f 100644
--- a/src/Propellor/Property/Ssh.hs
+++ b/src/Propellor/Property/Ssh.hs
@@ -417,6 +417,6 @@ unauthorizedKey user@(User u) l = property desc $ do
modAuthorizedKey :: FilePath -> User -> Property NoInfo -> Propellor Result
modAuthorizedKey f user p = ensureProperty $ p
- `requires` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
- `requires` File.ownerGroup f user (userGroup user)
- `requires` File.ownerGroup (takeDirectory f) user (userGroup user)
+ `before` File.mode f (combineModes [ownerWriteMode, ownerReadMode])
+ `before` File.ownerGroup f user (userGroup user)
+ `before` File.ownerGroup (takeDirectory f) user (userGroup user)
diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs
index 6c2dd28e..c302d11d 100644
--- a/src/Propellor/Types/OS.hs
+++ b/src/Propellor/Types/OS.hs
@@ -24,7 +24,7 @@ data System = System Distribution Architecture
data Distribution
= Debian DebianSuite
- | FooBuntu Release -- ^ "*buntu" (The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>)
+ | Buntish Release -- ^ A well-known Debian derivative founded by a space tourist. The actual name of this distribution is not used in Propellor per <http://joeyh.name/blog/entry/trademark_nonsense/>)
deriving (Show, Eq)
-- | Debian has several rolling suites, and a number of stable releases,