summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex.hs2
-rw-r--r--Annex/SpecialRemote.hs4
-rw-r--r--Assistant/DaemonStatus.hs7
-rw-r--r--Assistant/MakeRemote.hs4
-rw-r--r--Assistant/Sync.hs5
-rw-r--r--CHANGELOG6
-rw-r--r--Command/EnableRemote.hs9
-rw-r--r--Command/InitRemote.hs4
-rw-r--r--Command/Sync.hs17
-rw-r--r--Config/DynamicConfig.hs44
-rw-r--r--Remote.hs17
-rw-r--r--Remote/GCrypt.hs12
-rw-r--r--Remote/Git.hs4
-rw-r--r--RemoteDaemon/Core.hs27
-rw-r--r--Test.hs4
-rw-r--r--Types/GitConfig.hs93
-rw-r--r--doc/forum/Is_there_an___39__annex-cost__39___to_NEVER_access_remote__63__/comment_4_f1e234e80a6873b33986bec8d51c1001._comment7
-rw-r--r--doc/git-annex.mdwn15
-rw-r--r--git-annex.cabal1
19 files changed, 194 insertions, 88 deletions
diff --git a/Annex.hs b/Annex.hs
index 597a5dd1b..add568a1b 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -329,7 +329,7 @@ adjustGitRepo a = do
getRemoteGitConfig :: Git.Repo -> Annex RemoteGitConfig
getRemoteGitConfig r = do
g <- gitRepo
- return $ extractRemoteGitConfig g (Git.repoDescribe r)
+ liftIO $ atomically $ extractRemoteGitConfig g (Git.repoDescribe r)
{- Converts an Annex action into an IO action, that runs with a copy
- of the current Annex state.
diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs
index 3e2b1da0a..f53a2ca63 100644
--- a/Annex/SpecialRemote.hs
+++ b/Annex/SpecialRemote.hs
@@ -10,6 +10,7 @@ module Annex.SpecialRemote where
import Annex.Common
import Remote (remoteTypes, remoteMap)
import Types.Remote (RemoteConfig, RemoteConfigKey, SetupStage(..), typename, setup)
+import Types.GitConfig
import Logs.Remote
import Logs.Trust
import qualified Git.Config
@@ -79,7 +80,8 @@ autoEnable = do
case (M.lookup nameKey c, findType c) of
(Just name, Right t) -> whenM (canenable u) $ do
showSideAction $ "Auto enabling special remote " ++ name
- res <- tryNonAsync $ setup t Enable (Just u) Nothing c def
+ dummycfg <- liftIO dummyRemoteGitConfig
+ res <- tryNonAsync $ setup t Enable (Just u) Nothing c dummycfg
case res of
Left e -> warning (show e)
Right _ -> return ()
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index ce5f01e27..58cb28c01 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -19,6 +19,7 @@ import Logs.Trust
import Logs.TimeStamp
import qualified Remote
import qualified Types.Remote as Remote
+import Config.DynamicConfig
import Control.Concurrent.STM
import System.Posix.Types
@@ -47,12 +48,12 @@ modifyDaemonStatus a = do
- and other associated information. -}
calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus)
calcSyncRemotes = do
- rs <- filter (remoteAnnexSync . Remote.gitconfig) .
- concat . Remote.byCost <$> Remote.remoteList
+ rs <- filterM (liftIO . getDynamicConfig . remoteAnnexSync . Remote.gitconfig)
+ =<< (concat . Remote.byCost <$> Remote.remoteList)
alive <- trustExclude DeadTrusted (map Remote.uuid rs)
let good r = Remote.uuid r `elem` alive
let syncable = filter good rs
- let syncdata = filter (not . remoteAnnexIgnore . Remote.gitconfig) $
+ syncdata <- filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) $
filter (\r -> Remote.uuid r /= NoUUID) $
filter (not . Remote.isXMPPRemote) syncable
diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs
index 6d0377206..57abb86fd 100644
--- a/Assistant/MakeRemote.hs
+++ b/Assistant/MakeRemote.hs
@@ -24,6 +24,7 @@ import Git.Types (RemoteName)
import Creds
import Assistant.Gpg
import Utility.Gpg (KeyId)
+import Types.GitConfig
import qualified Data.Map as M
@@ -102,7 +103,8 @@ setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do
- pool is drained, and as of now there's no way to tell the user
- to perform IO actions to refill the pool. -}
let weakc = M.insert "highRandomQuality" "false" $ M.union config c
- (c', u) <- R.setup remotetype ss mu mcreds weakc def
+ dummycfg <- liftIO dummyRemoteGitConfig
+ (c', u) <- R.setup remotetype ss mu mcreds weakc dummycfg
configSet u c'
when setdesc $
whenM (isNothing . M.lookup u <$> uuidMap) $
diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs
index e6a5bc5d5..aba90f64c 100644
--- a/Assistant/Sync.hs
+++ b/Assistant/Sync.hs
@@ -27,6 +27,7 @@ import Annex.TaggedPush
import Annex.Ssh
import qualified Config
import Git.Config
+import Config.DynamicConfig
import Assistant.NamedThread
import Assistant.Threads.Watcher (watchThread, WatcherControl(..))
import Assistant.TransferSlots
@@ -77,8 +78,8 @@ reconnectRemotes rs = void $ do
go = do
(failed, diverged) <- sync
=<< liftAnnex (join Command.Sync.getCurrBranch)
- addScanRemotes diverged $
- filter (not . remoteAnnexIgnore . Remote.gitconfig)
+ addScanRemotes diverged =<<
+ filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig)
nonxmppremotes
return failed
signal r = liftIO . mapM_ (flip tryPutMVar ())
diff --git a/CHANGELOG b/CHANGELOG
index b2c8f6229..6bef5110b 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -15,9 +15,9 @@ git-annex (6.20170521) UNRELEASED; urgency=medium
an url to check if it exists. Some web servers take quite a long time
to answer a HEAD request.
* Windows: Win32 package has subsumed Win32-extras; update dependency.
- * Added annex-check-command configuration, which can be used to
- provide a shell command to check if a remote should be allowed to be
- used at all.
+ * Added remote configuration settings annex-ignore-command and
+ annex-sync-command, which are dynamic equivilants of the annex-ignore
+ and annex-sync configurations.
-- Joey Hess <id@joeyh.name> Sat, 17 Jun 2017 13:02:24 -0400
diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs
index b9b53a69c..a2a26009e 100644
--- a/Command/EnableRemote.hs
+++ b/Command/EnableRemote.hs
@@ -20,6 +20,8 @@ import qualified Remote.Git
import Logs.UUID
import Annex.UUID
import Config
+import Config.DynamicConfig
+import Types.GitConfig
import qualified Data.Map as M
@@ -76,7 +78,9 @@ startSpecialRemote name config (Just (u, c)) = do
let fullconfig = config `M.union` c
t <- either giveup return (Annex.SpecialRemote.findType fullconfig)
showStart "enableremote" name
- gc <- maybe def Remote.gitconfig <$> Remote.byUUID u
+ gc <- maybe (liftIO dummyRemoteGitConfig)
+ (return . Remote.gitconfig)
+ =<< Remote.byUUID u
next $ performSpecialRemote t u fullconfig gc
performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
@@ -109,5 +113,6 @@ unknownNameError prefix = do
where
isdisabled r = anyM id
[ (==) NoUUID <$> getRepoUUID r
- , remoteAnnexIgnore <$> Annex.getRemoteGitConfig r
+ , liftIO . getDynamicConfig . remoteAnnexIgnore
+ =<< Annex.getRemoteGitConfig r
]
diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs
index 78a1738d5..d82dc366c 100644
--- a/Command/InitRemote.hs
+++ b/Command/InitRemote.hs
@@ -15,6 +15,7 @@ import qualified Remote
import qualified Logs.Remote
import qualified Types.Remote as R
import Logs.UUID
+import Types.GitConfig
cmd :: Command
cmd = command "initremote" SectionSetup
@@ -46,7 +47,8 @@ start (name:ws) = ifM (isJust <$> findExisting name)
perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform
perform t name c = do
- (c', u) <- R.setup t R.Init cu Nothing c def
+ dummycfg <- liftIO dummyRemoteGitConfig
+ (c', u) <- R.setup t R.Init cu Nothing c dummycfg
next $ cleanup u name c'
where
cu = case M.lookup "uuid" c of
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 9ecb98620..d460679ba 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -40,6 +40,7 @@ import qualified Git
import qualified Remote.Git
import Config
import Config.GitConfig
+import Config.DynamicConfig
import Config.Files
import Annex.Wanted
import Annex.Content
@@ -152,8 +153,8 @@ seek o = allowConcurrentOutput $ do
remotes <- syncRemotes (syncWith o)
let gitremotes = filter Remote.gitSyncableRemote remotes
- let dataremotes = filter (\r -> Remote.uuid r /= NoUUID) $
- filter (not . remoteAnnexIgnore . Remote.gitconfig) remotes
+ dataremotes <- filter (\r -> Remote.uuid r /= NoUUID)
+ <$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes
-- Syncing involves many actions, any of which can independently
-- fail, without preventing the others from running.
@@ -247,10 +248,15 @@ remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote
-- Do automatic initialization of remotes when possible when getting remote
-- list.
syncRemotes :: [String] -> Annex [Remote]
-syncRemotes ps = syncRemotes' ps =<< Remote.remoteList' True
+syncRemotes ps = do
+ remotelist <- Remote.remoteList' True
+ available <- filterM (liftIO . getDynamicConfig . remoteAnnexSync . Remote.gitconfig)
+ (filter (not . Remote.isXMPPRemote) remotelist)
+ syncRemotes' ps available
syncRemotes' :: [String] -> [Remote] -> Annex [Remote]
-syncRemotes' ps remotelist = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
+syncRemotes' ps available =
+ ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
where
pickfast = (++) <$> listed <*> (filterM good (fastest available))
@@ -260,9 +266,6 @@ syncRemotes' ps remotelist = ifM (Annex.getState Annex.fast) ( nub <$> pickfast
listed = concat <$> mapM Remote.byNameOrGroup ps
- available = filter (remoteAnnexSync . Remote.gitconfig)
- $ filter (not . Remote.isXMPPRemote) remotelist
-
good r
| Remote.gitSyncableRemote r = Remote.Git.repoAvail $ Remote.repo r
| otherwise = return True
diff --git a/Config/DynamicConfig.hs b/Config/DynamicConfig.hs
new file mode 100644
index 000000000..095c7c641
--- /dev/null
+++ b/Config/DynamicConfig.hs
@@ -0,0 +1,44 @@
+{- dynamic configuration
+ -
+ - Copyright 2017 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Config.DynamicConfig where
+
+import Control.Concurrent.STM
+
+import Utility.SafeCommand
+
+-- | A configuration value that may only be known after performing an IO
+-- action. The IO action will only be run the first time the configuration
+-- is accessed; its result is then cached.
+data DynamicConfig a = DynamicConfig (IO a, TMVar a) | StaticConfig a
+
+mkDynamicConfig :: CommandRunner a -> Maybe String -> a -> STM (DynamicConfig a)
+mkDynamicConfig _ Nothing static = return $ StaticConfig static
+mkDynamicConfig cmdrunner (Just cmd) _ = do
+ tmvar <- newEmptyTMVar
+ return $ DynamicConfig (cmdrunner cmd, tmvar)
+
+getDynamicConfig :: DynamicConfig a -> IO a
+getDynamicConfig (StaticConfig v) = return v
+getDynamicConfig (DynamicConfig (a, tmvar)) =
+ go =<< atomically (tryReadTMVar tmvar)
+ where
+ go Nothing = do
+ v <- a
+ atomically $ do
+ _ <- tryTakeTMVar tmvar
+ putTMVar tmvar v
+ return v
+ go (Just v) = return v
+
+type CommandRunner a = String -> IO a
+
+successfullCommandRunner :: CommandRunner Bool
+successfullCommandRunner cmd = boolSystem "sh" [Param "-c", Param cmd]
+
+unsuccessfullCommandRunner :: CommandRunner Bool
+unsuccessfullCommandRunner cmd = not <$> successfullCommandRunner cmd
diff --git a/Remote.hs b/Remote.hs
index 8c774915a..877c9f37d 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -70,6 +70,7 @@ import Logs.Location hiding (logStatus)
import Logs.Web
import Remote.List
import Config
+import Config.DynamicConfig
import Git.Types (RemoteName)
import qualified Git
@@ -120,12 +121,13 @@ byNameWithUUID = checkuuid <=< byName
where
checkuuid Nothing = return Nothing
checkuuid (Just r)
- | uuid r == NoUUID = giveup $
- if remoteAnnexIgnore (gitconfig r)
- then noRemoteUUIDMsg r ++
+ | uuid r == NoUUID =
+ ifM (liftIO $ getDynamicConfig $ remoteAnnexIgnore (gitconfig r))
+ ( giveup $ noRemoteUUIDMsg r ++
" (" ++ show (remoteConfig (repo r) "ignore") ++
" is set)"
- else noRemoteUUIDMsg r
+ , giveup $ noRemoteUUIDMsg r
+ )
| otherwise = return $ Just r
byName' :: RemoteName -> Annex (Either String Remote)
@@ -292,8 +294,8 @@ remoteLocations locations trusted = do
let validtrustedlocations = nub locations `intersect` trusted
-- remotes that match uuids that have the key
- allremotes <- filter (not . remoteAnnexIgnore . gitconfig)
- <$> remoteList
+ allremotes <- remoteList
+ >>= filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig)
let validremotes = remotesWithUUID allremotes locations
return (sortBy (comparing cost) validremotes, validtrustedlocations)
@@ -313,7 +315,8 @@ showLocations separateuntrusted key exclude nolocmsg = do
let msg = message ppuuidswanted ppuuidsskipped
unless (null msg) $
showLongNote msg
- ignored <- filter (remoteAnnexIgnore . gitconfig) <$> remoteList
+ ignored <- remoteList
+ >>= filterM (liftIO . getDynamicConfig . remoteAnnexIgnore . gitconfig)
unless (null ignored) $
showLongNote $ "(Note that these git remotes have annex-ignore set: " ++ unwords (map name ignored) ++ ")"
where
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index ba28a7728..ee949ea08 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -227,7 +227,8 @@ gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c
setupRepo :: Git.GCrypt.GCryptId -> Git.Repo -> Annex AccessMethod
setupRepo gcryptid r
| Git.repoIsUrl r = do
- (_, _, accessmethod) <- rsyncTransport r def
+ dummycfg <- liftIO dummyRemoteGitConfig
+ (_, _, accessmethod) <- rsyncTransport r dummycfg
case accessmethod of
AccessDirect -> rsyncsetup
AccessShell -> ifM gitannexshellsetup
@@ -249,7 +250,8 @@ setupRepo gcryptid r
-}
rsyncsetup = Remote.Rsync.withRsyncScratchDir $ \tmp -> do
liftIO $ createDirectoryIfMissing True $ tmp </> objectDir
- (rsynctransport, rsyncurl, _) <- rsyncTransport r def
+ dummycfg <- liftIO dummyRemoteGitConfig
+ (rsynctransport, rsyncurl, _) <- rsyncTransport r dummycfg
let tmpconfig = tmp </> "config"
void $ liftIO $ rsync $ rsynctransport ++
[ Param $ rsyncurl ++ "/config"
@@ -389,8 +391,10 @@ toAccessMethod "shell" = AccessShell
toAccessMethod _ = AccessDirect
getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID)
-getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst
- <$> getGCryptId fast r def
+getGCryptUUID fast r = do
+ dummycfg <- liftIO dummyRemoteGitConfig
+ (genUUIDInNameSpace gCryptNameSpace <$>) . fst
+ <$> getGCryptId fast r dummycfg
coreGCryptId :: String
coreGCryptId = "core.gcrypt-id"
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 5c69473fd..b48b48b52 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -35,6 +35,7 @@ import qualified Annex.Url as Url
import Utility.Tmp
import Config
import Config.Cost
+import Config.DynamicConfig
import Annex.Init
import Annex.Version
import Types.CleanupActions
@@ -128,7 +129,8 @@ configRead :: Bool -> Git.Repo -> Annex Git.Repo
configRead autoinit r = do
gc <- Annex.getRemoteGitConfig r
u <- getRepoUUID r
- case (repoCheap r, remoteAnnexIgnore gc, u) of
+ annexignore <- liftIO $ getDynamicConfig (remoteAnnexIgnore gc)
+ case (repoCheap r, annexignore, u) of
(_, True, _) -> return r
(True, _, _) -> tryGitConfigRead autoinit r
(False, _, NoUUID) -> tryGitConfigRead autoinit r
diff --git a/RemoteDaemon/Core.hs b/RemoteDaemon/Core.hs
index a3e4e6400..399b1553a 100644
--- a/RemoteDaemon/Core.hs
+++ b/RemoteDaemon/Core.hs
@@ -10,6 +10,7 @@ module RemoteDaemon.Core (runInteractive, runNonInteractive) where
import qualified Annex
import Common
import Types.GitConfig
+import Config.DynamicConfig
import RemoteDaemon.Common
import RemoteDaemon.Types
import RemoteDaemon.Transport
@@ -139,19 +140,21 @@ genRemoteMap :: TransportHandle -> TChan Emitted -> IO RemoteMap
genRemoteMap h@(TransportHandle (LocalRepo g) _) ochan =
M.fromList . catMaybes <$> mapM gen (Git.remotes g)
where
- gen r = case Git.location r of
- Git.Url u -> case M.lookup (uriScheme u) remoteTransports of
- Just transport
- | remoteAnnexSync gc -> do
- ichan <- newTChanIO :: IO (TChan Consumed)
- return $ Just
- ( r
- , (transport (RemoteRepo r gc) (RemoteURI u) h ichan ochan, ichan)
- )
+ gen r = do
+ gc <- atomically $ extractRemoteGitConfig g (Git.repoDescribe r)
+ case Git.location r of
+ Git.Url u -> case M.lookup (uriScheme u) remoteTransports of
+ Just transport -> ifM (getDynamicConfig (remoteAnnexSync gc))
+ ( do
+ ichan <- newTChanIO :: IO (TChan Consumed)
+ return $ Just
+ ( r
+ , (transport (RemoteRepo r gc) (RemoteURI u) h ichan ochan, ichan)
+ )
+ , return Nothing
+ )
+ Nothing -> return Nothing
_ -> return Nothing
- _ -> return Nothing
- where
- gc = extractRemoteGitConfig g (Git.repoDescribe r)
genTransportHandle :: IO TransportHandle
genTransportHandle = do
diff --git a/Test.hs b/Test.hs
index 5f4e829c9..d22896f44 100644
--- a/Test.hs
+++ b/Test.hs
@@ -52,6 +52,7 @@ import qualified Git.Ref
import qualified Git.LsTree
import qualified Git.FilePath
import qualified Annex.Locations
+import qualified Types.GitConfig
import qualified Types.KeySource
import qualified Types.Backend
import qualified Types.TrustLevel
@@ -1642,7 +1643,6 @@ test_crypto = do
testscheme "pubkey"
where
gpgcmd = Utility.Gpg.mkGpgCmd Nothing
- encparams = (mempty :: Types.Remote.RemoteConfig, def :: Types.RemoteGitConfig)
testscheme scheme = intmpclonerepo $ whenM (Utility.Path.inPath (Utility.Gpg.unGpgCmd gpgcmd)) $ do
Utility.Gpg.testTestHarness gpgcmd
@? "test harness self-test failed"
@@ -1698,6 +1698,8 @@ test_crypto = do
checkScheme Types.Crypto.Hybrid = scheme == "hybrid"
checkScheme Types.Crypto.PubKey = scheme == "pubkey"
checkKeys cip mvariant = do
+ dummycfg <- Types.GitConfig.dummyRemoteGitConfig
+ let encparams = (mempty :: Types.Remote.RemoteConfig, dummycfg)
cipher <- Crypto.decryptCipher gpgcmd encparams cip
files <- filterM doesFileExist $
map ("dir" </>) $ concatMap (key2files cipher) keys
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
index cec64b57a..6eea51998 100644
--- a/Types/GitConfig.hs
+++ b/Types/GitConfig.hs
@@ -12,6 +12,7 @@ module Types.GitConfig (
mergeGitConfig,
RemoteGitConfig(..),
extractRemoteGitConfig,
+ dummyRemoteGitConfig,
) where
import Common
@@ -27,11 +28,15 @@ import Types.Availability
import Types.NumCopies
import Types.Difference
import Types.RefSpec
+import Config.DynamicConfig
import Utility.HumanTime
import Utility.Gpg (GpgCmd, mkGpgCmd)
import Utility.ThreadScheduler (Seconds(..))
--- | A configurable value, that may not be fully determined yet.
+import Control.Concurrent.STM
+
+-- | A configurable value, that may not be fully determined yet because
+-- the global git config has not yet been loaded.
data Configurable a
= HasConfig a
-- ^ Value is fully determined.
@@ -189,8 +194,8 @@ mergeGitConfig gitconfig repoglobals = gitconfig
data RemoteGitConfig = RemoteGitConfig
{ remoteAnnexCost :: Maybe Cost
, remoteAnnexCostCommand :: Maybe String
- , remoteAnnexIgnore :: Bool
- , remoteAnnexSync :: Bool
+ , remoteAnnexIgnore :: DynamicConfig Bool
+ , remoteAnnexSync :: DynamicConfig Bool
, remoteAnnexPull :: Bool
, remoteAnnexPush :: Bool
, remoteAnnexReadOnly :: Bool
@@ -224,41 +229,48 @@ data RemoteGitConfig = RemoteGitConfig
, remoteGitConfig :: GitConfig
}
-extractRemoteGitConfig :: Git.Repo -> String -> RemoteGitConfig
-extractRemoteGitConfig r remotename = RemoteGitConfig
- { remoteAnnexCost = getmayberead "cost"
- , remoteAnnexCostCommand = notempty $ getmaybe "cost-command"
- , remoteAnnexIgnore = getbool "ignore" False
- , remoteAnnexSync = getbool "sync" True
- , remoteAnnexPull = getbool "pull" True
- , remoteAnnexPush = getbool "push" True
- , remoteAnnexReadOnly = getbool "readonly" False
- , remoteAnnexVerify = getbool "verify" True
- , remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel"
- , remoteAnnexStartCommand = notempty $ getmaybe "start-command"
- , remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
- , remoteAnnexAvailability = getmayberead "availability"
- , remoteAnnexBare = getmaybebool "bare"
-
- , remoteAnnexShell = getmaybe "shell"
- , remoteAnnexSshOptions = getoptions "ssh-options"
- , remoteAnnexRsyncOptions = getoptions "rsync-options"
- , remoteAnnexRsyncDownloadOptions = getoptions "rsync-download-options"
- , remoteAnnexRsyncUploadOptions = getoptions "rsync-upload-options"
- , remoteAnnexRsyncTransport = getoptions "rsync-transport"
- , remoteAnnexGnupgOptions = getoptions "gnupg-options"
- , remoteAnnexGnupgDecryptOptions = getoptions "gnupg-decrypt-options"
- , remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl"
- , remoteAnnexBupRepo = getmaybe "buprepo"
- , remoteAnnexTahoe = getmaybe "tahoe"
- , remoteAnnexBupSplitOptions = getoptions "bup-split-options"
- , remoteAnnexDirectory = notempty $ getmaybe "directory"
- , remoteAnnexGCrypt = notempty $ getmaybe "gcrypt"
- , remoteAnnexDdarRepo = getmaybe "ddarrepo"
- , remoteAnnexHookType = notempty $ getmaybe "hooktype"
- , remoteAnnexExternalType = notempty $ getmaybe "externaltype"
- , remoteGitConfig = extractGitConfig r
- }
+extractRemoteGitConfig :: Git.Repo -> String -> STM RemoteGitConfig
+extractRemoteGitConfig r remotename = do
+ annexignore <- mkDynamicConfig unsuccessfullCommandRunner
+ (notempty $ getmaybe "ignore-command")
+ (getbool "ignore" False)
+ annexsync <- mkDynamicConfig successfullCommandRunner
+ (notempty $ getmaybe "sync-command")
+ (getbool "sync" True)
+ return $ RemoteGitConfig
+ { remoteAnnexCost = getmayberead "cost"
+ , remoteAnnexCostCommand = notempty $ getmaybe "cost-command"
+ , remoteAnnexIgnore = annexignore
+ , remoteAnnexSync = annexsync
+ , remoteAnnexPull = getbool "pull" True
+ , remoteAnnexPush = getbool "push" True
+ , remoteAnnexReadOnly = getbool "readonly" False
+ , remoteAnnexVerify = getbool "verify" True
+ , remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel"
+ , remoteAnnexStartCommand = notempty $ getmaybe "start-command"
+ , remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
+ , remoteAnnexAvailability = getmayberead "availability"
+ , remoteAnnexBare = getmaybebool "bare"
+
+ , remoteAnnexShell = getmaybe "shell"
+ , remoteAnnexSshOptions = getoptions "ssh-options"
+ , remoteAnnexRsyncOptions = getoptions "rsync-options"
+ , remoteAnnexRsyncDownloadOptions = getoptions "rsync-download-options"
+ , remoteAnnexRsyncUploadOptions = getoptions "rsync-upload-options"
+ , remoteAnnexRsyncTransport = getoptions "rsync-transport"
+ , remoteAnnexGnupgOptions = getoptions "gnupg-options"
+ , remoteAnnexGnupgDecryptOptions = getoptions "gnupg-decrypt-options"
+ , remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl"
+ , remoteAnnexBupRepo = getmaybe "buprepo"
+ , remoteAnnexTahoe = getmaybe "tahoe"
+ , remoteAnnexBupSplitOptions = getoptions "bup-split-options"
+ , remoteAnnexDirectory = notempty $ getmaybe "directory"
+ , remoteAnnexGCrypt = notempty $ getmaybe "gcrypt"
+ , remoteAnnexDdarRepo = getmaybe "ddarrepo"
+ , remoteAnnexHookType = notempty $ getmaybe "hooktype"
+ , remoteAnnexExternalType = notempty $ getmaybe "externaltype"
+ , remoteGitConfig = extractGitConfig r
+ }
where
getbool k d = fromMaybe d $ getmaybebool k
getmaybebool k = Git.Config.isTrue =<< getmaybe k
@@ -275,5 +287,6 @@ notempty Nothing = Nothing
notempty (Just "") = Nothing
notempty (Just s) = Just s
-instance Default RemoteGitConfig where
- def = extractRemoteGitConfig Git.Construct.fromUnknown "dummy"
+dummyRemoteGitConfig :: IO RemoteGitConfig
+dummyRemoteGitConfig = atomically $
+ extractRemoteGitConfig Git.Construct.fromUnknown "dummy"
diff --git a/doc/forum/Is_there_an___39__annex-cost__39___to_NEVER_access_remote__63__/comment_4_f1e234e80a6873b33986bec8d51c1001._comment b/doc/forum/Is_there_an___39__annex-cost__39___to_NEVER_access_remote__63__/comment_4_f1e234e80a6873b33986bec8d51c1001._comment
new file mode 100644
index 000000000..3bcce95be
--- /dev/null
+++ b/doc/forum/Is_there_an___39__annex-cost__39___to_NEVER_access_remote__63__/comment_4_f1e234e80a6873b33986bec8d51c1001._comment
@@ -0,0 +1,7 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 4"""
+ date="2017-08-17T17:53:59Z"
+ content="""
+I've implemented annex-ignore-command and annex-sync-command. Enjoy!
+"""]]
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index c7d0f10da..14a787219 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -1125,8 +1125,7 @@ Here are all the supported configuration settings.
* `remote.<name>.annex-cost-command`
If set, the command is run, and the number it outputs is used as the cost.
- This allows varying the cost based on e.g., the current network. The
- cost-command can be any shell command line.
+ This allows varying the cost based on e.g., the current network.
* `remote.<name>.annex-start-command`
@@ -1165,12 +1164,24 @@ Here are all the supported configuration settings.
This does not prevent git-annex sync (or the git-annex assistant) from
syncing the git repository to the remote.
+* `remote.<name>.annex-ignore-command`
+
+ If set, the command is run, and if it exits nonzero, that's the same
+ as setting annex-ignore to true. This allows controlling behavior based
+ on e.g., the current network.
+
* `remote.<name>.annex-sync`
If set to `false`, prevents git-annex sync (and the git-annex assistant)
from syncing with this remote by default. However, `git annex sync <name>`
can still be used to sync with the remote.
+* `remote.<name>.annex-sync-command`
+
+ If set, the command is run, and if it exits nonzero, that's the same
+ as setting annex-sync to false. This allows controlling behavior based
+ on e.g., the current network.
+
* `remote.<name>.annex-pull`
If set to `false`, prevents git-annex sync (and the git-annex assistant
diff --git a/git-annex.cabal b/git-annex.cabal
index 8ac15c64d..a5a1294c1 100644
--- a/git-annex.cabal
+++ b/git-annex.cabal
@@ -792,6 +792,7 @@ Executable git-annex
Config
Config.Cost
Config.Files
+ Config.DynamicConfig
Config.GitConfig
Creds
Crypto
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-21 00:20:37 +0000