From e3a44ab5825466f9db9c4749497445bd0af1068e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 24 Mar 2016 20:20:34 -0400 Subject: add tightenTargets, ported Network properties (DebinLike only) --- debian/changelog | 6 +++++ src/Propellor/Property.hs | 47 +++++++++++++++++++++++++++++++++++++++ src/Propellor/Property/Network.hs | 39 ++++++++++++++++++-------------- 3 files changed, 75 insertions(+), 17 deletions(-) diff --git a/debian/changelog b/debian/changelog index 323394f9..ead6585e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -23,6 +23,12 @@ propellor (3.0.0) UNRELEASED; urgency=medium of `ensureProperty` for an example, but basically, change this: foo = property desc $ ... ensureProperty bar to this: foo = property' desc $ \o -> ... ensureProperty o bar + - General purpose properties like cmdProperty have type "Property UnixLike". + When using that to run a command only available on Debian, you can + tighten the targets to only the OS that your more specific + property works on. For example: + upgraded :: Property Debian + upgraded = tightenTargets (cmdProperty "apt-get" ["upgrade"]) - The new `pickOS` property combinator can be used to combine different properties, supporting different OS's, into one Property that chooses what to do based on the Host's OS. diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 27d17135..cab233d0 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -1,5 +1,8 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE PolyKinds #-} module Propellor.Property ( -- * Property combinators @@ -20,6 +23,7 @@ module Propellor.Property ( , property , property' , ensureProperty + , tightenTargets --, withOS , unsupportedOS , makeChange @@ -240,6 +244,49 @@ isNewerThan x y = do where mtime f = catchMaybeIO $ modificationTimeHiRes <$> getFileStatus f +-- | Tightens the MetaType list of a Property, to contain fewer targets. +-- +-- Anything else in the MetaType list is passed through unchanged. +-- +-- For example, to make a property that uses apt-get, which is only +-- available on DebianLike systems: +-- +-- > upgraded :: Property DebianLike +-- > upgraded = tightenTargets $ cmdProperty "apt-get" ["upgrade"] +tightenTargets + :: + -- Note that this uses PolyKinds + ( (Targets old `NotSuperset` Targets new) ~ CanCombineTargets + , (NonTargets new `NotSuperset` NonTargets old) ~ CanCombineTargets + , SingI new + ) + => Property (Sing old) + -> Property (Sing new) +tightenTargets (Property old d a i c) = Property sing d a i c + +{- + +-- | Picks one of the two input properties to use, +-- depending on the targeted OS. +-- +-- If both input properties support the targeted OS, then the +-- first will be used. +pickOS + :: + ( combined ~ Union a b + , SingI combined + ) + => Property (Sing a) + -> Property (Sing b) + -> Property (Sing combined) +pickOS a@(Property ta ioa) b@(Property tb iob) = Property sing io + where + -- TODO pick with of ioa or iob to use based on final OS of + -- system being run on. + io = undefined + +-} + -- | Makes a property that is satisfied differently depending on the host's -- operating system. -- 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" -- cgit v1.2.3