diff options
Diffstat (limited to 'Logs/Transfer.hs')
| -rw-r--r-- | Logs/Transfer.hs | 33 |
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 |