fix annex-checkuuid

Fixed annex-checkuuid implementation, so that remotes configured that way
can be used. This was 100% broken from the first commit of it, oops.

This commit was sponsored by Øyvind Andersen Holm.

CHANGELOG

@@ -3,6 +3,8 @@ 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
+    way can be used.
 
  -- Joey Hess <id@joeyh.name>  Wed, 30 May 2018 11:49:08 -0400
 

Remote/Git.hs

@@ -175,7 +175,7 @@ gen r u c gc
 				else Just $ repairRemote r
 			, config = c
 			, localpath = localpathCalc r
-			, getRepo = return r
+			, getRepo = getRepoFromState st
 			, gitconfig = gc { remoteGitConfig = extractGitConfig r }
 			, readonly = Git.repoIsHttp r
 			, availability = availabilityCalc r
@@ -333,7 +333,7 @@ inAnnex rmt st key = do
 	inAnnex' repo rmt st key
 
 inAnnex' :: Git.Repo -> Remote -> State -> Key -> Annex Bool
-inAnnex' repo rmt (State connpool duc) key
+inAnnex' repo rmt (State connpool duc _) key
 	| Git.repoIsHttp repo = checkhttp
 	| Git.repoIsUrl repo = checkremote
 	| otherwise = checklocal
@@ -378,7 +378,7 @@ dropKey r st key = do
 	dropKey' repo r st key
 
 dropKey' :: Git.Repo -> Remote -> State -> Key -> Annex Bool
