summaryrefslogtreecommitdiff
path: root/Utility/Rsync.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/Rsync.hs')
-rw-r--r--Utility/Rsync.hs69
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