summaryrefslogtreecommitdiff
path: root/Remote/Git.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Remote/Git.hs')
-rw-r--r--Remote/Git.hs24
1 files changed, 20 insertions, 4 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 80e73ede9..cd38cac06 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -37,6 +37,8 @@ import Init
import Types.Key
import qualified Fields
+import Control.Concurrent
+
remote :: RemoteType
remote = RemoteType {
typename = "git",
@@ -297,13 +299,27 @@ rsyncHelper callback params = do
- filesystem. Then cp could be faster. -}
rsyncOrCopyFile :: [CommandParam] -> FilePath -> FilePath -> ProgressCallback -> Annex Bool
rsyncOrCopyFile rsyncparams src dest p =
- ifM (sameDeviceIds src dest)
- ( liftIO $ copyFileExternal src dest
- , rsyncHelper (Just p) $ rsyncparams ++ [Param src, Param dest]
- )
+ ifM (sameDeviceIds src dest) (dorsync, docopy)
where
sameDeviceIds a b = (==) <$> (getDeviceId a) <*> (getDeviceId b)
getDeviceId f = deviceID <$> liftIO (getFileStatus $ parentDir f)
+ dorsync = rsyncHelper (Just p) $
+ rsyncparams ++ [Param src, Param dest]
+ docopy = liftIO $ bracket
+ (forkIO $ watchfilesize 0)
+ (void . tryIO . killThread)
+ (const $ copyFileExternal src dest)
+ watchfilesize oldsz = do
+ threadDelay 500000 -- 0.5 seconds
+ v <- catchMaybeIO $
+ fromIntegral . fileSize
+ <$> getFileStatus dest
+ case v of
+ Just sz
+ | sz /= oldsz -> do
+ p sz
+ watchfilesize sz
+ _ -> watchfilesize oldsz
{- Generates rsync parameters that ssh to the remote and asks it
- to either receive or send the key's content. -}