diff options
| -rw-r--r-- | Remote/Git.hs | 9 | ||||
| -rw-r--r-- | Remote/Helper/Ssh.hs | 9 |
2 files changed, 9 insertions, 9 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index 4498ec907..bf2228c49 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -390,6 +390,7 @@ copyFromRemote' r key file dest Just (cmd, params) <- Ssh.git_annex_shell (repo r) "transferinfo" [Param $ key2file key] fields v <- liftIO (newEmptySV :: IO (MSampleVar Integer)) + pidv <- liftIO $ newEmptyMVar tid <- liftIO $ forkIO $ void $ tryIO $ do bytes <- readSV v p <- createProcess $ @@ -397,6 +398,7 @@ copyFromRemote' r key file dest { std_in = CreatePipe , std_err = CreatePipe } + putMVar pidv (processHandle p) hClose $ stderrHandle p let h = stdinHandle p let send b = do @@ -406,7 +408,12 @@ copyFromRemote' r key file dest forever $ send =<< readSV v let feeder = writeSV v . fromBytesProcessed - bracketIO noop (const $ tryIO $ killThread tid) (const $ a feeder) + let cleanup = do + void $ tryIO $ killThread tid + tryNonAsync $ + maybe noop (void . waitForProcess) + =<< tryTakeMVar pidv + bracketIO noop (const cleanup) (const $ a feeder) copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool #ifndef mingw32_HOST_OS diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index e0199dca3..05a98865f 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -102,20 +102,13 @@ dropKey r key = onRemote r (boolSystem, False) "dropkey" rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool rsyncHelper callback params = do showOutput -- make way for progress bar - ok <- ifM (liftIO $ (maybe rsync rsyncProgress callback) params) + ifM (liftIO $ (maybe rsync rsyncProgress callback) params) ( return True , do showLongNote "rsync failed -- run git annex again to resume file transfer" return False ) - {- For an unknown reason, this causes rsync to run a second - - ssh process, which it neglects to wait on. - - Reap the resulting zombie. -} - liftIO reapZombies - - return ok - {- Generates rsync parameters that ssh to the remote and asks it - to either receive or send the key's content. -} rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam] |