add directional stalldetection and bwlimit configs

Sponsored-by: Dartmouth College's DANDI project

diff --git a/Annex/Import.hs b/Annex/Import.hs
index 959158466bffab447ce15c226d5fcd5601baf0b4..eaf41f4f79d5245c7aac6a0eeeae7669c8ad662e 100644 (file)
--- a/Annex/Import.hs
+++ b/Annex/Import.hs
@@ -798,7 +798,6 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
                                        , providedMimeEncoding = Nothing
                                        , providedLinkType = Nothing
                                        }
-                               let bwlimit = remoteAnnexBwLimit (Remote.gitconfig remote)
                                islargefile <- checkMatcher' matcher mi mempty
                                metered Nothing sz bwlimit $ const $ if islargefile
                                        then doimportlarge importkey cidmap loc cid sz f
@@ -895,7 +894,6 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
                        Left e -> do
                                warning (UnquotedString (show e))
                                return Nothing
-               let bwlimit = remoteAnnexBwLimit (Remote.gitconfig remote)
                checkDiskSpaceToGet tmpkey Nothing Nothing $
                        notifyTransfer Download af $
                                download' (Remote.uuid remote) tmpkey af Nothing stdRetry $ \p ->
@@ -924,6 +922,9 @@ importKeys remote importtreeconfig importcontent thirdpartypopulated importablec
                                else gitShaKey <$> hashFile tmpfile
        
        ia = Remote.importActions remote
+                               
+       bwlimit = remoteAnnexBwLimitDownload (Remote.gitconfig remote)
+                       <|> remoteAnnexBwLimit (Remote.gitconfig remote)
 
        locworktreefile loc = fromRepo $ fromTopFilePath $ asTopFilePath $
                case importtreeconfig of

diff --git a/Annex/StallDetection.hs b/Annex/StallDetection.hs
index 21b958ce58035cc2f49365510db5584de5cf2381..9b885c2ecffbaea9398d526644b0be432c01dd4f 100644 (file)
--- a/Annex/StallDetection.hs
+++ b/Annex/StallDetection.hs
@@ -5,10 +5,16 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Annex.StallDetection (detectStalls, StallDetection) where
+module Annex.StallDetection (
+       getStallDetection,
+       detectStalls,
+       StallDetection,
+) where
 
 import Annex.Common
 import Types.StallDetection
+import Types.Direction
+import Types.Remote (gitconfig)
 import Utility.Metered
 import Utility.HumanTime
 import Utility.DataUnits
@@ -18,6 +24,14 @@ import Control.Concurrent.STM
 import Control.Monad.IO.Class (MonadIO)
 import Data.Time.Clock
 
+getStallDetection :: Direction -> Remote -> Maybe StallDetection
+getStallDetection Download r = 
+       remoteAnnexStallDetectionDownload (gitconfig r)
+               <|> remoteAnnexStallDetection (gitconfig r)
+getStallDetection Upload r =
+       remoteAnnexStallDetectionUpload (gitconfig r)
+               <|> remoteAnnexStallDetection (gitconfig r)
+
 {- This may be safely canceled (with eg uninterruptibleCancel),
  - as long as the passed action can be safely canceled. -}
 detectStalls :: (Monad m, MonadIO m) => Maybe StallDetection -> TVar (Maybe BytesProcessed) -> m () -> m ()
@@ -120,7 +134,7 @@ upscale input@(BwRate minsz duration) timepassedsecs
                (Duration (ceiling (fromIntegral dsecs * scale)))
        | otherwise = input
   where
-       scale = max 1 $
+       scale = max (1 :: Double) $
                (fromIntegral timepassedsecs / fromIntegral (max dsecs 1))
                * fromIntegral allowedvariation
        

diff --git a/Annex/Transfer.hs b/Annex/Transfer.hs
index 4cc9b56e5af3dd6dbe54073456d05f94d8f79204..d31863f2b8d29ed97e1d2ad2a8a3ff0204bc30d2 100644 (file)
--- a/Annex/Transfer.hs
+++ b/Annex/Transfer.hs
@@ -56,7 +56,7 @@ import Data.Ord
 -- Upload, supporting canceling detected stalls.
 upload :: Remote -> Key -> AssociatedFile -> RetryDecider -> NotifyWitness -> Annex Bool
 upload r key f d witness = 
-       case remoteAnnexStallDetection (Remote.gitconfig r) of
+       case getStallDetection Upload r of
                Nothing -> go (Just ProbeStallDetection)
                Just StallDetectionDisabled -> go Nothing
                Just sd -> runTransferrer sd r key f d Upload witness
