summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/File.hs
diff options
context:
space:
mode:
authorPer Olofsson2015-10-13 14:29:45 +0200
committerJoey Hess2015-10-14 12:42:28 -0400
commit7ed033302a942ad8e92355de1d36884550e7aa53 (patch)
tree98763be1d979012b50872d257ab5368fc225f389 /src/Propellor/Property/File.hs
parente41aeb6aecfac69f8c2a2c90639634433694b335 (diff)
Add File.isSymlinkedTo
Signed-off-by: Per Olofsson <pelle@dsv.su.se>
Diffstat (limited to 'src/Propellor/Property/File.hs')
-rw-r--r--src/Propellor/Property/File.hs36
1 files changed, 36 insertions, 0 deletions
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