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
Download patch file Download diff file Expand all files Collapse all files

13
Annex/Transfer.hs
View file

@ -19,7 +19,6 @@ module Annex.Transfer (
noRetry, noRetry,
stdRetry, stdRetry,
pickRemote, pickRemote,
stallDetection,
) where ) where
import Annex.Common import Annex.Common
@ -55,7 +54,8 @@ import Data.Ord
-- Upload, supporting canceling detected stalls. -- Upload, supporting canceling detected stalls.
upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
upload r key f d witness = stallDetection r >>= \case upload r key f d witness =
case remoteAnnexStallDetection (Remote.gitconfig r) of
Nothing -> go (Just ProbeStallDetection) Nothing -> go (Just ProbeStallDetection)
Just StallDetectionDisabled -> go Nothing Just StallDetectionDisabled -> go Nothing
Just sd -> runTransferrer sd r key f d Upload witness Just sd -> runTransferrer sd r key f d Upload witness
@ -73,7 +73,8 @@ alwaysUpload u key f sd d a _witness = guardHaveUUID u $
-- Download, supporting canceling detected stalls. -- Download, supporting canceling detected stalls.
download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool download :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
download r key f d witness = logStatusAfter key $ stallDetection r >>= \case download r key f d witness = logStatusAfter key $
case remoteAnnexStallDetection (Remote.gitconfig r) of
Nothing -> go (Just ProbeStallDetection) Nothing -> go (Just ProbeStallDetection)
Just StallDetectionDisabled -> go Nothing Just StallDetectionDisabled -> go Nothing
Just sd -> runTransferrer sd r key f d Download witness Just sd -> runTransferrer sd r key f d Download witness
@ -400,9 +401,3 @@ lessActiveFirst :: M.Map Remote Integer -> Remote -> Remote -> Ordering
lessActiveFirst active a b lessActiveFirst active a b
| Remote.cost a == Remote.cost b = comparing (`M.lookup` active) a b | Remote.cost a == Remote.cost b = comparing (`M.lookup` active) a b
| otherwise = comparing Remote.cost 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.Alert.Utility
import Assistant.Commits import Assistant.Commits
import Assistant.Drop import Assistant.Drop
import Annex.Transfer (stallDetection)
import Types.Transfer import Types.Transfer
import Logs.Transfer import Logs.Transfer
import Logs.Location import Logs.Location
@ -126,7 +125,8 @@ genTransfer t info = case transferRemote info of
( do ( do
debug [ "Transferring:" , describeTransfer t info ] debug [ "Transferring:" , describeTransfer t info ]
notifyTransfer notifyTransfer
sd <- liftAnnex $ stallDetection remote let sd = remoteAnnexStallDetection
(Remote.gitconfig remote)
return $ Just (t, info, go remote sd) return $ Just (t, info, go remote sd)
, do , do
debug [ "Skipping unnecessary transfer:", debug [ "Skipping unnecessary transfer:",

4
Types/GitConfig.hs
View file

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