add annex-ignore-command and annex-sync-command configs

Added remote configuration settings annex-ignore-command and
annex-sync-command, which are dynamic equivilants of the annex-ignore
and annex-sync configurations.

For this I needed a new DynamicConfig infrastructure. Its implementation
should be as fast as before when there is no dynamic config, and it caches
so shell commands are only run once.

Note that annex-ignore-command exits nonzero when the remote should be ignored.
While that may seem backwards, it allows using the same command for it as
for annex-sync-command when you want to disable both.

This commit was sponsored by Trenton Cronholm on Patreon.

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. 

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

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) .
+	rs <- filterM (liftIO . getDynamicConfig . remoteAnnexSync . Remote.gitconfig)
-		concat . Remote.byCost <$> Remote.remoteList
+		=<< (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
 

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

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 $
+		addScanRemotes diverged =<<
-			filter (not . remoteAnnexIgnore . Remote.gitconfig)
+			filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig)
 				nonxmppremotes
 		return failed
 	signal r = liftIO . mapM_ (flip tryPutMVar ())

Assistant/WebApp/Configurators/Edit.hs

@@ -44,6 +44,7 @@ import Annex.UUID
 import Assistant.Ssh
 import Config
 import Config.GitConfig
+import Config.DynamicConfig
 
 import qualified Data.Text as T
 import qualified Data.Map as M
@@ -76,7 +77,7 @@ getRepoConfig uuid mremote = do
 	description <- fmap T.pack . M.lookup uuid <$> uuidMap
 
 	syncable <- case mremote of
-		Just r -> return $ remoteAnnexSync $ Remote.gitconfig r
+		Just r -> liftIO $ getDynamicConfig $ remoteAnnexSync $ Remote.gitconfig r
 		Nothing -> getGitConfigVal annexAutoCommit
 
 	return $ RepoConfig

Assistant/WebApp/Configurators/WebDAV.hs

@@ -19,12 +19,13 @@ import Types.Remote (RemoteConfig)
 import Types.StandardGroups
 import Logs.Remote
 import Git.Types (RemoteName)
+import Assistant.Gpg
+import Types.GitConfig
 
 import qualified Data.Map as M
 #endif
 import qualified Data.Text as T
 import Network.URI
-import Assistant.Gpg
 
 webDAVConfigurator :: Widget -> Handler Html
 webDAVConfigurator = page "Add a WebDAV repository" (Just Configuration)
@@ -94,8 +95,9 @@ postEnableWebDAVR uuid = do
 	let c = fromJust $ M.lookup uuid m
 	let name = fromJust $ M.lookup "name" c
 	let url = fromJust $ M.lookup "url" c
-	mcreds <- liftAnnex $
+	mcreds <- liftAnnex $ do
-		getRemoteCredPairFor "webdav" c def (WebDAV.davCreds uuid)
+		dummycfg <- liftIO dummyRemoteGitConfig
+		getRemoteCredPairFor "webdav" c dummycfg (WebDAV.davCreds uuid)
 	case mcreds of
 		Just creds -> webDAVConfigurator $ liftH $
 			makeWebDavRemote enableSpecialRemote name creds M.empty

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
+  * Added remote configuration settings annex-ignore-command and
-    provide a shell command to check if a remote should be allowed to be
+    annex-sync-command, which are dynamic equivilants of the annex-ignore
-    used at all.
+    and annex-sync configurations.
 
  -- Joey Hess <id@joeyh.name>  Sat, 17 Jun 2017 13:02:24 -0400
 

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
 		]

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

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) $ 
+	dataremotes <- filter (\r -> Remote.uuid r /= NoUUID)
-		filter (not . remoteAnnexIgnore . Remote.gitconfig) remotes
+		<$> 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

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

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 $
+		| uuid r == NoUUID =
-			if remoteAnnexIgnore (gitconfig r)
+			ifM (liftIO $ getDynamicConfig $ remoteAnnexIgnore (gitconfig r))
-				then noRemoteUUIDMsg 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)
+	allremotes <- remoteList 
-		<$> 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

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
+getGCryptUUID fast r = do
-	<$> getGCryptId fast r def
+	dummycfg <- liftIO dummyRemoteGitConfig
+	(genUUIDInNameSpace gCryptNameSpace <$>) . fst
+		<$> getGCryptId fast r dummycfg
 
 coreGCryptId :: String
 coreGCryptId = "core.gcrypt-id"

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

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
+	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
+				Just transport -> ifM (getDynamicConfig (remoteAnnexSync gc))
-				| remoteAnnexSync gc -> do
+					( 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

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

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
+	, remoteAnnexIgnore :: DynamicConfig Bool
-	, remoteAnnexSync :: Bool
+	, remoteAnnexSync :: DynamicConfig Bool
 	, remoteAnnexPull :: Bool
 	, remoteAnnexPush :: Bool
 	, remoteAnnexReadOnly :: Bool
@@ -224,12 +229,19 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteGitConfig :: GitConfig
 	}
 
-extractRemoteGitConfig :: Git.Repo -> String -> RemoteGitConfig
+extractRemoteGitConfig :: Git.Repo -> String -> STM RemoteGitConfig
-extractRemoteGitConfig r remotename = 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 = getbool "ignore" False
+		, remoteAnnexIgnore = annexignore
-	, remoteAnnexSync = getbool "sync" True
+		, remoteAnnexSync = annexsync
 		, remoteAnnexPull = getbool "pull" True
 		, remoteAnnexPush = getbool "push" True
 		, remoteAnnexReadOnly = getbool "readonly" False
@@ -275,5 +287,6 @@ notempty Nothing = Nothing
 notempty (Just "") = Nothing
 notempty (Just s) = Just s
 
-instance Default RemoteGitConfig where
+dummyRemoteGitConfig :: IO RemoteGitConfig
-	def = extractRemoteGitConfig Git.Construct.fromUnknown "dummy"
+dummyRemoteGitConfig = atomically $ 
+	extractRemoteGitConfig Git.Construct.fromUnknown "dummy"

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!
+"""]]

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
+  This allows varying the cost based on e.g., the current network.
-  cost-command can be any shell command line.
 
 * `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

git-annex.cabal

@@ -792,6 +792,7 @@ Executable git-annex
     Config
     Config.Cost
     Config.Files
+    Config.DynamicConfig
     Config.GitConfig
     Creds
     Crypto