From de2c8133aa2cf694f16fc5732e841af0991125bb Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 10 Oct 2015 15:21:54 -0400 Subject: example for withOS --- src/Propellor/Property.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'src') 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 -- cgit v1.3-2-g0d8e From 084d1f9ba34e5c88f3ade4a32bc18cf5952a1c1a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 10 Oct 2015 16:08:30 -0400 Subject: wording --- src/Propellor.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src') diff --git a/src/Propellor.hs b/src/Propellor.hs index 4f777f11..c84c0371 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: -- cgit v1.3-2-g0d8e From e41aeb6aecfac69f8c2a2c90639634433694b335 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 10 Oct 2015 19:43:55 -0400 Subject: reorg sections --- src/Propellor.hs | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) (limited to 'src') diff --git a/src/Propellor.hs b/src/Propellor.hs index c84c0371..9d45c376 100644 --- a/src/Propellor.hs +++ b/src/Propellor.hs @@ -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 -- cgit v1.3-2-g0d8e From 7ed033302a942ad8e92355de1d36884550e7aa53 Mon Sep 17 00:00:00 2001 From: Per Olofsson Date: Tue, 13 Oct 2015 14:29:45 +0200 Subject: Add File.isSymlinkedTo Signed-off-by: Per Olofsson --- src/Propellor/Property/File.hs | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) (limited to 'src') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index b491ccbe..eeb38ce9 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -98,6 +98,42 @@ 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 = bracket_ setup cleanup $ rename link' link + link' = link ++ ".propellor-new~" + setup = do + whenM hasOldLink' removeOldLink' + createSymbolicLink target link' + cleanup = tryIO $ removeLink link' + hasOldLink' = (tryIO $ getSymbolicLinkStatus link') >>= \result -> + case result of + Right stat -> return $ isSymbolicLink stat + Left _ -> return False + removeOldLink' = do + warningMessage $ "removing cruft from previous run: " ++ link' + removeLink 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 -- cgit v1.3-2-g0d8e From bbb0386515365b6735a9e635baa38fe762c951ef Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 Oct 2015 12:43:37 -0400 Subject: excess newline --- src/Propellor/Property/File.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index eeb38ce9..f774272c 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -133,7 +133,6 @@ link `isSymlinkedTo` target = property desc $ warningMessage $ "removing cruft from previous run: " ++ link' removeLink 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 -- cgit v1.3-2-g0d8e From 037d287a3a383471edbcd4cf8f490fc4027b67b7 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 Oct 2015 13:10:07 -0400 Subject: fileProperty, and properties derived from it now write the new file content via origfile.propellor-new~, instead of to a randomly named temp file. This allows them to clean up any temp file that may have been left by an interrupted run of propellor. Also converted the new isSymlinkedTo property to use the same implementation, with some simplifications. --- debian/changelog | 4 ++++ src/Propellor/Property/File.hs | 43 ++++++++++++++++++++++++--------------- src/Propellor/Property/Systemd.hs | 5 +++-- 3 files changed, 34 insertions(+), 18 deletions(-) (limited to 'src') diff --git a/debian/changelog b/debian/changelog index dda8197b..292ec0be 100644 --- a/debian/changelog +++ b/debian/changelog @@ -10,6 +10,10 @@ propellor (2.9.0) UNRELEASED; urgency=medium * Some renaming of instance methods, and moving of functions to more appropriate modules. (API change) * Added File.isSymlinkedTo. Thanks, Per Olofsson. + * fileProperty, and properties derived from it now write the new + file content via origfile.propellor-new~, instead of to a randomly named + temp file. This allows them to clean up any temp file that may have + been left by an interrupted run of propellor. -- Joey Hess Thu, 08 Oct 2015 11:09:01 -0400 diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index f774272c..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) @@ -119,19 +118,7 @@ link `isSymlinkedTo` target = property desc $ if target == target' then noChange else makeChange updateLink - updateLink = bracket_ setup cleanup $ rename link' link - link' = link ++ ".propellor-new~" - setup = do - whenM hasOldLink' removeOldLink' - createSymbolicLink target link' - cleanup = tryIO $ removeLink link' - hasOldLink' = (tryIO $ getSymbolicLinkStatus link') >>= \result -> - case result of - Right stat -> return $ isSymbolicLink stat - Left _ -> return False - removeOldLink' = do - warningMessage $ "removing cruft from previous run: " ++ link' - removeLink link' + updateLink = createSymbolicLink target `viaStableTmp` link -- | Ensures that a file/dir has the specified owner and group. ownerGroup :: FilePath -> User -> Group -> Property NoInfo @@ -148,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/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, -- cgit v1.3-2-g0d8e From 7d2576ec9c8623182f8d4b890a372b1929fd758a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 14 Oct 2015 15:48:32 -0400 Subject: recent changes broke the baseurl --- src/Propellor/Property/OpenId.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') 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 -- cgit v1.3-2-g0d8e