@@ -75,7 +75,7 @@ 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 = 
-       case remoteAnnexStallDetection (Remote.gitconfig r) of
+       case getStallDetection Download r of
                Nothing -> go (Just ProbeStallDetection)
                Just StallDetectionDisabled -> go Nothing
                Just sd -> runTransferrer sd r key f d Download witness

diff --git a/Assistant/TransferSlots.hs b/Assistant/TransferSlots.hs
index bf14118f64ed8ff4f022207b4ce1d71e8276b448..c16871f4684e7830eb7e946e3d0891daf6698613 100644 (file)
--- a/Assistant/TransferSlots.hs
+++ b/Assistant/TransferSlots.hs
@@ -33,6 +33,7 @@ import qualified Remote
 import qualified Types.Remote as Remote
 import Annex.Content
 import Annex.Wanted
+import Annex.StallDetection
 import Utility.Batch
 import Types.NumCopies
 
@@ -126,8 +127,7 @@ genTransfer t info = case transferRemote info of
                                qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig
                                debug [ "Transferring:" , describeTransfer qp t info ]
                                notifyTransfer
-                               let sd = remoteAnnexStallDetection
-                                       (Remote.gitconfig remote)
+                               let sd = getStallDetection (transferDirection t) remote
                                return $ Just (t, info, go remote sd)
                        , do
                                qp <- liftAnnex $ coreQuotePath <$> Annex.getGitConfig

diff --git a/CHANGELOG b/CHANGELOG
index c38ba6ecb57f5e80034373247a2ae5f06690e278..e01b60df1b8aae817e2e635ccb8227dd6800bbb0 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -18,6 +18,9 @@ git-annex (10.20231228) UNRELEASED; urgency=medium
   * external: Monitor file size when getting content from external
     special remotes and use that to update the progress meter,
     in case the external special remote program does not report progress.
+  * Added configs annex.stalldetection-download, annex.stalldetection-upload,
+    annex.bwlimit-download, annex.bwlimit-upload,
+    and similar per-remote configs.
 
  -- Joey Hess <id@joeyh.name>  Fri, 29 Dec 2023 11:52:06 -0400
 

diff --git a/Remote/Git.hs b/Remote/Git.hs
index f7fe1f9199326ded070a0d10fb1e6e5d5759e8cc..bba505e3788d50e7f45ff0b30e803d3a925f67c1 100644 (file)
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -484,7 +484,8 @@ copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc
        | not $ Git.repoIsUrl repo = guardUsable repo (giveup "cannot access remote") $ do
                u <- getUUID
                hardlink <- wantHardLink
-               let bwlimit = remoteAnnexBwLimit (gitconfig r)
+               let bwlimit = remoteAnnexBwLimitDownload (gitconfig r)
+                       <|> remoteAnnexBwLimit (gitconfig r)
                -- run copy from perspective of remote
                onLocalFast st $ Annex.Content.prepSendAnnex' key >>= \case
                        Just (object, _sz, check) -> do
@@ -552,7 +553,8 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
                checkio <- Annex.withCurrentState check
                u <- getUUID
                hardlink <- wantHardLink
-               let bwlimit = remoteAnnexBwLimit (gitconfig r)
+               let bwlimit = remoteAnnexBwLimitUpload (gitconfig r)
+                       <|> remoteAnnexBwLimit (gitconfig r)
                -- run copy from perspective of remote
                res <- onLocalFast st $ ifM (Annex.Content.inAnnex key)
                        ( return True

diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs
index c76f4d4d02f2f244fd5e2e73698e2ea0f47fef82..ed9d3bffa4dbb92fc420d3893b6eeaf748b2304b 100644 (file)
--- a/Remote/Helper/P2P.hs
+++ b/Remote/Helper/P2P.hs
@@ -35,7 +35,7 @@ type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) ->
 store :: RemoteGitConfig -> ProtoRunner Bool -> Key -> AssociatedFile -> MeterUpdate -> Annex ()
 store gc runner k af p = do
        let sizer = KeySizer k (fmap (toRawFilePath . fst3) <$> prepSendAnnex k)
