summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Network.hs
diff options
context:
space:
mode:
authorJoey Hess2016-03-24 20:20:34 -0400
committerJoey Hess2016-03-24 20:27:47 -0400
commite3a44ab5825466f9db9c4749497445bd0af1068e (patch)
tree038e97af1b86be7d7121023448046b0e712faea7 /src/Propellor/Property/Network.hs
parent16ea40620ef2dbd62a2e8d5d8eb153e03d0c5848 (diff)
add tightenTargets, ported Network properties (DebinLike only)
Diffstat (limited to 'src/Propellor/Property/Network.hs')
-rw-r--r--src/Propellor/Property/Network.hs39
1 files changed, 22 insertions, 17 deletions
diff --git a/src/Propellor/Property/Network.hs b/src/Propellor/Property/Network.hs
index 382f5d9d..46f5cef3 100644
--- a/src/Propellor/Property/Network.hs
+++ b/src/Propellor/Property/Network.hs
@@ -2,13 +2,14 @@ module Propellor.Property.Network where
import Propellor.Base
import Propellor.Property.File
+import Propellor.Types.MetaTypes
import Data.Char
type Interface = String
-ifUp :: Interface -> Property NoInfo
-ifUp iface = cmdProperty "ifup" [iface]
+ifUp :: Interface -> Property DebianLike
+ifUp iface = tightenTargets $ cmdProperty "ifup" [iface]
`assume` MadeChange
-- | Resets /etc/network/interfaces to a clean and empty state,
@@ -18,8 +19,8 @@ ifUp iface = cmdProperty "ifup" [iface]
-- This can be used as a starting point to defining other interfaces.
--
-- No interfaces are brought up or down by this property.
-cleanInterfacesFile :: Property NoInfo
-cleanInterfacesFile = hasContent interfacesFile
+cleanInterfacesFile :: Property DebianLike
+cleanInterfacesFile = tightenTargets $ hasContent interfacesFile
[ "# Deployed by propellor, do not edit."
, ""
, "source-directory interfaces.d"
@@ -31,8 +32,8 @@ cleanInterfacesFile = hasContent interfacesFile
`describe` ("clean " ++ interfacesFile)
-- | Configures an interface to get its address via dhcp.
-dhcp :: Interface -> Property NoInfo
-dhcp iface = hasContent (interfaceDFile iface)
+dhcp :: Interface -> Property DebianLike
+dhcp iface = tightenTargets $ hasContent (interfaceDFile iface)
[ "auto " ++ iface
, "iface " ++ iface ++ " inet dhcp"
]
@@ -50,18 +51,20 @@ dhcp iface = hasContent (interfaceDFile iface)
--
-- (ipv6 addresses are not included because it's assumed they come up
-- automatically in most situations.)
-static :: Interface -> Property NoInfo
-static iface = check (not <$> doesFileExist f) setup
- `describe` desc
- `requires` interfacesDEnabled
+static :: Interface -> Property DebianLike
+static iface = tightenTargets $
+ check (not <$> doesFileExist f) setup
+ `describe` desc
+ `requires` interfacesDEnabled
where
f = interfaceDFile iface
desc = "static " ++ iface
- setup = property desc $ do
+ setup :: Property DebianLike
+ setup = property' desc $ \o -> do
ls <- liftIO $ lines <$> readProcess "ip"
["-o", "addr", "show", iface, "scope", "global"]
stanzas <- liftIO $ concat <$> mapM mkstanza ls
- ensureProperty $ hasContent f $ ("auto " ++ iface) : stanzas
+ ensureProperty o $ hasContent f $ ("auto " ++ iface) : stanzas
mkstanza ipline = case words ipline of
-- Note that the IP address is written CIDR style, so
-- the netmask does not need to be specified separately.
@@ -81,8 +84,8 @@ static iface = check (not <$> doesFileExist f) setup
_ -> Nothing
-- | 6to4 ipv6 connection, should work anywhere
-ipv6to4 :: Property NoInfo
-ipv6to4 = hasContent (interfaceDFile "sit0")
+ipv6to4 :: Property DebianLike
+ipv6to4 = tightenTargets $ hasContent (interfaceDFile "sit0")
[ "# Deployed by propellor, do not edit."
, "iface sit0 inet6 static"
, "\taddress 2002:5044:5531::1"
@@ -107,6 +110,8 @@ escapeInterfaceDName :: Interface -> FilePath
escapeInterfaceDName = filter (\c -> isAscii c && (isAlphaNum c || c `elem` "_-"))
-- | Ensures that files in the the interfaces.d directory are used.
-interfacesDEnabled :: Property NoInfo
-interfacesDEnabled = containsLine interfacesFile "source-directory interfaces.d"
- `describe` "interfaces.d directory enabled"
+-- interfacesDEnabled :: Property DebianLike
+interfacesDEnabled :: Property DebianLike
+interfacesDEnabled = tightenTargets $
+ containsLine interfacesFile "source-directory interfaces.d"
+ `describe` "interfaces.d directory enabled"