From 9d546f04c640c0eb1ded6e585c99e2cd11fb1847 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 4 Sep 2015 10:38:36 -0700 Subject: Added Propellor.Property.Rsync. --- src/Propellor/Property/File.hs | 14 ---------- src/Propellor/Property/Rsync.hs | 58 +++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 14 deletions(-) create mode 100644 src/Propellor/Property/Rsync.hs (limited to 'src') diff --git a/src/Propellor/Property/File.hs b/src/Propellor/Property/File.hs index 239095c7..adced166 100644 --- a/src/Propellor/Property/File.hs +++ b/src/Propellor/Property/File.hs @@ -105,17 +105,3 @@ mode :: FilePath -> FileMode -> Property NoInfo mode f v = property (f ++ " mode " ++ show v) $ do liftIO $ modifyFileMode f (\_old -> v) noChange - --- | Ensures that the second directory exists and has identical contents --- as the first directory. --- --- Implemented with rsync. --- --- rsync -av 1/ 2/ --exclude='2/*' --delete --delete-excluded -copyDir :: FilePath -> FilePath -> Property NoInfo -copyDir src dest = copyDir' src dest [] - --- | Like copyDir, but avoids copying anything into directories --- in the list. Those directories are created, but will be kept empty. -copyDir' :: FilePath -> FilePath -> [FilePath] -> Property NoInfo -copyDir' src dest exclude = undefined diff --git a/src/Propellor/Property/Rsync.hs b/src/Propellor/Property/Rsync.hs new file mode 100644 index 00000000..064d129f --- /dev/null +++ b/src/Propellor/Property/Rsync.hs @@ -0,0 +1,58 @@ +module Propellor.Property.Rsync where + +import Propellor +import qualified Propellor.Property.Apt as Apt + +type Src = FilePath +type Dest = FilePath + +class RsyncParam p where + toRsync :: p -> String + +-- | Rsync checks each name to be transferred against its list of Filter +-- rules, and the first matching one is acted on. If no matching rule +-- is found, the file is processed. +data Filter + = Include Pattern + | Exclude Pattern + +instance RsyncParam Filter where + toRsync (Include (Pattern p)) = "--include=" ++ p + toRsync (Exclude (Pattern p)) = "--exclude=" ++ p + +-- | A pattern to match against files that rsync is going to transfer. +-- +-- See "INCLUDE/EXCLUDE PATTERN RULES" in the rsync(1) man page. +-- +-- For example, Pattern "/foo/*" matches all files under the "foo" +-- directory, relative to the 'Src' that rsync is acting on. +newtype Pattern = Pattern String + +-- | A pattern that matches all files under a directory, but does not +-- match the directory itself. +filesUnder :: FilePath -> Pattern +filesUnder d = Pattern (d ++ "/*") + +-- | Ensures that the Dest directory exists and has identical contents as +-- the Src directory. +syncDir :: Src -> Dest -> Property NoInfo +syncDir = syncDirFiltered [] + +-- | Like syncDir, but avoids copying anything that the filter list +-- excludes. Anything that's filtered out will be deleted from Dest. +syncDirFiltered :: [Filter] -> Src -> Dest -> Property NoInfo +syncDirFiltered filters src dest = rsync $ + [ "-av" + -- Add trailing '/' to get rsync to sync the Dest directory, + -- rather than a subdir inside it, which it will do without a + -- trailing '/'. + , addTrailingPathSeparator src + , addTrailingPathSeparator dest + , "--delete" + , "--delete-exluded" + , "--quiet" + ] ++ map toRsync filters + +rsync :: [String] -> Property NoInfo +rsync ps = cmdProperty "rsync" ps + `requires` Apt.installed ["rsync"] -- cgit v1.2.3