summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Rsync.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/Utility/Rsync.hs b/Utility/Rsync.hs
index 1b022c184..08caeb12b 100644
--- a/Utility/Rsync.hs
+++ b/Utility/Rsync.hs
@@ -54,10 +54,10 @@ rsync = boolSystem "rsync"
-}
rsyncProgress :: (Integer -> IO ()) -> [CommandParam] -> IO Bool
rsyncProgress callback params = catchBoolIO $
- withHandle StdoutHandle createProcessSuccess p (feedprogress [])
+ withHandle StdoutHandle createProcessSuccess p (feedprogress 0 [])
where
p = proc "rsync" (toCommand params)
- feedprogress buf h = do
+ feedprogress prev buf h = do
s <- hGetSomeString h 80
if null s
then return True
@@ -65,8 +65,12 @@ rsyncProgress callback params = catchBoolIO $
putStr s
hFlush stdout
let (mbytes, buf') = parseRsyncProgress (buf++s)
- maybe noop callback mbytes
- feedprogress buf' h
+ case mbytes of
+ Nothing -> feedprogress prev buf' h
+ (Just bytes) -> do
+ when (bytes /= prev) $
+ callback bytes
+ feedprogress bytes buf' h
{- Checks if an rsync url involves the remote shell (ssh or rsh).
- Use of such urls with rsync requires additional shell