mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

simplify annex.stalldetection handling

Browse source 
RemoteGitConfig parsing looks for annex.stalldetection when a remote
does not have a per-remote config for it, so no need for a separate
gobal config.

Sponsored-by: Noam Kremen on Patreon
This commit is contained in:
Joey Hess 2021-09-22 10:46:10 -04:00
parent 55b405a965
commit 4fef94d764
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 12 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
Annex/Transfer.hs
View file

@ -19,7 +19,6 @@ module Annex.Transfer (
noRetry,
stdRetry,
pickRemote,
stallDetection,
) where
import Annex.Common
@ -55,10 +54,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
@ -73,10 +73,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
@ -400,9 +401,3 @@ lessActiveFirst :: M.Map Remote Integer -> Remote -> Remote -> Ordering
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

4
Assistant/TransferSlots.hs
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:",

4
Types/GitConfig.hs
View file

@ -123,7 +123,6 @@ data GitConfig = GitConfig
, annexRetry :: Maybe Integer
, annexForwardRetry :: Maybe Integer
, annexRetryDelay :: Maybe Seconds
, annexStallDetection :: Maybe StallDetection
, annexAllowedUrlSchemes :: S.Set Scheme
, annexAllowedIPAddresses :: String
, annexAllowUnverifiedDownloads :: Bool
@ -217,9 +216,6 @@ extractGitConfig configsource r = GitConfig
, annexForwardRetry = getmayberead (annexConfig "forward-retry")
, annexRetryDelay = Seconds
<$> getmayberead (annexConfig "retrydelay")
, annexStallDetection =
either (const Nothing) id . parseStallDetection
=<< getmaybe (annexConfig "stalldetection")
, annexAllowedUrlSchemes = S.fromList $ map mkScheme $
maybe ["http", "https", "ftp"] words $
getmaybe (annexConfig "security.allowed-url-schemes")