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/Propellor/Property/File.hs') 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.2.3