summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-09-04 10:38:36 -0700
committerJoey Hess2015-09-04 11:15:43 -0700
commit9d546f04c640c0eb1ded6e585c99e2cd11fb1847 (patch)
treec636ca6b8e5c0658dac808a7ac6feb5289c604ba
parent2c94926558850cb702fd8e844ccbe768937af110 (diff)
Added Propellor.Property.Rsync.
-rw-r--r--debian/changelog6
-rw-r--r--propellor.cabal1
-rw-r--r--src/Propellor/Property/File.hs14
-rw-r--r--src/Propellor/Property/Rsync.hs58
4 files changed, 65 insertions, 14 deletions
diff --git a/debian/changelog b/debian/changelog
index 1fa8c1f1..559cd75d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+propellor (2.7.4) UNRELEASED; urgency=medium
+
+ * Added Propellor.Property.Rsync.
+
+ -- Joey Hess <id@joeyh.name> Fri, 04 Sep 2015 10:36:40 -0700
+
propellor (2.7.3) unstable; urgency=medium
* Fix bug that caused provisioning new chroots to fail.
diff --git a/propellor.cabal b/propellor.cabal
index eab5ccfb..4e4a7388 100644
--- a/propellor.cabal
+++ b/propellor.cabal
@@ -100,6 +100,7 @@ Library
Propellor.Property.Postfix
Propellor.Property.Prosody
Propellor.Property.Reboot
+ Propellor.Property.Rsync
Propellor.Property.List
Propellor.Property.LightDM
Propellor.Property.Scheduled
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"]