git-annex/Logs/Transfer.hs

344 lines
12 KiB
Haskell
Raw Normal View History

{- git-annex transfer information files and lock files
2012-07-01 18:29:00 +00:00
-
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
2012-07-01 18:29:00 +00:00
-
- Licensed under the GNU AGPL version 3 or higher.
2012-07-01 18:29:00 +00:00
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
2012-07-01 18:29:00 +00:00
module Logs.Transfer where
import Types.Transfer
import Types.ActionItem
import Annex.Common
2012-07-01 18:29:00 +00:00
import qualified Git
2023-04-12 21:18:29 +00:00
import qualified Git.Quote
import Utility.Metered
import Utility.Percentage
import Utility.PID
import Annex.LockPool
2018-10-30 03:13:36 +00:00
import Utility.TimeStamp
import Logs.File
import qualified Utility.RawFilePath as R
#ifndef mingw32_HOST_OS
import Annex.Perms
#endif
2012-07-01 18:29:00 +00:00
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Control.Concurrent.STM
import qualified Data.ByteString.Char8 as B8
import qualified System.FilePath.ByteString as P
2012-07-01 18:29:00 +00:00
2023-04-12 21:18:29 +00:00
describeTransfer :: Git.Quote.QuotePath -> Transfer -> TransferInfo -> String
describeTransfer qp t info = unwords
[ show $ transferDirection t
, show $ transferUUID t
, decodeBS $ quote qp $ actionItemDesc $ ActionItemAssociatedFile
2019-06-06 16:53:24 +00:00
(associatedFile info)
(transferKey t)
2013-04-02 20:38:47 +00:00
, show $ bytesComplete info
]
{- Transfers that will accomplish the same task. -}
equivilantTransfer :: Transfer -> Transfer -> Bool
equivilantTransfer t1 t2
| transferDirection t1 == Download && transferDirection t2 == Download &&
transferKeyData t1 == transferKeyData t2 = True
| otherwise = t1 == t2
percentComplete :: Transfer -> TransferInfo -> Maybe Percentage
percentComplete t info =
percentage
<$> keySize (transferKeyData t)
<*> Just (fromMaybe 0 $ bytesComplete info)
{- Generates a callback that can be called as transfer progresses to update
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
- the transfer info file. Also returns an action that sets up the file with
- appropriate permissions, which should be run after locking the transfer
- lock file, but before using the callback, and a TVar that can be used to
- read the number of bytes processed so far. -}
mkProgressUpdater :: Transfer -> TransferInfo -> RawFilePath -> Annex (MeterUpdate, Annex (), TVar (Maybe BytesProcessed))
mkProgressUpdater t info tfile = do
let createtfile = void $ tryNonAsync $ writeTransferInfoFile info tfile
tvar <- liftIO $ newTVarIO Nothing
loggedtvar <- liftIO $ newTVarIO 0
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
return (liftIO . updater (fromRawFilePath tfile) tvar loggedtvar, createtfile, tvar)
2012-11-11 04:51:07 +00:00
where
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
updater tfile' tvar loggedtvar new = do
old <- atomically $ swapTVar tvar (Just new)
let oldbytes = maybe 0 fromBytesProcessed old
let newbytes = fromBytesProcessed new
when (newbytes - oldbytes >= mindelta) $ do
let info' = info { bytesComplete = Just newbytes }
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
_ <- tryIO $ updateTransferInfoFile info' tfile'
atomically $ writeTVar loggedtvar newbytes
2012-11-11 04:51:07 +00:00
{- The minimum change in bytesComplete that is worth
- updating a transfer info file for is 1% of the total
- keySize, rounded down. -}
mindelta = case keySize (transferKeyData t) of
2012-11-11 04:51:07 +00:00
Just sz -> sz `div` 100
Nothing -> 100 * 1024 -- arbitrarily, 100 kb
2012-07-01 18:29:00 +00:00
startTransferInfo :: AssociatedFile -> IO TransferInfo
startTransferInfo afile = TransferInfo
<$> (Just . utcTimeToPOSIXSeconds <$> getCurrentTime)
#ifndef mingw32_HOST_OS
<*> pure Nothing -- pid not stored in file, so omitted for speed
#else
<*> (Just <$> getPID)
#endif
<*> pure Nothing -- tid ditto
<*> pure Nothing -- not 0; transfer may be resuming
<*> pure Nothing
<*> pure afile
<*> pure False
{- If a transfer is still running, returns its TransferInfo.
-
- If no transfer is running, attempts to clean up the stale
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
- lock and info files, which can be left behind when a transfer
- process was interrupted.
-}
2012-07-01 18:29:00 +00:00
checkTransfer :: Transfer -> Annex (Maybe TransferInfo)
checkTransfer t = debugLocks $ do
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
(tfile, lck, moldlck) <- fromRepo $ transferFileAndLockFile t
let deletestale = do
void $ tryIO $ R.removeLink tfile
void $ tryIO $ R.removeLink lck
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
maybe noop (void . tryIO . R.removeLink) moldlck
#ifndef mingw32_HOST_OS
v <- getLockStatus lck
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
v' <- case (moldlck, v) of
(Nothing, _) -> pure v
(_, StatusLockedBy pid) -> pure (StatusLockedBy pid)
(Just oldlck, _) -> getLockStatus oldlck
case v' of
StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $
readTransferInfoFile (Just pid) (fromRawFilePath tfile)
_ -> do
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
mode <- annexFileMode
-- Ignore failure due to permissions, races, etc.
void $ tryIO $ tryLockExclusive (Just mode) lck >>= \case
Just lockhandle -> case moldlck of
Nothing -> liftIO $ do
deletestale
dropLock lockhandle
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
Just oldlck -> tryLockExclusive (Just mode) oldlck >>= \case
Just oldlockhandle -> liftIO $ do
deletestale
dropLock oldlockhandle
dropLock lockhandle
Nothing -> liftIO $ dropLock lockhandle
Nothing -> noop
return Nothing
#else
v <- liftIO $ lockShared lck
liftIO $ case v of
Nothing -> catchDefaultIO Nothing $
readTransferInfoFile Nothing (fromRawFilePath tfile)
Just lockhandle -> do
dropLock lockhandle
cleanstale
return Nothing
#endif
2012-07-01 18:29:00 +00:00
{- Gets all currently running transfers. -}
getTransfers :: Annex [(Transfer, TransferInfo)]
getTransfers = getTransfers' [Download, Upload] (const True)
getTransfers' :: [Direction] -> (Key -> Bool) -> Annex [(Transfer, TransferInfo)]
getTransfers' dirs wanted = do
transfers <- filter (wanted . transferKey)
<$> mapMaybe parseTransferFile . concat <$> findfiles
2012-07-01 18:29:00 +00:00
infos <- mapM checkTransfer transfers
return $ mapMaybe running $ zip transfers infos
2012-11-11 04:51:07 +00:00
where
fix empty tree import when directory does not exist Fix behavior when importing a tree from a directory remote when the directory does not exist. An empty tree was imported, rather than the import failing. Merging that tree would delete every file in the branch, if those files had been exported to the directory before. The problem was that dirContentsRecursive returned [] when the directory did not exist. Better for it to throw an exception. But in commit 74f0d67aa3988a71f3a53b88de4344272d924b95 back in 2012, I made it never theow exceptions, because exceptions throw inside unsafeInterleaveIO become untrappable when the list is being traversed. So, changed it to list the contents of the directory before entering unsafeInterleaveIO. So exceptions are thrown for the directory. But still not if it's unable to list the contents of a subdirectory. That's less of a problem, because the subdirectory does exist (or if not, it got removed after being listed, and it's ok to not include it in the list). A subdirectory that has permissions that don't allow listing it will have its contents omitted from the list still. (Might be better to have it return a type that includes indications of errors listing contents of subdirectories?) The rest of the changes are making callers of dirContentsRecursive use emptyWhenDoesNotExist when they relied on the behavior of it not throwing an exception when the directory does not exist. Note that it's possible some callers of dirContentsRecursive that used to ignore permissions problems listing a directory will now start throwing exceptions on them. The fix to the directory special remote consisted of not making its call in listImportableContentsM use emptyWhenDoesNotExist. So it will throw an exception as desired. Sponsored-by: Joshua Antonishen on Patreon
2023-08-15 16:57:41 +00:00
findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath)
=<< mapM (fromRepo . transferDir) dirs
running (t, Just i) = Just (t, i)
running (_, Nothing) = Nothing
2012-07-01 18:29:00 +00:00
{- Number of bytes remaining to download from matching downloads that are in
- progress. -}
sizeOfDownloadsInProgress :: (Key -> Bool) -> Annex Integer
sizeOfDownloadsInProgress wanted = sum . map remaining
<$> getTransfers' [Download] wanted
where
remaining (t, info) =
case (fromKey keySize (transferKey t), bytesComplete info) of
(Just sz, Just done) -> sz - done
(Just sz, Nothing) -> sz
(Nothing, _) -> 0
{- Gets failed transfers for a given remote UUID. -}
getFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]
getFailedTransfers u = catMaybes <$> (liftIO . getpairs =<< concat <$> findfiles)
2012-11-11 04:51:07 +00:00
where
getpairs = mapM $ \f -> do
let mt = parseTransferFile f
mi <- readTransferInfoFile Nothing f
return $ case (mt, mi) of
(Just t, Just i) -> Just (t, i)
_ -> Nothing
fix empty tree import when directory does not exist Fix behavior when importing a tree from a directory remote when the directory does not exist. An empty tree was imported, rather than the import failing. Merging that tree would delete every file in the branch, if those files had been exported to the directory before. The problem was that dirContentsRecursive returned [] when the directory did not exist. Better for it to throw an exception. But in commit 74f0d67aa3988a71f3a53b88de4344272d924b95 back in 2012, I made it never theow exceptions, because exceptions throw inside unsafeInterleaveIO become untrappable when the list is being traversed. So, changed it to list the contents of the directory before entering unsafeInterleaveIO. So exceptions are thrown for the directory. But still not if it's unable to list the contents of a subdirectory. That's less of a problem, because the subdirectory does exist (or if not, it got removed after being listed, and it's ok to not include it in the list). A subdirectory that has permissions that don't allow listing it will have its contents omitted from the list still. (Might be better to have it return a type that includes indications of errors listing contents of subdirectories?) The rest of the changes are making callers of dirContentsRecursive use emptyWhenDoesNotExist when they relied on the behavior of it not throwing an exception when the directory does not exist. Note that it's possible some callers of dirContentsRecursive that used to ignore permissions problems listing a directory will now start throwing exceptions on them. The fix to the directory special remote consisted of not making its call in listImportableContentsM use emptyWhenDoesNotExist. So it will throw an exception as desired. Sponsored-by: Joshua Antonishen on Patreon
2023-08-15 16:57:41 +00:00
findfiles = liftIO . mapM (emptyWhenDoesNotExist . dirContentsRecursive . fromRawFilePath)
2012-11-11 04:51:07 +00:00
=<< mapM (fromRepo . failedTransferDir u) [Download, Upload]
clearFailedTransfers :: UUID -> Annex [(Transfer, TransferInfo)]
clearFailedTransfers u = do
failed <- getFailedTransfers u
2013-09-26 03:19:01 +00:00
mapM_ (removeFailedTransfer . fst) failed
return failed
2012-09-17 18:58:43 +00:00
removeFailedTransfer :: Transfer -> Annex ()
removeFailedTransfer t = do
f <- fromRepo $ failedTransferFile t
liftIO $ void $ tryIO $ R.removeLink f
2012-09-17 18:58:43 +00:00
recordFailedTransfer :: Transfer -> TransferInfo -> Annex ()
recordFailedTransfer t info = do
failedtfile <- fromRepo $ failedTransferFile t
writeTransferInfoFile info failedtfile
fix transfer lock file for Download to not include uuid While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
2024-03-25 18:47:38 +00:00
{- The transfer information file and transfer lock file
- to use for a given Transfer.
-
- The transfer lock file used for an Upload includes the UUID.
- This allows multiple transfers of the same key to different remote
- repositories run at the same time, while preventing multiple
- transfers of the same key to the same remote repository.
-
- The transfer lock file used for a Download does not include the UUID.
- This prevents multiple transfers of the same key into the local
- repository at the same time.
-
- Since old versions of git-annex (10.20240227 and older) used to
- include the UUID in the transfer lock file for a Download, this also
- returns a second lock file for Downloads, which has to be locked
- in order to interoperate with the old git-annex processes.
- Lock order is the same as return value order.
- At some point in the future, when old git-annex processes are no longer
- a concern, this complication can be removed.
-}
transferFileAndLockFile :: Transfer -> Git.Repo -> (RawFilePath, RawFilePath, Maybe RawFilePath)
transferFileAndLockFile (Transfer direction u kd) r =
case direction of
Upload -> (transferfile, uuidlockfile, Nothing)
Download -> (transferfile, nouuidlockfile, Just uuidlockfile)
where
td = transferDir direction r
fu = B8.filter (/= '/') (fromUUID u)
kf = keyFile (mkKey (const kd))
lckkf = "lck." <> kf
transferfile = td P.</> fu P.</> kf
uuidlockfile = td P.</> fu P.</> lckkf
nouuidlockfile = td P.</> "lck" P.</> lckkf
2012-07-01 18:29:00 +00:00
{- The transfer information file to use to record a failed Transfer -}
failedTransferFile :: Transfer -> Git.Repo -> RawFilePath
failedTransferFile (Transfer direction u kd) r =
failedTransferDir u direction r
P.</> keyFile (mkKey (const kd))
2012-07-01 18:29:00 +00:00
{- Parses a transfer information filename to a Transfer. -}
parseTransferFile :: FilePath -> Maybe Transfer
parseTransferFile file
2013-04-03 07:52:41 +00:00
| "lck." `isPrefixOf` takeFileName file = Nothing
| otherwise = case drop (length bits - 3) bits of
2012-07-01 19:04:29 +00:00
[direction, u, key] -> Transfer
<$> parseDirection direction
<*> pure (toUUID u)
<*> fmap (fromKey id) (fileKey (toRawFilePath key))
2012-07-01 18:29:00 +00:00
_ -> Nothing
2012-11-11 04:51:07 +00:00
where
bits = splitDirectories file
2012-07-01 18:29:00 +00:00
writeTransferInfoFile :: TransferInfo -> RawFilePath -> Annex ()
writeTransferInfoFile info tfile = writeLogFile tfile $ writeTransferInfo info
-- The file keeps whatever permissions it has, so should be used only
-- after it's been created with the right perms by writeTransferInfoFile.
updateTransferInfoFile :: TransferInfo -> FilePath -> IO ()
updateTransferInfoFile info tfile = writeFile tfile $ writeTransferInfo info
{- File format is a header line containing the startedTime and any
- bytesComplete value. Followed by a newline and the associatedFile.
-
- On unix, the transferPid is not included; instead it is obtained
- by looking at the process that locks the file.
-
- On windows, the transferPid is included, as a second line.
-}
2012-07-01 18:29:00 +00:00
writeTransferInfo :: TransferInfo -> String
2012-07-01 19:04:29 +00:00
writeTransferInfo info = unlines
[ (maybe "" show $ startedTime info) ++
2013-04-03 07:52:41 +00:00
(maybe "" (\b -> ' ' : show b) (bytesComplete info))
#ifdef mingw32_HOST_OS
, maybe "" show (transferPid info)
#endif
-- comes last; arbitrary content
, let AssociatedFile afile = associatedFile info
in maybe "" fromRawFilePath afile
2012-07-01 18:29:00 +00:00
]
readTransferInfoFile :: Maybe PID -> FilePath -> IO (Maybe TransferInfo)
readTransferInfoFile mpid tfile = catchDefaultIO Nothing $
readTransferInfo mpid <$> readFileStrict tfile
readTransferInfo :: Maybe PID -> String -> Maybe TransferInfo
readTransferInfo mpid s = TransferInfo
<$> time
#ifdef mingw32_HOST_OS
2013-12-11 04:18:58 +00:00
<*> pure (if isJust mpid then mpid else mpid')
#else
<*> pure mpid
#endif
<*> pure Nothing
<*> pure Nothing
<*> bytes
<*> pure (AssociatedFile (if null filename then Nothing else Just (toRawFilePath filename)))
<*> pure False
2012-11-11 04:51:07 +00:00
where
#ifdef mingw32_HOST_OS
2014-01-28 18:43:20 +00:00
(firstline, otherlines) = separate (== '\n') s
(secondline, rest) = separate (== '\n') otherlines
mpid' = readish secondline
#else
(firstline, rest) = separate (== '\n') s
#endif
filename
| end rest == "\n" = beginning rest
| otherwise = rest
bits = splitc ' ' firstline
2012-11-11 04:51:07 +00:00
numbits = length bits
time = if numbits > 0
then Just <$> parsePOSIXTime =<< headMaybe bits
else pure Nothing -- not failure
bytes = if numbits > 1
then Just <$> readish =<< headMaybe (drop 1 bits)
else pure Nothing -- not failure
2012-07-19 00:48:08 +00:00
2012-08-23 17:42:13 +00:00
{- The directory holding transfer information files for a given Direction. -}
transferDir :: Direction -> Git.Repo -> RawFilePath
transferDir direction r = gitAnnexTransferDir r P.</> formatDirection direction
2012-08-23 17:42:13 +00:00
{- The directory holding failed transfer information files for a given
- Direction and UUID -}
failedTransferDir :: UUID -> Direction -> Git.Repo -> RawFilePath
failedTransferDir u direction r = gitAnnexTransferDir r
P.</> "failed"
P.</> formatDirection direction
P.</> B8.filter (/= '/') (fromUUID u)
prop_read_write_transferinfo :: TransferInfo -> Bool
prop_read_write_transferinfo info
2013-04-03 07:52:41 +00:00
| isJust (transferRemote info) = True -- remote not stored
| isJust (transferTid info) = True -- tid not stored
| otherwise = Just (info { transferPaused = False }) == info'
where
info' = readTransferInfo (transferPid info) (writeTransferInfo info)