diff --git a/debian/changelog b/debian/changelog index 055035b..f4fcf35 100644 --- a/debian/changelog +++ b/debian/changelog @@ -5,6 +5,9 @@ propellor (2.7.0) UNRELEASED; urgency=medium * setSshdConfig type changed, and setSshdConfigBool added with old type. * Fix a bug in shim generation code for docker and chroots, that sometimes prevented deployment of docker containers. + * Added onChangeFlagOnFail which is often a safer alternative to + onChange. + Thanks, Antoine Eiche. -- Joey Hess Mon, 20 Jul 2015 12:01:38 -0400 diff --git a/src/Propellor/Property.hs b/src/Propellor/Property.hs index 1801902..b90d5b8 100644 --- a/src/Propellor/Property.hs +++ b/src/Propellor/Property.hs @@ -54,6 +54,41 @@ onChange = combineWith $ \p hook -> do return $ r <> r' _ -> return r +-- | Same as `onChange` except that if property y fails, a flag file +-- is generated. On next run, if the flag file is present, property y +-- is executed even if property x doesn't change. +-- +-- With `onChange`, if y fails, the property x `onChange` y returns +-- `FailedChange`. But if this property is applied again, it returns +-- `NoChange`. This behavior can cause trouble... +onChangeFlagOnFail + :: (Combines (Property x) (Property y)) + => FilePath + -> Property x + -> Property y + -> CombinedType (Property x) (Property y) +onChangeFlagOnFail flagfile p1 p2 = + combineWith go p1 p2 + where + go s1 s2 = do + r1 <- s1 + case r1 of + MadeChange -> flagFailed s2 + _ -> ifM (liftIO $ doesFileExist flagfile) + (flagFailed s2 + , return r1 + ) + flagFailed s = do + r <- s + liftIO $ case r of + FailedChange -> createFlagFile + _ -> removeFlagFile + return r + createFlagFile = unlessM (doesFileExist flagfile) $ do + createDirectoryIfMissing True (takeDirectory flagfile) + writeFile flagfile "" + removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile + -- | Alias for @flip describe@ (==>) :: IsProp (Property i) => Desc -> Property i -> Property i (==>) = flip describe