diff --git a/Remote/Git.hs b/Remote/Git.hs index 46f65ac747..80e73ede9d 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -245,7 +245,7 @@ copyFromRemote r key file dest loc <- inRepo $ gitAnnexLocation key upload u key file $ rsyncOrCopyFile params loc dest - | Git.repoIsSsh r = rsyncHelper =<< rsyncParamsRemote r True key dest file + | Git.repoIsSsh r = rsyncHelper Nothing =<< rsyncParamsRemote r True key dest file | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest | otherwise = error "copying from non-ssh, non-http repo not supported" @@ -280,13 +280,13 @@ copyToRemote r key file p ) | Git.repoIsSsh r = commitOnCleanup r $ do keysrc <- inRepo $ gitAnnexLocation key - rsyncHelper =<< rsyncParamsRemote r False key keysrc file + rsyncHelper (Just p) =<< rsyncParamsRemote r False key keysrc file | otherwise = error "copying to non-ssh repo not supported" -rsyncHelper :: [CommandParam] -> Annex Bool -rsyncHelper p = do +rsyncHelper :: Maybe ProgressCallback -> [CommandParam] -> Annex Bool +rsyncHelper callback params = do showOutput -- make way for progress bar - ifM (liftIO $ rsync p) + ifM (liftIO $ (maybe rsync rsyncProgress callback) params) ( return True , do showLongNote "rsync failed -- run git annex again to resume file transfer" @@ -299,7 +299,7 @@ rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> ProgressCallback -> rsyncOrCopyFile rsyncparams src dest p = ifM (sameDeviceIds src dest) ( liftIO $ copyFileExternal src dest - , rsyncHelper $ rsyncparams ++ [Param src, Param dest] + , rsyncHelper (Just p) $ rsyncparams ++ [Param src, Param dest] ) where sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b) diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs index 70be0d0bca..a533b88ddc 100644 --- a/Utility/Rsync.hs +++ b/Utility/Rsync.hs @@ -7,11 +7,8 @@ module Utility.Rsync where -import Utility.SafeCommand -import Utility.PartialPrelude +import Common -import Data.String.Utils -import Data.List import Data.Char {- Generates parameters to make rsync use a specified command as its remote @@ -49,6 +46,24 @@ rsyncServerParams = rsync :: [CommandParam] -> IO Bool rsync = boolSystem "rsync" +{- Runs rsync, but intercepts its progress output and feeds bytes + - complete values into the callback. The progress output is also output + - to stdout. -} +rsyncProgress :: (Integer -> IO ()) -> [CommandParam] -> IO Bool +rsyncProgress callback params = catchBoolIO $ + withHandle StdoutHandle createProcessSuccess p (feedprogress []) + where + p = proc "rsync" (toCommand params) + feedprogress buf h = + catchMaybeIO (hGetChar h) >>= \v -> case v of + Just c -> do + putChar c + hFlush stdout + let (mbytes, buf') = parseRsyncProgress (buf++[c]) + maybe noop callback mbytes + feedprogress buf' h + Nothing -> return True + {- Checks if an rsync url involves the remote shell (ssh or rsh). - Use of such urls with rsync requires additional shell - escaping. -}