summaryrefslogtreecommitdiff
path: root/Logs/Transfer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Logs/Transfer.hs')
-rw-r--r--Logs/Transfer.hs33
1 files changed, 21 insertions, 12 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index ec3e9cb26..5072ca9aa 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -103,11 +103,13 @@ download u key = runTransfer (Transfer Download u key)
{- Runs a transfer action. Creates and locks the lock file while the
- action is running, and stores info in the transfer information
- - file. Will throw an error if the transfer is already in progress.
+ - file.
-
- If the transfer action returns False, the transfer info is
- left in the failedTransferDir.
-
+ - If the transfer is already in progress, returns False.
+ -
- An upload can be run from a read-only filesystem, and in this case
- no transfer information or lock file is used.
-}
@@ -116,11 +118,14 @@ runTransfer t file shouldretry a = do
info <- liftIO $ startTransferInfo file
(meter, tfile, metervar) <- mkProgressUpdater t info
mode <- annexFileMode
- fd <- liftIO $ prep tfile mode info
- ok <- retry info metervar $
- bracketIO (return fd) (cleanup tfile) (const $ a meter)
- unless ok $ recordFailedTransfer t info
- return ok
+ (fd, cantransfer) <- liftIO $ prep tfile mode info
+ if cantransfer
+ then do
+ ok <- retry info metervar $
+ bracketIO (return fd) (cleanup tfile) (const $ a meter)
+ unless ok $ recordFailedTransfer t info
+ return ok
+ else return False
where
prep tfile mode info = do
#ifndef __WINDOWS__
@@ -128,18 +133,22 @@ runTransfer t file shouldretry a = do
openFd (transferLockFile tfile) ReadWrite (Just mode)
defaultFileFlags { trunc = True }
case mfd of
- Nothing -> return mfd
+ Nothing -> return (mfd, True)
Just fd -> do
locked <- catchMaybeIO $
setLock fd (WriteLock, AbsoluteSeek, 0, 0)
- when (isNothing locked) $
- error "transfer already in progress"
- void $ tryIO $ writeTransferInfoFile info tfile
- return mfd
+ if isNothing locked
+ then do
+ hPutStrLn stderr "transfer already in progress"
+ return (Nothing, False)
+ else do
+ void $ tryIO $ writeTransferInfoFile info tfile
+ return (mfd, True)
#else
- catchMaybeIO $ do
+ mfd <- catchMaybeIO $ do
writeFile (transferLockFile tfile) ""
writeTransferInfoFile info tfile
+ return (mfd, True)
#endif
cleanup _ Nothing = noop
cleanup tfile (Just fd) = do