-       let bwlimit = remoteAnnexBwLimit gc
+       let bwlimit = remoteAnnexBwLimitUpload gc <|> remoteAnnexBwLimit gc
        metered (Just p) sizer bwlimit $ \_ p' ->
                runner (P2P.put k af p') >>= \case
                        Just True -> return ()
@@ -45,7 +45,7 @@ store gc runner k af p = do
 retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 retrieve gc runner k af dest p verifyconfig = do
        iv <- startVerifyKeyContentIncrementally verifyconfig k
-       let bwlimit = remoteAnnexBwLimit gc
+       let bwlimit = remoteAnnexBwLimitDownload gc <|> remoteAnnexBwLimit gc
        metered (Just p) k bwlimit $ \m p' -> 
                runner (P2P.get dest k iv af m p') >>= \case
                        Just (True, v) -> return v

diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs
index 5b86df46d8bd46702ff668db7395e7b893dccb10..4cb61241599f3a87d2602537f18d21f9b3c7fb35 100644 (file)
--- a/Remote/Helper/Special.hs
+++ b/Remote/Helper/Special.hs
@@ -212,9 +212,9 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
                        then whereisKey baser
                        else Nothing
                , exportActions = (exportActions baser)
-                       { storeExport = \f k l p -> displayprogress p k (Just f) $
+                       { storeExport = \f k l p -> displayprogress uploadbwlimit p k (Just f) $
                                storeExport (exportActions baser) f k l
-                       , retrieveExport = \k l f p -> displayprogress p k Nothing $
+                       , retrieveExport = \k l f p -> displayprogress downloadbwlimit p k Nothing $
                                retrieveExport (exportActions baser) k l f
                        }
                }
@@ -223,7 +223,7 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 
        -- chunk, then encrypt, then feed to the storer
        storeKeyGen k p enc = sendAnnex k rollback $ \src _sz ->
-               displayprogress p k (Just src) $ \p' ->
+               displayprogress uploadbwlimit p k (Just src) $ \p' ->
                        storeChunks (uuid baser) chunkconfig enck k src p'
                                enc encr storer checkpresent
          where
@@ -232,7 +232,7 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 
        -- call retriever to get chunks; decrypt them; stream to dest file
        retrieveKeyFileGen k dest p vc enc =
-               displayprogress p k Nothing $ \p' ->
+               displayprogress downloadbwlimit p k Nothing $ \p' ->
                        retrieveChunks retriever (uuid baser) vc
                                chunkconfig enck k dest p' enc encr
          where
@@ -250,9 +250,13 @@ specialRemote' cfg c storer retriever remover checkpresent baser = encr
 
        chunkconfig = chunkConfig cfg
 
-       displayprogress p k srcfile a
+       downloadbwlimit = remoteAnnexBwLimitDownload (gitconfig baser)
+               <|> remoteAnnexBwLimit (gitconfig baser)
+       uploadbwlimit = remoteAnnexBwLimitUpload (gitconfig baser)
+               <|> remoteAnnexBwLimit (gitconfig baser)
+
+       displayprogress bwlimit p k srcfile a
                | displayProgress cfg = do
-                       let bwlimit = remoteAnnexBwLimit (gitconfig baser)
                        metered (Just p) (KeySizer k (pure (fmap toRawFilePath srcfile))) bwlimit (const a)
                | otherwise = a p
 

diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index 0c531fbf06e8be5a9e04d8240a9960e5d872dd8c..d2bf3cf1cd9372b80ac73b2764ba501d76837a55 100644 (file)
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -1,6 +1,6 @@
 {- git-annex configuration
  -
- - Copyright 2012-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -359,7 +359,11 @@ data RemoteGitConfig = RemoteGitConfig
        , remoteAnnexForwardRetry :: Maybe Integer
        , remoteAnnexRetryDelay :: Maybe Seconds
        , remoteAnnexStallDetection :: Maybe StallDetection
+       , remoteAnnexStallDetectionUpload :: Maybe StallDetection
+       , remoteAnnexStallDetectionDownload :: Maybe StallDetection
        , remoteAnnexBwLimit :: Maybe BwRate
+       , remoteAnnexBwLimitUpload :: Maybe BwRate
+       , remoteAnnexBwLimitDownload :: Maybe BwRate
        , remoteAnnexAllowUnverifiedDownloads :: Bool
        , remoteAnnexConfigUUID :: Maybe UUID
 
@@ -426,11 +430,17 @@ extractRemoteGitConfig r remotename = do
                , remoteAnnexRetryDelay = Seconds
                        <$> getmayberead "retrydelay"
                , remoteAnnexStallDetection =
-                       either (const Nothing) Just . parseStallDetection
-                               =<< getmaybe "stalldetection"
-               , remoteAnnexBwLimit = do
-                       sz <- readSize dataUnits =<< getmaybe "bwlimit"
-                       return (BwRate sz (Duration 1))
+                       readStallDetection =<< getmaybe "stalldetection"
+               , remoteAnnexStallDetectionUpload =
+                       readStallDetection =<< getmaybe "stalldetection-upload"
+               , remoteAnnexStallDetectionDownload =
+                       readStallDetection =<< getmaybe "stalldetection-download"
+               , remoteAnnexBwLimit =
+                       readBwRatePerSecond =<< getmaybe "bwlimit"
+               , remoteAnnexBwLimitUpload =
+                       readBwRatePerSecond =<< getmaybe "bwlimit-upload"
+               , remoteAnnexBwLimitDownload =
+                       readBwRatePerSecond =<< getmaybe "bwlimit-download"
                , remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $
                        getmaybe ("security-allow-unverified-downloads")
                , remoteAnnexConfigUUID = toUUID <$> getmaybe "config-uuid"

diff --git a/Types/StallDetection.hs b/Types/StallDetection.hs
index 13d88699f2e2cc232816e0aa3ca2ca52d4dede4a..2278119f4ef96821037ce58ce97b2e2c141a66cb 100644 (file)
--- a/Types/StallDetection.hs
+++ b/Types/StallDetection.hs
@@ -1,6 +1,6 @@
 {- types for stall detection and banwdith rates
  -
- - Copyright 2020-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2020-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -39,6 +39,9 @@ parseStallDetection s = case isTrueFalse s of
        Just True -> Right ProbeStallDetection
        Just False -> Right StallDetectionDisabled
 
+readStallDetection :: String -> Maybe StallDetection
+readStallDetection = either (const Nothing) Just . parseStallDetection
+
 parseBwRate :: String -> Either String BwRate
 parseBwRate s = do
        let (bs, ds) = separate (== '/') s
@@ -48,3 +51,8 @@ parseBwRate s = do
                (readSize dataUnits bs)
        d <- parseDuration ds
        Right (BwRate b d)
+
+readBwRatePerSecond :: String -> Maybe BwRate
+readBwRatePerSecond s = do
+       sz <- readSize dataUnits s
+       return (BwRate sz (Duration 1))

diff --git a/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment b/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment
index e4e56806bb8af036249ef5d14dafb74bf8ac7143..993ea416a15c7161360cfcf6a57399dac07b592c 100644 (file)
--- a/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment
+++ b/doc/bugs/too_aggressive_in_claiming___34__Transfer_stalled__34____63__/comment_5_9fc2d7f4b39615e43bce3993e0a6e647._comment
@@ -15,8 +15,11 @@ downloads but allow slow uploads. For example, `git-annex get` with
 the content on several remotes, where the download speed from one
 remote is often fast but occasionally slows down, and another remote
 is consistently medium speed.
-So you might set "10gb/1m" for that remote, knowing that if it is slow
-it will abort the download from it and fall back to the medium speed remote.
-But when sending content *to* the variable speed remote, would not want to
-give up only because it was a little slow.
+
+So you might set "10gb/1m" for downloads from remote, knowing that if it is
+slow it will abort the download from it and fall back to the medium speed
+remote. But when sending content *to* the variable speed remote, would not
+want to give up only because it was a little slow.
+
+Ok, added annex.stalldetection-download, annex.stalldetection-upload, etc.
 """]]

diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 37f7de0b942c2468af4c17650a8d718ca7aa25cf..7b895701e479eaeab03a4da54e4a22eb8d72e1bd 100644 (file)
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1521,7 +1521,19 @@ Remotes are configured using these settings in `.git/config`.
   for remotes where the transfer is run by a separate program than
   git-annex. 
 
-* `remote.<name>.annex-stalldetecton`, `annex.stalldetection`
+* `remote.<name>.annex-bwlimit-download`, `annex.bwlimit-download`
+
+  Limit bandwith for downloads from a remote.
+  
+  Overrides `remote.<name>.annex-bwlimit` and `annex.bwlimit`
+
+* `remote.<name>.annex-bwlimit-upload`, `annex.bwlimit-upload`
+  
+  Limit bandwith for uploads to a remote. 
+
+  Overrides `remote.<name>.annex-bwlimit` and `annex.bwlimit`
+
+* `remote.<name>.annex-stalldetection`, `annex.stalldetection`
 
   Configuring this lets stalled or too-slow transfers be detected, and
   dealt with, so rather than getting stuck, git-annex will cancel the
@@ -1567,6 +1579,24 @@ Remotes are configured using these settings in `.git/config`.
   connections to a remote than usual, or the communication with those
   processes may make it a bit slower.
 
+* `remote.<name>.annex-stalldetection-download`, `annex.stalldetection-download`
+
+  Stall detection for downloads from a remote.
+ 
+  For example, if a remote is often fast, but sometimes is very slow,
+  and there is another remote that is consistently medium speed
+  and that contains the same data, this could be set to treat the fast
+  remote as stalled when it's slow. Then a command like `git-annex get`
+  will fall back to downloading from the medium speed remote.
+
+  Overrides `remote.<name>.annex-stalldetection`, `annex.stalldetection`
+
+* `remote.<name>.annex-stalldetection-upload`, `annex.stalldetection-upload`
+
+  Stall detection for uploads to a remote.
+
+  Overrides `remote.<name>.annex-stalldetection`, `annex.stalldetection`
+
 * `remote.<name>.annex-checkuuid`
 
   This only affects remotes that have their url pointing to a directory on