diff options
| -rw-r--r-- | Assistant/Threads/TransferPoller.hs | 3 | ||||
| -rw-r--r-- | Remote/Git.hs | 24 |
2 files changed, 22 insertions, 5 deletions
diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs index e31dfb40c..f8f9388f0 100644 --- a/Assistant/Threads/TransferPoller.hs +++ b/Assistant/Threads/TransferPoller.hs @@ -45,5 +45,6 @@ transferPollerThread st dstatus = thread $ do when (bytesComplete info /= sz && isJust sz) $ alterTransferInfo dstatus t $ \i -> i { bytesComplete = sz } - {- can't poll uploads -} + {- Can't poll uploads, instead the upload code + - updates the files. -} | otherwise = noop 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. -} |