removal of the rest of remoteGitConfig

In keyUrls, the GitConfig is used only by annexLocations
to support configured Differences. Since such configurations affect all
clones of a repository, the local repo's GitConfig must have the same
information as the remote's GitConfig would have. So, used getGitConfig
to get the local GitConfig, which is cached and so available cheaply.

That actually fixed a bug noone had ever noticed: keyUrls is
used for remotes accessed over http. The full git config of such a
remote is normally not available, so the remoteGitConfig that keyUrls
used would not have the necessary information in it.

In copyFromRemoteCheap', it uses gitAnnexLocation,
which does need the GitConfig of the remote repo itself in order to
check if it's crippled, supports symlinks, etc. So, made the
State include that GitConfig, cached. The use of gitAnnexLocation is
within a (not $ Git.repoIsUrl repo) guard, so it's local, and so
its git config will always be read and available.

(Note that gitAnnexLocation in turn calls annexLocations, so the
Differences config it uses in this case comes from the remote repo's
GitConfig and not from the local repo's GitConfig. As explained above
this is ok since they must have the same value.)

Not very happy with this mess of different GitConfigs not type-safe and
some read only sometimes etc. Very hairy. Think I got it this change
right. Test suite passes..

This commit was sponsored by Ethan Aubin.

CHANGELOG

@@ -3,8 +3,10 @@ git-annex (6.20180530) UNRELEASED; urgency=medium
   * Fix build with ghc 8.4+, which broke due to the Semigroup Monoid change. 
   * version: Show operating system and repository version list 
     when run outside a git repo too.
-  * Fixed annex-checkuuid implementation, so that remotes configured that
+  * Fix annex-checkuuid implementation, so that remotes configured that
     way can be used.
+  * Fix problems accessing repositories over http when annex.tune.*
+    is configured.
 
  -- Joey Hess <id@joeyh.name>  Wed, 30 May 2018 11:49:08 -0400
 

Remote/GCrypt.hs

@@ -124,7 +124,7 @@ gen' r u c gc = do
 		, config = c
 		, localpath = localpathCalc r
 		, getRepo = return r
-		, gitconfig = gc { remoteGitConfig = extractGitConfig r }
+		, gitconfig = gc
 		, readonly = Git.repoIsHttp r
 		, availability = availabilityCalc r
 		, remotetype = remote

Remote/Git.hs

@@ -176,7 +176,7 @@ gen r u c gc
 			, config = c
 			, localpath = localpathCalc r
 			, getRepo = getRepoFromState st
-			, gitconfig = gc { remoteGitConfig = extractGitConfig r }
+			, gitconfig = gc
 			, readonly = Git.repoIsHttp r
 			, availability = availabilityCalc r
 			, remotetype = remote
@@ -340,8 +340,9 @@ inAnnex' repo rmt (State connpool duc _) key
   where
 	checkhttp = do
 		showChecking repo
+		gc <- Annex.getGitConfig
 		ifM (Url.withUrlOptions $ \uo -> liftIO $
-			anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls repo rmt key))
+			anyM (\u -> Url.checkBoth u (keySize key) uo) (keyUrls gc repo rmt key))
 				( return True
 				, giveup "not found"
 				)
@@ -355,22 +356,21 @@ inAnnex' repo rmt (State connpool duc _) key
 		, cantCheck repo
 		)
 
-keyUrls :: Git.Repo -> Remote -> Key -> [String]
-keyUrls repo r key = map tourl locs'
+keyUrls :: GitConfig -> Git.Repo -> Remote -> Key -> [String]
+keyUrls gc repo r key = map tourl locs'
   where
 	tourl l = Git.repoLocation repo ++ "/" ++ l
 	-- If the remote is known to not be bare, try the hash locations
 	-- used for non-bare repos first, as an optimisation.
 	locs
-		| remoteAnnexBare remoteconfig == Just False = reverse (annexLocations cfg key)
-		| otherwise = annexLocations cfg key
+		| remoteAnnexBare remoteconfig == Just False = reverse (annexLocations gc key)
+		| otherwise = annexLocations gc key
 #ifndef mingw32_HOST_OS
 	locs' = locs
 #else
 	locs' = map (replace "\\" "/") locs
 #endif
 	remoteconfig = gitconfig r
-	cfg = remoteGitConfig remoteconfig
 
 dropKey :: Remote -> State -> Key -> Annex Bool
 dropKey r st key = do
@@ -471,8 +471,9 @@ copyFromRemote' forcersync r st key file dest meterupdate = do
 
 copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
 copyFromRemote'' repo forcersync r (State connpool _ _) key file dest meterupdate
-	| Git.repoIsHttp repo = unVerified $
-		Annex.Content.downloadUrl key meterupdate (keyUrls repo r key) dest
+	| Git.repoIsHttp repo = unVerified $ do
+		gc <- Annex.getGitConfig
+		Annex.Content.downloadUrl key meterupdate (keyUrls gc repo r key) dest
 	| not $ Git.repoIsUrl repo = guardUsable repo (unVerified (return False)) $ do
 		params <- Ssh.rsyncParams r Download
 		u <- getUUID
@@ -567,10 +568,10 @@ copyFromRemoteCheap r st key af file = do
 copyFromRemoteCheap' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> Annex Bool
 #ifndef mingw32_HOST_OS
 copyFromRemoteCheap' repo r st key af file
