From 18dfecfa1e39842365b5b8d2bd99dfb6dc8bd510 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sat, 28 Oct 2017 13:13:36 -0700 Subject: File.isSymlinkedTo now revertable --- src/Propellor/Property/File.hs | 22 ++++++++++++++++++---- 1 file changed, 18 insertions(+), 4 deletions(-) (limited to 'src/Propellor/Property/File.hs') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 3293599a..340a6d02 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -126,18 +126,30 @@ newtype LinkTarget = LinkTarget FilePath -- | Creates or atomically updates a symbolic link. -- +-- Revert to ensure the symlink is not present. +-- -- Does not overwrite regular files or directories. -isSymlinkedTo :: FilePath -> LinkTarget -> Property UnixLike -link `isSymlinkedTo` (LinkTarget target) = property desc $ - go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link) +isSymlinkedTo :: FilePath -> LinkTarget -> RevertableProperty UnixLike UnixLike +link `isSymlinkedTo` (LinkTarget target) = linked notLinked where - desc = link ++ " is symlinked to " ++ target + linked = property (link ++ " is symlinked to " ++ target) $ + go =<< getLinkStatus + go (Right stat) = if isSymbolicLink stat then checkLink else nonSymlinkExists go (Left _) = makeChange $ createSymbolicLink target link + notLinked = property (link ++ "does not exist as a symlink") $ + stop =<< getLinkStatus + + stop (Right stat) = + if isSymbolicLink stat + then makeChange $ nukeFile link + else nonSymlinkExists + stop (Left _) = noChange + nonSymlinkExists = do warningMessage $ link ++ " exists and is not a symlink" return FailedChange @@ -148,6 +160,8 @@ link `isSymlinkedTo` (LinkTarget target) = property desc $ else makeChange updateLink updateLink = createSymbolicLink target `viaStableTmp` link + getLinkStatus = liftIO $ tryIO $ getSymbolicLinkStatus link + -- | Ensures that a file is a copy of another (regular) file. isCopyOf :: FilePath -> FilePath -> Property UnixLike f `isCopyOf` src = property desc $ go =<< (liftIO $ tryIO $ getFileStatus src) -- cgit v1.2.3