diff options
Diffstat (limited to 'Utility/Rsync.hs')
| -rw-r--r-- | Utility/Rsync.hs | 63 |
1 files changed, 55 insertions, 8 deletions
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 3aaf928..c6881b7 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -7,14 +7,28 @@ {-# LANGUAGE CPP #-} -module Utility.Rsync where +module Utility.Rsync ( + rsyncShell, + rsyncServerSend, + rsyncServerReceive, + rsyncUseDestinationPermissions, + rsync, + rsyncUrlIsShell, + rsyncUrlIsPath, + rsyncProgress, + filterRsyncSafeOptions, +) where import Common import Utility.Metered +import Utility.Tuple + +#ifdef mingw32_HOST_OS +import qualified System.FilePath.Posix as Posix +#endif import Data.Char import System.Console.GetOpt -import Data.Tuple.Utils {- Generates parameters to make rsync use a specified command as its remote - shell. -} @@ -24,7 +38,7 @@ rsyncShell command = [Param "-e", Param $ unwords $ map escape (toCommand comman {- 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 = "'" ++ intercalate "''" (split "'" s) ++ "'" + escape s = "'" ++ intercalate "''" (splitc '\'' s) ++ "'" {- Runs rsync in server mode to send a file. -} rsyncServerSend :: [CommandParam] -> FilePath -> IO Bool @@ -54,16 +68,16 @@ rsyncUseDestinationPermissions = Param "--chmod=ugo=rwX" rsync :: [CommandParam] -> IO Bool rsync = boolSystem "rsync" . rsyncParamsFixup -{- On Windows, rsync is from Cygwin, and expects to get Cygwin formatted +{- On Windows, rsync is from msys2, and expects to get msys2 formatted - paths to files. (It thinks that C:foo refers to a host named "C"). - Fix up the Params appropriately. -} rsyncParamsFixup :: [CommandParam] -> [CommandParam] #ifdef mingw32_HOST_OS rsyncParamsFixup = map fixup where - fixup (File f) = File (toCygPath f) + fixup (File f) = File (toMSYS2Path f) fixup (Param s) - | rsyncUrlIsPath s = Param (toCygPath s) + | rsyncUrlIsPath s = Param (toMSYS2Path s) fixup p = p #else rsyncParamsFixup = id @@ -99,7 +113,16 @@ rsyncUrlIsPath s - 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 +rsyncProgress oh meter ps = + commandMeter' parseRsyncProgress oh meter "rsync" (rsyncParamsFixup ps) >>= \case + Just ExitSuccess -> return True + Just (ExitFailure exitcode) -> do + when (exitcode /= 1) $ + hPutStrLn stderr $ "rsync exited " ++ show exitcode + return False + Nothing -> do + hPutStrLn stderr $ "unable to run rsync" + return False {- Strategy: Look for chunks prefixed with \r (rsync writes a \r before - the first progress output, and each thereafter). The first number @@ -123,7 +146,7 @@ parseRsyncProgress = go [] . reverse . progresschunks {- 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] + progresschunks = drop 1 . splitc delim findbytesstart s = dropWhile isSpace s parsebytes :: String -> Maybe Integer @@ -139,3 +162,27 @@ filterRsyncSafeOptions = fst3 . getOpt Permute [ Option [] ["bwlimit"] (reqArgLong "bwlimit") "" ] where reqArgLong x = ReqArg (\v -> "--" ++ x ++ "=" ++ v) "" + +{- Converts a DOS style path to a msys2 style path. Only on Windows. + - Any trailing '\' is preserved as a trailing '/' + - + - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i + - + - The virtual filesystem contains: + - /c, /d, ... mount points for Windows drives + -} +#ifdef mingw32_HOST_OS +toMSYS2Path :: FilePath -> FilePath +toMSYS2Path p + | null drive = recombine parts + | otherwise = recombine $ "/" : driveletter drive : parts + where + (drive, p') = splitDrive p + parts = splitDirectories p' + driveletter = map toLower . takeWhile (/= ':') + recombine = fixtrailing . Posix.joinPath + fixtrailing s + | hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s + | otherwise = s +#endif + |