-	| not $ Git.repoIsUrl repo = guardUsable repo (return False) $ liftIO $ do
-		loc <- gitAnnexLocation key repo $
-			remoteGitConfig $ gitconfig r
-		ifM (doesFileExist loc)
+	| not $ Git.repoIsUrl repo = guardUsable repo (return False) $ do
+		gc <- getGitConfigFromState st
+		loc <- liftIO $ gitAnnexLocation key repo gc
+		liftIO $ ifM (doesFileExist loc)
 			( do
 				absloc <- absPath loc
 				catchBoolIO $ do
@@ -782,10 +783,14 @@ mkCopier remotewanthardlink rsyncparams = do
  - This returns False when the repository UUID is not as expected. -}
 type DeferredUUIDCheck = Annex Bool
 
-data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck (Annex Git.Repo)
+data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck (Annex (Git.Repo, GitConfig))
 
 getRepoFromState :: State -> Annex Git.Repo
-getRepoFromState (State _ _ a) = a
+getRepoFromState (State _ _ a) = fst <$> a
+
+{- The config of the remote git repository, cached for speed. -}
+getGitConfigFromState :: State -> Annex GitConfig
+getGitConfigFromState (State _ _ a) = snd <$> a
 
 mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State
 mkState r u gc = do
@@ -794,21 +799,23 @@ mkState r u gc = do
 	return $ State pool duc getrepo
   where
 	go
-		| remoteAnnexCheckUUID gc = return (return True, return r)
+		| remoteAnnexCheckUUID gc = return
+			(return True, return (r, extractGitConfig r))
 		| otherwise = do
 			rv <- liftIO newEmptyMVar
 			let getrepo = ifM (liftIO $ isEmptyMVar rv)
 				( do
 					r' <- tryGitConfigRead False r
-					void $ liftIO $ tryPutMVar rv r'
-					return r'
+					let t = (r', extractGitConfig r')
+					void $ liftIO $ tryPutMVar rv t
+					return t
 				, liftIO $ readMVar rv
 				)
 
 			cv <- liftIO newEmptyMVar
 			let duc = ifM (liftIO $ isEmptyMVar cv)
 				( do
-					r' <- getrepo
+					r' <- fst <$> getrepo
 					u' <- getRepoUUID r'
 					let ok = u' == u
 					void $ liftIO $ tryPutMVar cv ok

Remote/P2P.hs

@@ -65,7 +65,7 @@ chainGen addr r u c gc = do
 		, config = c
 		, localpath = Nothing
 		, getRepo = return r
-		, gitconfig = gc { remoteGitConfig = extractGitConfig r }
+		, gitconfig = gc
 		, readonly = False
 		, availability = GloballyAvailable
 		, remotetype = remote

Types/GitConfig.hs

@@ -19,6 +19,7 @@ import Common
 import qualified Git
 import qualified Git.Config
 import qualified Git.Construct
+import Git.Types
 import Git.ConfigTypes
 import Utility.DataUnits
 import Config.Cost
@@ -195,7 +196,12 @@ mergeGitConfig gitconfig repoglobals = gitconfig
 
 {- Per-remote git-annex settings. Each setting corresponds to a git-config
  - key such as <remote>.annex-foo, or if that is not set, a default from
- - annex.foo -}
+ - annex.foo.
+ -
+ - Note that this is from the perspective of the local repository,
+ - it is not influenced in any way by the contents of the remote
+ - repository's git config.
+ -}
 data RemoteGitConfig = RemoteGitConfig
 	{ remoteAnnexCost :: DynamicConfig (Maybe Cost)
 	, remoteAnnexIgnore :: DynamicConfig Bool
@@ -235,11 +241,11 @@ data RemoteGitConfig = RemoteGitConfig
 	, remoteAnnexDdarRepo :: Maybe String
 	, remoteAnnexHookType :: Maybe String
 	, remoteAnnexExternalType :: Maybe String
-	{- A regular git remote's git repository config. -}
-	, remoteGitConfig :: GitConfig
 	}
 
-extractRemoteGitConfig :: Git.Repo -> String -> STM RemoteGitConfig
+{- The Git.Repo is the local repository, which has the remote with the
+ - given RemoteName. -}
+extractRemoteGitConfig :: Git.Repo -> RemoteName -> STM RemoteGitConfig
 extractRemoteGitConfig r remotename = do
 	annexcost <- mkDynamicConfig readCommandRunner
 		(notempty $ getmaybe "cost-command")
@@ -288,7 +294,6 @@ extractRemoteGitConfig r remotename = do
 		, remoteAnnexDdarRepo = getmaybe "ddarrepo"
 		, remoteAnnexHookType = notempty $ getmaybe "hooktype"
 		, remoteAnnexExternalType = notempty $ getmaybe "externaltype"
-		, remoteGitConfig = extractGitConfig r
 		}
   where
 	getbool k d = fromMaybe d $ getmaybebool k

doc/todo/need_to_remove_remoteGitConfig_for_checkuuid_support.mdwn

@@ -8,3 +8,5 @@ annex-checkuuid=false.
 
 The best thing would be to remove remoteGitConfig, to avoid such problems
 in the future. --[[Joey]]
+
+> [[done]] --[[Joey]]