diff options
Diffstat (limited to 'Utility/Rsync.hs')
| -rw-r--r-- | Utility/Rsync.hs | 65 |
1 files changed, 28 insertions, 37 deletions
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 8dee609..3aaf928 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -1,10 +1,12 @@ {- various rsync stuff - - - Copyright 2010-2013 Joey Hess <joey@kitenet.net> + - Copyright 2010-2013 Joey Hess <id@joeyh.name> - - License: BSD-2-clause -} +{-# LANGUAGE CPP #-} + module Utility.Rsync where import Common @@ -42,7 +44,8 @@ rsyncServerParams = -- allow resuming of transfers of big files , Param "--inplace" -- other options rsync normally uses in server mode - , Params "-e.Lsf ." + , Param "-e.Lsf" + , Param "." ] rsyncUseDestinationPermissions :: CommandParam @@ -53,37 +56,18 @@ rsync = boolSystem "rsync" . rsyncParamsFixup {- On Windows, rsync is from Cygwin, and expects to get Cygwin formatted - paths to files. (It thinks that C:foo refers to a host named "C"). - - Fix up all Files in the Params appropriately. -} + - Fix up the Params appropriately. -} rsyncParamsFixup :: [CommandParam] -> [CommandParam] +#ifdef mingw32_HOST_OS rsyncParamsFixup = map fixup where fixup (File f) = File (toCygPath f) + fixup (Param s) + | rsyncUrlIsPath s = Param (toCygPath s) fixup p = p - -{- Runs rsync, but intercepts its progress output and updates a meter. - - The progress output is also output to stdout. - - - - The params must enable rsync's --progress mode for this to work. - -} -rsyncProgress :: MeterUpdate -> [CommandParam] -> IO Bool -rsyncProgress meterupdate params = catchBoolIO $ - withHandle StdoutHandle createProcessSuccess p (feedprogress 0 []) - where - p = proc "rsync" (toCommand $ rsyncParamsFixup params) - feedprogress prev buf h = do - s <- hGetSomeString h 80 - if null s - then return True - else do - putStr s - hFlush stdout - let (mbytes, buf') = parseRsyncProgress (buf++s) - case mbytes of - Nothing -> feedprogress prev buf' h - (Just bytes) -> do - when (bytes /= prev) $ - meterupdate $ toBytesProcessed bytes - feedprogress bytes buf' h +#else +rsyncParamsFixup = id +#endif {- Checks if an rsync url involves the remote shell (ssh or rsh). - Use of such urls with rsync requires additional shell @@ -103,17 +87,21 @@ rsyncUrlIsShell s {- Checks if a rsync url is really just a local path. -} rsyncUrlIsPath :: String -> Bool rsyncUrlIsPath s +#ifdef mingw32_HOST_OS + | not (null (takeDrive s)) = True +#endif | rsyncUrlIsShell s = False | otherwise = ':' `notElem` s -{- Parses the String looking for rsync progress output, and returns - - Maybe the number of bytes rsynced so far, and any any remainder of the - - string that could be an incomplete progress output. That remainder - - should be prepended to future output, and fed back in. This interface - - allows the output to be read in any desired size chunk, or even one - - character at a time. +{- Runs rsync, but intercepts its progress output and updates a progress + - meter. - - - Strategy: Look for chunks prefixed with \r (rsync writes a \r before + - The params must enable rsync's --progress mode for this to work. + -} +rsyncProgress :: OutputHandler -> MeterUpdate -> [CommandParam] -> IO Bool +rsyncProgress oh meter = commandMeter parseRsyncProgress oh meter "rsync" . rsyncParamsFixup + +{- Strategy: Look for chunks prefixed with \r (rsync writes a \r before - the first progress output, and each thereafter). The first number - after the \r is the number of bytes processed. After the number, - there must appear some whitespace, or we didn't get the whole number, @@ -122,20 +110,23 @@ rsyncUrlIsPath s - In some locales, the number will have one or more commas in the middle - of it. -} -parseRsyncProgress :: String -> (Maybe Integer, String) +parseRsyncProgress :: ProgressParser parseRsyncProgress = go [] . reverse . progresschunks where go remainder [] = (Nothing, remainder) go remainder (x:xs) = case parsebytes (findbytesstart x) of Nothing -> go (delim:x++remainder) xs - Just b -> (Just b, remainder) + Just b -> (Just (toBytesProcessed b), remainder) delim = '\r' + {- Find chunks that each start with delim. - The first chunk doesn't start with it - (it's empty when delim is at the start of the string). -} progresschunks = drop 1 . split [delim] findbytesstart s = dropWhile isSpace s + + parsebytes :: String -> Maybe Integer parsebytes s = case break isSpace s of ([], _) -> Nothing (_, []) -> Nothing |