1 files changed, 69 insertions, 0 deletions
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
new file mode 100644
index 000000000..5845ba703
--- /dev/null
+++ b/Utility/Rsync.hs
@@ -0,0 +1,69 @@
+{- various rsync stuff
+ -
+ - Copyright 2010-2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Rsync where
+
+import Data.String.Utils
+import Data.List
+
+import Utility.SafeCommand
+
+{- Generates parameters to make rsync use a specified command as its remote
+ - shell. -}
+rsyncShell :: [CommandParam] -> [CommandParam]
+rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand command)]
+	where
+		{- rsync requires some weird, non-shell like quoting in
+                 - here. A doubled single quote inside the single quoted
+                 - string is a single quote. -}
+		escape s = "'" ++  join "''" (split "'" s) ++ "'"
+
+{- Runs rsync in server mode to send a file. -}
+rsyncServerSend :: FilePath -> IO Bool
+rsyncServerSend file = rsync $
+	rsyncServerParams ++ [Param "--sender", File file]
+
+{- Runs rsync in server mode to receive a file. -}
+rsyncServerReceive :: FilePath -> IO Bool
+rsyncServerReceive file = rsync $ rsyncServerParams ++ [File file]
+
+rsyncServerParams :: [CommandParam]
+rsyncServerParams =
+	[ Param "--server"
+	-- preserve permissions
+	, Param "-p"
+	-- preserve timestamps
+	, Param "-t"
+	-- allow resuming of transfers of big files
+	, Param "--inplace"
+	-- other options rsync normally uses in server mode
+	, Params "-e.Lsf ."
+	]
+
+rsync :: [CommandParam] -> IO Bool
+rsync = boolSystem "rsync"
+
+{- Checks if an rsync url involves the remote shell (ssh or rsh).
+ - Use of such urls with rsync requires additional shell
+ - escaping. -}
+rsyncUrlIsShell :: String -> Bool
+rsyncUrlIsShell s
+	| "rsync://" `isPrefixOf` s = False
+	| otherwise = go s
+	where
+		-- host::dir is rsync protocol, while host:dir is ssh/rsh
+		go [] = False
+		go (c:cs)
+			| c == '/' = False -- got to directory with no colon
+			| c == ':' = not $ ":" `isPrefixOf` cs
+			| otherwise = go cs
+
+{- Checks if a rsync url is really just a local path. -}
+rsyncUrlIsPath :: String -> Bool
+rsyncUrlIsPath s
+	| rsyncUrlIsShell s = False
+	| otherwise = ':' `notElem` s