summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJoey Hess2015-10-16 12:30:34 -0400
committerJoey Hess2015-10-16 12:30:34 -0400
commit51634a1bfc091b0c2e005e58266771dab0710ffe (patch)
treeb0ae2dc87cf6d3a21bc81dbd4dcb0b63afb1d612 /src
parent5cbbc8fbc5cfe0862ac278b63bb5f16f35998ee8 (diff)
parente5b5a190b7de979cd889c92ecff530417534864e (diff)
Merge branch 'joeyconfig'
Diffstat (limited to 'src')
-rw-r--r--src/Propellor.hs14
-rw-r--r--src/Propellor/Property.hs7
-rw-r--r--src/Propellor/Property/File.hs52
-rw-r--r--src/Propellor/Property/OpenId.hs2
-rw-r--r--src/Propellor/Property/Systemd.hs5
5 files changed, 64 insertions, 16 deletions
diff --git a/src/Propellor.hs b/src/Propellor.hs
index 4f777f11..9d45c376 100644
--- a/src/Propellor.hs
+++ b/src/Propellor.hs
@@ -1,7 +1,7 @@
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
--- | When propellor runs on a Host, it ensures that its list of Properties
--- is satisfied, taking action as necessary when a Property is not
+-- | When propellor runs on a Host, it ensures that its Properties
+-- are satisfied, taking action as necessary when a Property is not
-- currently satisfied.
--
-- A simple propellor program example:
@@ -32,13 +32,14 @@ module Propellor (
, Property
, RevertableProperty
, (<!>)
- -- * Core config file
+ , module Propellor.Types
+ -- * Config file
, defaultMain
, host
, (&)
, (!)
+ -- * Propertries
, describe
- -- * Combining properties
-- | Properties are often combined together in your propellor
-- configuration. For example:
--
@@ -47,11 +48,6 @@ module Propellor (
, requires
, before
, onChange
- -- * Included modules
- -- | These are only the core modules you'll need. There are many
- -- more in propellor that you can import.
- , module Propellor.Types
- -- | Additional data types used by propellor
, module Propellor.Property
-- | Everything you need to build your own properties,
-- and useful property combinators
diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs
index 667dc52b..342db1a5 100644
--- a/src/Propellor/Property.hs
+++ b/src/Propellor/Property.hs
@@ -173,7 +173,12 @@ trivial p = adjustPropertySatisfy p $ \satisfy -> do
-- | Makes a property that is satisfied differently depending on the host's
-- operating system.
--
--- Note that the operating system may not be declared for some hosts.
+-- Note that the operating system may not be declared for all hosts.
+--
+-- > myproperty = withOS "foo installed" $ \o -> case o of
+-- > (Just (System (Debian suite) arch)) -> ...
+-- > (Just (System (Ubuntu release) arch)) -> ...
+-- > Nothing -> ...
withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo
withOS desc a = property desc $ a =<< getOS
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index b491ccbe..12a3e80a 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -82,12 +82,11 @@ fileProperty' writer desc a f = property desc $ go =<< liftIO (doesFileExist f)
let new = unlines (a (lines old))
if old == new
then noChange
- else makeChange $ viaTmp updatefile f new
+ else makeChange $ updatefile new `viaStableTmp` f
go False = makeChange $ writer f (unlines $ a [])
- -- viaTmp makes the temp file mode 600.
-- Replicate the original file's owner and mode.
- updatefile f' content = do
+ updatefile content f' = do
writer f' content
s <- getFileStatus f
setFileMode f' (fileMode s)
@@ -98,6 +97,29 @@ dirExists :: FilePath -> Property NoInfo
dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $
makeChange $ createDirectoryIfMissing True d
+-- | Creates or atomically updates a symbolic link. Does not overwrite regular
+-- files or directories.
+isSymlinkedTo :: FilePath -> FilePath -> Property NoInfo
+link `isSymlinkedTo` target = property desc $
+ go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link)
+ where
+ desc = link ++ " is symlinked to " ++ target
+ go (Right stat) =
+ if isSymbolicLink stat
+ then checkLink
+ else nonSymlinkExists
+ go (Left _) = makeChange $ createSymbolicLink target link
+
+ nonSymlinkExists = do
+ warningMessage $ link ++ " exists and is not a symlink"
+ return FailedChange
+ checkLink = do
+ target' <- liftIO $ readSymbolicLink link
+ if target == target'
+ then noChange
+ else makeChange updateLink
+ updateLink = createSymbolicLink target `viaStableTmp` link
+
-- | Ensures that a file/dir has the specified owner and group.
ownerGroup :: FilePath -> User -> Group -> Property NoInfo
ownerGroup f (User owner) (Group group) = property (f ++ " owner " ++ og) $ do
@@ -113,3 +135,27 @@ mode :: FilePath -> FileMode -> Property NoInfo
mode f v = property (f ++ " mode " ++ show v) $ do
liftIO $ modifyFileMode f (const v)
noChange
+
+-- | A temp file to use when writing new content for a file.
+--
+-- This is a stable name so it can be removed idempotently.
+--
+-- It ends with "~" so that programs that read many config files from a
+-- directory will treat it as an editor backup file, and not read it.
+stableTmpFor :: FilePath -> FilePath
+stableTmpFor f = f ++ ".propellor-new~"
+
+-- | Creates/updates a file atomically, running the action to create the
+-- stable tmp file, and then renaming it into place.
+viaStableTmp :: (MonadMask m, MonadIO m) => (FilePath -> m ()) -> FilePath -> m ()
+viaStableTmp a f = bracketIO setup cleanup go
+ where
+ setup = do
+ createDirectoryIfMissing True (takeDirectory f)
+ let tmpfile = stableTmpFor f
+ nukeFile tmpfile
+ return tmpfile
+ cleanup tmpfile = tryIO $ removeFile tmpfile
+ go tmpfile = do
+ a tmpfile
+ liftIO $ rename tmpfile f
diff --git a/src/Propellor/Property/OpenId.hs b/src/Propellor/Property/OpenId.hs
index ae437518..bafca041 100644
--- a/src/Propellor/Property/OpenId.hs
+++ b/src/Propellor/Property/OpenId.hs
@@ -28,7 +28,7 @@ providerFor users hn mp = propertyList desc $ props
where
baseurl = hn ++ case mp of
Nothing -> ""
- Just (Port p) -> show p
+ Just (Port p) -> ':' : show p
url = "http://"++baseurl++"/simpleid"
desc = "openid provider " ++ url
setbaseurl l
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 8194fc85..a93c48bc 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -254,8 +254,9 @@ nspawnService (Container name _ _) cfg = setup <!> teardown
<$> servicefilecontent
<*> catchDefaultIO "" (readFile servicefile)
- writeservicefile = property servicefile $ makeChange $
- viaTmp writeFile servicefile =<< servicefilecontent
+ writeservicefile = property servicefile $ makeChange $ do
+ c <- servicefilecontent
+ File.viaStableTmp (\t -> writeFile t c) servicefile
setupservicefile = check (not <$> goodservicefile) $
-- if it's running, it has the wrong configuration,