deal with Cygwin rsync paths issue

This commit is contained in:
Joey Hess 2013-05-14 13:24:15 -04:00
parent 43f2de8522
commit 03a0f17fbb
4 changed files with 39 additions and 6 deletions

View file

@ -425,7 +425,7 @@ rsyncOrCopyFile rsyncparams src dest p =
_ -> watchfilesize oldsz
#endif
dorsync = rsyncHelper (Just p) $
rsyncparams ++ [Param src, Param dest]
rsyncparams ++ [File src, File dest]
{- Generates rsync parameters that ssh to the remote and asks it
- to either receive or send the key's content. -}

View file

@ -242,7 +242,7 @@ rsyncRetrieve o k dest callback =
-- use inplace when retrieving to support resuming
[ Param "--inplace"
, Param u
, Param dest
, File dest
]
rsyncRemote :: RsyncOpts -> (Maybe MeterUpdate) -> [CommandParam] -> Annex Bool
@ -292,7 +292,7 @@ rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do
[ Param "--recursive"
, partialParams
-- tmp/ to send contents of tmp dir
, Param $ addTrailingPathSeparator tmp
, File $ addTrailingPathSeparator tmp
, Param $ rsyncUrl o
]
else return False

View file

@ -17,6 +17,11 @@ import Data.List
import Data.Maybe
import Control.Applicative
#ifdef __WINDOWS__
import Data.Char
import System.FilePath.Posix as Posix
#endif
import Utility.Monad
import Utility.UserInfo
@ -185,3 +190,22 @@ dotfile file
| otherwise = "." `isPrefixOf` f || dotfile (takeDirectory file)
where
f = takeFileName file
{- Converts a DOS style path to a Cygwin style path. Only on Windows.
- Any trailing '\' is preserved as a trailing '/' -}
toCygPath :: FilePath -> FilePath
#ifndef __WINDOWS__
toCygPath = id
#else
toCygPath p
| null drive = recombine parts
| otherwise = recombine $ "/cygdrive" : 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

View file

@ -1,6 +1,6 @@
{- various rsync stuff
-
- Copyright 2010-2012 Joey Hess <joey@kitenet.net>
- Copyright 2010-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -49,7 +49,16 @@ rsyncUseDestinationPermissions :: CommandParam
rsyncUseDestinationPermissions = Param "--chmod=ugo=rwX"
rsync :: [CommandParam] -> IO Bool
rsync = boolSystem "rsync"
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. -}
rsyncParamsFixup :: [CommandParam] -> [CommandParam]
rsyncParamsFixup = map fixup
where
fixup (File f) = File (toCygPath f)
fixup p = p
{- Runs rsync, but intercepts its progress output and updates a meter.
- The progress output is also output to stdout.
@ -65,7 +74,7 @@ rsyncProgress meterupdate params = do
reapZombies
return r
where
p = proc "rsync" (toCommand params)
p = proc "rsync" (toCommand $ rsyncParamsFixup params)
feedprogress prev buf h = do
s <- hGetSomeString h 80
if null s