Merge branch 'master' into bwlimit

This commit is contained in:
Joey Hess 2021-09-22 10:48:27 -04:00
commit 05a097cde8
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 70 additions and 33 deletions

View file

@ -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

View file

@ -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

View file

@ -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:",

View file

@ -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

View file

@ -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)

View file

@ -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

View file

@ -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 ->

View file

@ -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]]

View file

@ -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]]