summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/File.hs
diff options
context:
space:
mode:
authorPer Olofsson2015-10-26 14:01:23 +0100
committerJoey Hess2015-10-26 15:38:03 -0400
commit94d859a6cf094ed3bbdb268fca52c105f68803bd (patch)
tree5281924bf00f67022b9fe4c971fdfe99d4d463d7 /src/Propellor/Property/File.hs
parent3c285d772a42a0bc4fef3a7255d26dc3e8488032 (diff)
Add File.isCopyOf
Signed-off-by: Per Olofsson <pelle@dsv.su.se>
Diffstat (limited to 'src/Propellor/Property/File.hs')
-rw-r--r--src/Propellor/Property/File.hs22
1 files changed, 22 insertions, 0 deletions
diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs
index 3476bad0..e29eceb8 100644
--- a/src/Propellor/Property/File.hs
+++ b/src/Propellor/Property/File.hs
@@ -5,6 +5,7 @@ import Utility.FileMode
import System.Posix.Files
import System.PosixCompat.Types
+import System.Exit
type Line = String
@@ -134,6 +135,27 @@ link `isSymlinkedTo` (LinkTarget target) = property desc $
else makeChange updateLink
updateLink = createSymbolicLink target `viaStableTmp` link
+-- | Ensures that a file is a copy of another (regular) file.
+isCopyOf :: FilePath -> FilePath -> Property NoInfo
+f `isCopyOf` f' = property desc $ go =<< (liftIO $ tryIO $ getFileStatus f')
+ where
+ desc = f ++ " is copy of " ++ f'
+ go (Right stat) = if isRegularFile stat
+ then gocmp =<< (liftIO $ cmp)
+ else warningMessage (f' ++ " is not a regular file") >>
+ return FailedChange
+ go (Left e) = warningMessage (show e) >> return FailedChange
+
+ cmp = safeSystem "cmp" [Param "-s", Param "--", File f, File f']
+ gocmp ExitSuccess = noChange
+ gocmp (ExitFailure 1) = doit
+ gocmp _ = warningMessage "cmp failed" >> return FailedChange
+
+ doit = makeChange $ copy f' `viaStableTmp` f
+ copy src dest = unlessM (runcp src dest) $ errorMessage "cp failed"
+ runcp src dest = boolSystem "cp"
+ [Param "--preserve=all", Param "--", File src, File dest]
+
-- | 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