-dropKey' repo r (State connpool duc) key
+dropKey' repo r (State connpool duc _) key
 	| not $ Git.repoIsUrl repo = ifM duc
 		( guardUsable repo (return False) $
 			commitOnCleanup repo r $ onLocalFast repo r $ do
@@ -402,7 +402,7 @@ lockKey r st key callback = do
 	lockKey' repo r st key callback
 
 lockKey' :: Git.Repo -> Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
-lockKey' repo r (State connpool duc) key callback
+lockKey' repo r (State connpool duc _) key callback
 	| not $ Git.repoIsUrl repo = ifM duc
 		( guardUsable repo failedlock $ do
 			inorigrepo <- Annex.makeRunner
@@ -470,7 +470,7 @@ copyFromRemote' forcersync r st key file dest meterupdate = do
 	copyFromRemote'' repo forcersync r st key file dest meterupdate
 
 copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)
-copyFromRemote'' repo forcersync r (State connpool _) key file dest meterupdate
+copyFromRemote'' repo forcersync r (State connpool _ _) key file dest meterupdate
 	| Git.repoIsHttp repo = unVerified $
 		Annex.Content.downloadUrl key meterupdate (keyUrls repo r key) dest
 	| not $ Git.repoIsUrl repo = guardUsable repo (unVerified (return False)) $ do
@@ -595,7 +595,7 @@ copyToRemote r st key file meterupdate = do
 	copyToRemote' repo r st key file meterupdate
 
 copyToRemote' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
-copyToRemote' repo r (State connpool duc) key file meterupdate
+copyToRemote' repo r (State connpool duc _) key file meterupdate
 	| not $ Git.repoIsUrl repo = ifM duc
 		( guardUsable repo (return False) $ commitOnCleanup repo r $
 			copylocal =<< Annex.Content.prepSendAnnex key
@@ -775,13 +775,6 @@ mkCopier remotewanthardlink rsyncparams = do
 		, return copier
 		)
 
-data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck
-
-mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State
-mkState r u gc = State
-	<$> Ssh.mkP2PSshConnectionPool
-	<*> mkDeferredUUIDCheck r u gc
-
 {- Normally the UUID of a local repository is checked at startup,
  - but annex-checkuuid config can prevent that. To avoid getting
  - confused, a deferred check is done just before the repository
@@ -789,19 +782,40 @@ mkState r u gc = State
  - This returns False when the repository UUID is not as expected. -}
 type DeferredUUIDCheck = Annex Bool
 
-mkDeferredUUIDCheck :: Git.Repo -> UUID -> RemoteGitConfig -> Annex DeferredUUIDCheck
-mkDeferredUUIDCheck r u gc
-	| remoteAnnexCheckUUID gc = return (return True)
-	| otherwise = do
-		v <- liftIO newEmptyMVar
-		return $ ifM (liftIO $ isEmptyMVar v)
-			( do
-				r' <- tryGitConfigRead False r
-				u' <- getRepoUUID r'
-				let ok = u' == u
-				void $ liftIO $ tryPutMVar v ok
-				unless ok $
-					warning $ Git.repoDescribe r ++ " is not the expected repository. The remote's annex-checkuuid configuration prevented noticing the change until now."
-				return ok
-			, liftIO $ readMVar v
-			)
+data State = State Ssh.P2PSshConnectionPool DeferredUUIDCheck (Annex Git.Repo)
+
+getRepoFromState :: State -> Annex Git.Repo
+getRepoFromState (State _ _ a) = a
+
+mkState :: Git.Repo -> UUID -> RemoteGitConfig -> Annex State
+mkState r u gc = do
+	pool <- Ssh.mkP2PSshConnectionPool
+	(duc, getrepo) <- go
+	return $ State pool duc getrepo
+  where
+	go
+		| remoteAnnexCheckUUID gc = return (return True, return r)
+		| otherwise = do
+			rv <- liftIO newEmptyMVar
+			let getrepo = ifM (liftIO $ isEmptyMVar rv)
+				( do
+					r' <- tryGitConfigRead False r
+					void $ liftIO $ tryPutMVar rv r'
+					return r'
+				, liftIO $ readMVar rv
+				)
+
+			cv <- liftIO newEmptyMVar
+			let duc = ifM (liftIO $ isEmptyMVar cv)
+				( do
+					r' <- getrepo
+					u' <- getRepoUUID r'
+					let ok = u' == u
+					void $ liftIO $ tryPutMVar cv ok
+					unless ok $
+						warning $ Git.repoDescribe r ++ " is not the expected repository. The remote's annex-checkuuid configuration prevented noticing the change until now."
+					return ok
+				, liftIO $ readMVar cv
+				)
+
+			return (duc, getrepo)

doc/bugs/annex-checkuuid_renders_remotes_inaccessible.mdwn

@@ -38,3 +38,5 @@ Setting `remote.<name>.annex-checkuuid` to `false` renders remote `<name>` inacc
     dependency versions: aws-0.20 bloomfilter-2.0.1.0 cryptonite-0.25 DAV-1.3.2 feed-1.0.0.0 ghc-8.4.2 http-client-0.5.12.1 persistent-sqlite-2.8.1.2 torrent-10000.1.1 uuid-1.3.13 yesod-1.6.0
     key/value backends: SHA256E SHA256 SHA512E SHA512 SHA224E SHA224 SHA384E SHA384 SHA3_256E SHA3_256 SHA3_512E SHA3_512 SHA3_224E SHA3_224 SHA3_384E SHA3_384 SKEIN256E SKEIN256 SKEIN512E SKEIN512 BLAKE2B256E BLAKE2B256 BLAKE2B512E BLAKE2B512 BLAKE2B160E BLAKE2B160 BLAKE2B224E BLAKE2B224 BLAKE2B384E BLAKE2B384 BLAKE2S256E BLAKE2S256 BLAKE2S160E BLAKE2S160 BLAKE2S224E BLAKE2S224 BLAKE2SP256E BLAKE2SP256 BLAKE2SP224E BLAKE2SP224 SHA1E SHA1 MD5E MD5 WORM URL
     remote types: git gcrypt p2p S3 bup directory rsync web bittorrent webdav adb tahoe glacier ddar hook external
+
+> [[fixed|done]] --[[Joey]]

doc/bugs/annex-checkuuid_renders_remotes_inaccessible/comment_3_4e68ba8e7bc1e3d935093bf45c5afb10._comment

@@ -0,0 +1,12 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2018-06-04T20:43:13Z"
+ content="""
+Since I have been working on this for 4 hours now and want to
+end with something usable today, I went ahead with the fix.
+
+Opened a todo to keep track of the remaining problems with the remote's git
+config not being read:
+[[todo/need_to_remove_remoteGitConfig_for_checkuuid_support]]
+"""]]

doc/todo/need_to_remove_remoteGitConfig_for_checkuuid_support.mdwn

@@ -0,0 +1,12 @@
+annex-checkuuid=false prevents the git config of a remote from being read.
+So, the remoteGitConfig will be an empty config when that's set.
+
+Only a few things use remoteGitConfig. Annex.Ssh uses it, but is not
+impacted by the problem. 
+
+And `git annex sync` looks at it to determine
+if the remote is a FAT-formatted drive, and does updateInstead emulation.
+So, that's broken for remotes with annex-checkuuid=false
+
+The best thing would be to remove remoteGitConfig, to avoid such problems
+in the future. --[[Joey]]