Merge branch 'master' into bwlimit
This commit is contained in:
commit
05a097cde8
9 changed files with 70 additions and 33 deletions
|
@ -15,6 +15,8 @@ import Utility.CopyFile
|
|||
import Utility.FileMode
|
||||
import Utility.Touch
|
||||
import Utility.Hash (IncrementalVerifier(..))
|
||||
import Annex.Tmp
|
||||
import Utility.Tmp
|
||||
|
||||
import Control.Concurrent
|
||||
import qualified Data.ByteString as S
|
||||
|
@ -28,23 +30,34 @@ newCopyCoWTried :: IO CopyCoWTried
|
|||
newCopyCoWTried = CopyCoWTried <$> newEmptyMVar
|
||||
|
||||
{- Copies a file is copy-on-write is supported. Otherwise, returns False. -}
|
||||
tryCopyCoW :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> IO Bool
|
||||
tryCopyCoW :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> Annex Bool
|
||||
tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate =
|
||||
-- If multiple threads reach this at the same time, they
|
||||
-- will both try CoW, which is acceptable.
|
||||
ifM (isEmptyMVar copycowtried)
|
||||
ifM (liftIO $ isEmptyMVar copycowtried)
|
||||
( do
|
||||
ok <- docopycow
|
||||
void $ tryPutMVar copycowtried ok
|
||||
void $ liftIO $ tryPutMVar copycowtried ok
|
||||
return ok
|
||||
, ifM (readMVar copycowtried)
|
||||
, ifM (liftIO $ readMVar copycowtried)
|
||||
( docopycow
|
||||
, return False
|
||||
)
|
||||
)
|
||||
where
|
||||
docopycow = watchFileSize dest meterupdate $
|
||||
copyCoW CopyTimeStamps src dest
|
||||
-- copyCow needs a destination file that does not exist,
|
||||
-- but the dest file might already. So use it with another
|
||||
-- temp file, and if it succeeds, rename it into place. If it fails,
|
||||
-- the dest file is left as-is, to support resuming.
|
||||
docopycow = withOtherTmp $ \othertmp -> liftIO $
|
||||
withTmpFileIn (fromRawFilePath othertmp) (takeFileName dest) $ \tmpdest _h -> do
|
||||
copied <- watchFileSize tmpdest meterupdate $
|
||||
copyCoW CopyTimeStamps src tmpdest
|
||||
if copied
|
||||
then liftIO $ catchBoolIO $ do
|
||||
rename tmpdest dest
|
||||
return True
|
||||
else return False
|
||||
|
||||
data CopyMethod = CopiedCoW | Copied
|
||||
|
||||
|
@ -70,7 +83,7 @@ fileCopier :: CopyCoWTried -> FilePath -> FilePath -> MeterUpdate -> Maybe Incre
|
|||
fileCopier _ src dest meterupdate iv = docopy
|
||||
#else
|
||||
fileCopier copycowtried src dest meterupdate iv =
|
||||
ifM (liftIO $ tryCopyCoW copycowtried src dest meterupdate)
|
||||
ifM (tryCopyCoW copycowtried src dest meterupdate)
|
||||
( do
|
||||
liftIO $ maybe noop unableIncremental iv
|
||||
return CopiedCoW
|
||||
|
|
|
@ -19,7 +19,6 @@ module Annex.Transfer (
|
|||
noRetry,
|
||||
stdRetry,
|
||||
pickRemote,
|
||||
stallDetection,
|
||||
bwLimit,
|
||||
) where
|
||||
|
||||
|
@ -56,10 +55,11 @@ import Data.Ord
|
|||
|
||||
-- Upload, supporting canceling detected stalls.
|
||||
upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
|
||||
upload r key f d witness = stallDetection r >>= \case
|
||||
Nothing -> go (Just ProbeStallDetection)
|
||||
Just StallDetectionDisabled -> go Nothing
|
||||
Just sd -> runTransferrer sd r key f d Upload witness
|
||||
upload r key f d witness =
|
||||
case remoteAnnexStallDetection (Remote.gitconfig r) of
|
||||
Nothing -> go (Just ProbeStallDetection)
|
||||
Just StallDetectionDisabled -> go Nothing
|
||||
Just sd -> runTransferrer sd r key f d Upload witness
|
||||
where
|
||||
go sd = upload' (Remote.uuid r) key f sd d (action . Remote.storeKey r key f) witness
|
||||
|
||||
|
@ -74,10 +74,11 @@ alwaysUpload u key f sd d a _witness = guardHaveUUID u $
|
|||
|
||||
-- Download, supporting canceling detected stalls.
|
||||
download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
|
||||
download r key f d witness = logStatusAfter key $ stallDetection r >>= \case
|
||||
Nothing -> go (Just ProbeStallDetection)
|
||||
Just StallDetectionDisabled -> go Nothing
|
||||
Just sd -> runTransferrer sd r key f d Download witness
|
||||
download r key f d witness = logStatusAfter key $
|
||||
case remoteAnnexStallDetection (Remote.gitconfig r) of
|
||||
Nothing -> go (Just ProbeStallDetection)
|
||||
Just StallDetectionDisabled -> go Nothing
|
||||
Just sd -> runTransferrer sd r key f d Download witness
|
||||
where
|
||||
go sd = getViaTmp (Remote.retrievalSecurityPolicy r) vc key f $ \dest ->
|
||||
download' (Remote.uuid r) key f sd d (go' dest) witness
|
||||
|
@ -402,12 +403,6 @@ lessActiveFirst active a b
|
|||
| Remote.cost a == Remote.cost b = comparing (`M.lookup` active) a b
|
||||
| otherwise = comparing Remote.cost a b
|
||||
|
||||
stallDetection :: Remote -> Annex (Maybe StallDetection)
|
||||
stallDetection r = maybe globalcfg (pure . Just) remotecfg
|
||||
where
|
||||
globalcfg = annexStallDetection <$> Annex.getGitConfig
|
||||
remotecfg = remoteAnnexStallDetection $ Remote.gitconfig r
|
||||
|
||||
bwLimit :: RemoteGitConfig -> Annex (Maybe BwRate)
|
||||
bwLimit gc = maybe globalcfg (pure . Just) remotecfg
|
||||
where
|
||||
|
|
|
@ -24,7 +24,6 @@ import Assistant.Alert
|
|||
import Assistant.Alert.Utility
|
||||
import Assistant.Commits
|
||||
import Assistant.Drop
|
||||
import Annex.Transfer (stallDetection)
|
||||
import Types.Transfer
|
||||
import Logs.Transfer
|
||||
import Logs.Location
|
||||
|
@ -126,7 +125,8 @@ genTransfer t info = case transferRemote info of
|
|||
( do
|
||||
debug [ "Transferring:" , describeTransfer t info ]
|
||||
notifyTransfer
|
||||
sd <- liftAnnex $ stallDetection remote
|
||||
let sd = remoteAnnexStallDetection
|
||||
(Remote.gitconfig remote)
|
||||
return $ Just (t, info, go remote sd)
|
||||
, do
|
||||
debug [ "Skipping unnecessary transfer:",
|
||||
|
|
|
@ -2,8 +2,13 @@ git-annex (8.20210904) UNRELEASED; urgency=medium
|
|||
|
||||
* Added annex.bwlimit and remote.name.annex-bwlimit config that works
|
||||
for git remotes and many but not all special remotes.
|
||||
* Bug fix: Git configs such as annex.verify were incorrectly overriding
|
||||
per-remote git configs such as remote.name.annex-verify.
|
||||
(Reversion in version 4.20130323)
|
||||
* borg: Avoid trying to extract xattrs, ACLS, and bsdflags when
|
||||
retrieving from a borg repository.
|
||||
* Resume where it left off when copying a file to/from a local git remote
|
||||
was interrupted.
|
||||
|
||||
-- Joey Hess <id@joeyh.name> Fri, 03 Sep 2021 12:02:55 -0400
|
||||
|
||||
|
|
|
@ -412,7 +412,7 @@ retrieveExportWithContentIdentifierM dir cow loc cid dest mkkey p =
|
|||
f = exportPath dir loc
|
||||
f' = fromRawFilePath f
|
||||
|
||||
docopy = ifM (liftIO $ tryCopyCoW cow f' dest p)
|
||||
docopy = ifM (tryCopyCoW cow f' dest p)
|
||||
( do
|
||||
k <- mkkey
|
||||
postcheckcow (return k)
|
||||
|
|
|
@ -123,7 +123,6 @@ data GitConfig = GitConfig
|
|||
, annexRetry :: Maybe Integer
|
||||
, annexForwardRetry :: Maybe Integer
|
||||
, annexRetryDelay :: Maybe Seconds
|
||||
, annexStallDetection :: Maybe StallDetection
|
||||
, annexBwLimit :: Maybe BwRate
|
||||
, annexAllowedUrlSchemes :: S.Set Scheme
|
||||
, annexAllowedIPAddresses :: String
|
||||
|
@ -218,9 +217,6 @@ extractGitConfig configsource r = GitConfig
|
|||
, annexForwardRetry = getmayberead (annexConfig "forward-retry")
|
||||
, annexRetryDelay = Seconds
|
||||
<$> getmayberead (annexConfig "retrydelay")
|
||||
, annexStallDetection =
|
||||
either (const Nothing) Just . parseStallDetection
|
||||
=<< getmaybe (annexConfig "stalldetection")
|
||||
, annexBwLimit =
|
||||
either (const Nothing) Just . parseBwRate
|
||||
=<< getmaybe (annexConfig "bwlimit")
|
||||
|
@ -448,8 +444,10 @@ extractRemoteGitConfig r remotename = do
|
|||
getmaybebool k = Git.Config.isTrueFalse' =<< getmaybe' k
|
||||
getmayberead k = readish =<< getmaybe k
|
||||
getmaybe = fmap fromConfigValue . getmaybe'
|
||||
getmaybe' k = mplus (Git.Config.getMaybe (annexConfig k) r)
|
||||
(Git.Config.getMaybe (remoteAnnexConfig remotename k) r)
|
||||
getmaybe' k =
|
||||
Git.Config.getMaybe (remoteAnnexConfig remotename k) r
|
||||
<|>
|
||||
Git.Config.getMaybe (annexConfig k) r
|
||||
getoptions k = fromMaybe [] $ words <$> getmaybe k
|
||||
|
||||
notempty :: Maybe String -> Maybe String
|
||||
|
|
|
@ -56,11 +56,13 @@ copyFileExternal meta src dest = do
|
|||
| otherwise = copyMetaDataParams meta
|
||||
|
||||
{- When a filesystem supports CoW (and cp does), uses it to make
|
||||
- an efficient copy of a file. Otherwise, returns False. -}
|
||||
- an efficient copy of a file. Otherwise, returns False.
|
||||
-
|
||||
- The dest file must not exist yet, or it will fail to make a CoW copy,
|
||||
- and will return False. -}
|
||||
copyCoW :: CopyMetaData -> FilePath -> FilePath -> IO Bool
|
||||
copyCoW meta src dest
|
||||
| BuildInfo.cp_reflink_supported = do
|
||||
void $ tryIO $ removeFile dest
|
||||
-- When CoW is not supported, cp will complain to stderr,
|
||||
-- so have to discard its stderr.
|
||||
ok <- catchBoolIO $ withNullHandle $ \nullh ->
|
||||
|
|
|
@ -0,0 +1,21 @@
|
|||
A copy --to a local git remote that gets interrupted and is run again does
|
||||
not resume where it left off, but copies all the data again.
|
||||
|
||||
This does not affect git remotes accessed over ssh.
|
||||
|
||||
It's kind of hard to notice this, because normally a resume, has to read
|
||||
the src file and dest file, in order for incremental verification to
|
||||
get started. But it is somewhat slower to do that than it is to re-write
|
||||
the dest file from the start. And when annex.verify = false, it's a lot
|
||||
slower.
|
||||
|
||||
Looks like it's due to copyCoW unlinking the dest file. Since the first
|
||||
file copy trues copyCoW to probe if that's supported, that happens.
|
||||
And when resuming an interrupted copy, that probe will generally happen
|
||||
with the file it was interrupted on.
|
||||
|
||||
So, the solution seems like it would be to copyCoW to some other temp file,
|
||||
and if it succeeds, rename it to the dest.
|
||||
--[[Joey]]
|
||||
|
||||
> [[fixed|done]] --[[Joey]]
|
|
@ -9,3 +9,6 @@ second when it's running too fast. The way the progress reporting interface
|
|||
works, it will probably work to put the delay in there. --[[Joey]]
|
||||
|
||||
[[confirmed]]
|
||||
|
||||
> Implmentation in progress in the `bwlimit` branch. Seems to work, but see
|
||||
> commit message for what still needs to be done. --[[Joey]]
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue