nasty race workaround

This commit is contained in:
Joey Hess 2012-10-19 16:59:18 -04:00
parent 40aab719df
commit 73c28d2ca7

View file

@ -18,6 +18,8 @@ import Utility.DirWatcher
import Utility.Types.DirWatcher
import qualified Remote
import Control.Concurrent
thisThread :: ThreadName
thisThread = "TransferWatcher"
@ -103,7 +105,13 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of
, show t
]
minfo <- removeTransfer dstatus t
finishedTransfer st dstatus transferqueue t minfo
void $ forkIO $ do
{- XXX race workaround delay. The location
- log needs to be updated before finishedTransfer
- runs. -}
threadDelay 10000000 -- 10 seconds
finishedTransfer st dstatus transferqueue t minfo
{- Queue uploads of files we successfully downloaded, spreading them
- out to other reachable remotes.