fix embedcreds=yes reversion

Fix bug that made enableremote of S3 and webdav remotes, that have
embedcreds=yes, fail to set up the embedded creds, so accessing the remotes
failed.

(Regression introduced in version 7.20200202.7 in when reworking all the
remote configs to be parsed.)

Root problem is that parseEncryptionConfig excludes all other config keys
except encryption ones, so it is then unable to find the
credPairRemoteField. And since that field is not required to be
present, it proceeds as if it's not, rather than failing in any visible
way.

This causes it to not find any creds, and so it does not cache
them. When when the S3 remote tries to make a S3 connection, it finds no
creds, so assumes it's being used in no-creds mode, and tries to find a
public url. With no public url available, it fails, but the failure doesn't
say a lack of creds is the problem.

Fix is to provide setRemoteCredPair with a ParsedRemoteConfig, so the full
set of configs of the remote can be parsed. A bit annoying to need to
parse the remote config before the full config (as returned by
setRemoteCredPair) is available, but this avoids the problem.

I assume webdav also had the problem by inspection, but didn't try to
reproduce it with it.

Also, getRemoteCredPair used getRemoteConfigValue to get a ProposedAccepted
String, but that does not seem right. Now that it runs that code, it
crashed saying it had just a String.

Remotes that have already been enableremoted, and so lack the cached creds
file will work after this fix, because getRemoteCredPair will extract
the creds from the remote config, writing the missing file.

This commit was sponsored by Ilya Shlyakhter on Patreon.

CHANGELOG

@@ -28,6 +28,9 @@ git-annex (8.20200502) UNRELEASED; urgency=medium
     directory that's a symbolic link to elsewhere.
   * When accessing a remote fails, always display a reason why.
   * whereis: Added --format option.
+  * Fix bug that made enableremote of S3 and webdav remotes, that
+    have embedcreds=yes, fail to set up the embedded creds, so accessing
+    the remotes failed. (Regression introduced in version 7.20200202.7)
 
  -- Joey Hess <id@joeyh.name>  Mon, 04 May 2020 12:46:11 -0400
 

Creds.hs

@@ -31,7 +31,7 @@ import Utility.FileMode
 import Crypto
 import Types.Remote (RemoteConfig, RemoteConfigField)
 import Types.ProposedAccepted
-import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher, parseEncryptionConfig)
+import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher)
 import Utility.Env (getEnv)
 
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -56,10 +56,8 @@ data CredPairStorage = CredPairStorage
  - if that's going to be done, so that the creds can be encrypted using the
  - cipher. The EncryptionIsSetup is witness to that being the case.
  -}
-setRemoteCredPair :: EncryptionIsSetup -> RemoteConfig -> RemoteGitConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
+setRemoteCredPair :: EncryptionIsSetup -> ParsedRemoteConfig -> RemoteGitConfig -> CredPairStorage -> Maybe CredPair -> Annex RemoteConfig
-setRemoteCredPair = setRemoteCredPair' id go
+setRemoteCredPair encsetup pc = setRemoteCredPair' id (const pc) encsetup (unparsedRemoteConfig pc)
-  where
-	go c = either (const (ParsedRemoteConfig mempty c)) id (parseEncryptionConfig c)
 
 setRemoteCredPair'
 	:: (ProposedAccepted String -> a)
@@ -106,7 +104,7 @@ getRemoteCredPair c gc storage = maybe fromcache (return . Just) =<< fromenv
 	fromconfig = do
 		let key = credPairRemoteField storage
 		mcipher <- remoteCipher' c gc
-		case (fromProposedAccepted <$> getRemoteConfigValue key c, mcipher) of
+		case (getRemoteConfigValue key c, mcipher) of
 			(Nothing, _) -> return Nothing
 			(Just enccreds, Just (cipher, storablecipher)) ->
 				fromenccreds enccreds cipher storablecipher

Remote/Glacier.hs

@@ -118,16 +118,17 @@ glacierSetup ss mu mcreds c gc = do
 	glacierSetup' ss u mcreds c gc
 glacierSetup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
 glacierSetup' ss u mcreds c gc = do
-	(c', encsetup) <- encryptionSetup c gc
+	(c', encsetup) <- encryptionSetup (c `M.union` defaults) gc
-	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
+	pc <- either giveup return . parseRemoteConfig c'
-	let fullconfig = c'' `M.union` defaults
+		=<< configParser remote c'
-	pc <- either giveup return . parseRemoteConfig fullconfig
+	c'' <- setRemoteCredPair encsetup pc gc (AWS.creds u) mcreds
-		=<< configParser remote fullconfig
+	pc' <- either giveup return . parseRemoteConfig c''
+		=<< configParser remote c''
 	case ss of
-		Init -> genVault pc gc u
+		Init -> genVault pc' gc u
 		_ -> return ()
-	gitConfigSpecialRemote u fullconfig [("glacier", "true")]
+	gitConfigSpecialRemote u c'' [("glacier", "true")]
-	return (fullconfig, u)
+	return (c'', u)
   where
 	remotename = fromJust (lookupName c)
 	defvault = remotename ++ "-" ++ fromUUID u

Remote/Helper/Chunked.hs

@@ -247,13 +247,14 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 		let ls' = maybe ls (setupResume ls) currsize
 		if any null ls'
 			then noop -- dest is already complete
-			else firstavail currsize ls'
+			else firstavail Nothing currsize ls'
 
-	firstavail _ [] = giveup "chunk retrieval failed"
+	firstavail Nothing _ [] = giveup "chunk retrieval failed"
-	firstavail currsize ([]:ls) = firstavail currsize ls
+	firstavail (Just e) _ [] = throwM e
-	firstavail currsize ((k:ks):ls)
+	firstavail pe currsize ([]:ls) = firstavail pe currsize ls
+	firstavail _ currsize ((k:ks):ls)
 		| k == basek = getunchunked
-			`catchNonAsync` (const $ firstavail currsize ls)
+			`catchNonAsync` (\e -> firstavail (Just e) currsize ls)
 		| otherwise = do
 			let offset = resumeOffset currsize k
 			let p = maybe basep
@@ -269,7 +270,7 @@ retrieveChunks retriever u chunkconfig encryptor basek dest basep sink
 			case v of
 				Left e
 					| null ls -> throwM e
-					| otherwise -> firstavail currsize ls
+					| otherwise -> firstavail (Just e) currsize ls
 				Right r -> return r
 
 	getrest _ _ _ _ [] = noop

Remote/S3.hs

@@ -243,7 +243,7 @@ s3Setup ss mu mcreds c gc = do
 	s3Setup' ss u mcreds c gc
 
 s3Setup' :: SetupStage -> UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
-s3Setup' ss u mcreds c gc
+s3Setup'  ss u mcreds c gc
 	| maybe False (isIAHost . fromProposedAccepted) (M.lookup hostField c) = archiveorg
 	| otherwise = defaulthost
   where
@@ -263,21 +263,24 @@ s3Setup' ss u mcreds c gc
 		return (fullconfig, u)
 
 	defaulthost = do
-		(c', encsetup) <- encryptionSetup c gc
+		(c', encsetup) <- encryptionSetup (c `M.union` defaults) gc
-		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
+		pc <- either giveup return . parseRemoteConfig c'
-		let fullconfig = c'' `M.union` defaults
+			=<< configParser remote c'
-		pc <- either giveup return . parseRemoteConfig fullconfig
+		c'' <- setRemoteCredPair encsetup pc gc (AWS.creds u) mcreds
-			=<< configParser remote fullconfig
+		pc' <- either giveup return . parseRemoteConfig c''
-		info <- extractS3Info pc
+			=<< configParser remote c''
-		checkexportimportsafe pc info
+		info <- extractS3Info pc'
+		checkexportimportsafe pc' info
 		case ss of
-			Init -> genBucket pc gc u
+			Init -> genBucket pc' gc u
 			_ -> return ()
-		use fullconfig pc info
+		use c'' pc' info
 
 	archiveorg = do
 		showNote "Internet Archive mode"
-		c' <- setRemoteCredPair noEncryptionUsed c gc (AWS.creds u) mcreds
+		pc <- either giveup return . parseRemoteConfig c
+			=<< configParser remote c
+		c' <- setRemoteCredPair noEncryptionUsed pc gc (AWS.creds u) mcreds
 		-- Ensure user enters a valid bucket name, since
 		-- this determines the name of the archive.org item.
 		let validbucket = replace " " "-" $ map toLower $
@@ -292,14 +295,14 @@ s3Setup' ss u mcreds c gc
 			M.union c' $
 			-- special constraints on key names
 			M.insert mungekeysField (Proposed "ia") defaults
-		pc <- either giveup return . parseRemoteConfig archiveconfig
+		pc' <- either giveup return . parseRemoteConfig archiveconfig
 			=<< configParser remote archiveconfig
-		info <- extractS3Info pc
+		info <- extractS3Info pc'
-		checkexportimportsafe pc info
+		checkexportimportsafe pc' info
-		hdl <- mkS3HandleVar pc gc u
+		hdl <- mkS3HandleVar pc' gc u
 		withS3HandleOrFail u hdl $
-			writeUUIDFile pc u info
+			writeUUIDFile pc' u info
-		use archiveconfig pc info
+		use archiveconfig pc' info
 	
 	checkexportimportsafe c' info =
 		unlessM (Annex.getState Annex.force) $

Remote/WebDAV.hs

@@ -134,7 +134,7 @@ webdavSetup _ mu mcreds c gc = do
 	creds <- maybe (getCreds pc gc u) (return . Just) mcreds
 	testDav url creds
 	gitConfigSpecialRemote u c' [("webdav", "true")]
-	c'' <- setRemoteCredPair encsetup c' gc (davCreds u) creds
+	c'' <- setRemoteCredPair encsetup pc gc (davCreds u) creds
 	return (c'', u)
 
 store :: DavHandleVar -> ChunkConfig -> Storer

doc/bugs/git_annex_creds_are_not_embedded_with_newer_git-annex_clients.mdwn

@@ -55,3 +55,4 @@ Linux, Ubuntu 20.04
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 
+> [[fixed|done]] --[[Joey]]

doc/bugs/git_annex_creds_are_not_embedded_with_newer_git-annex_clients/comment_1_48953f4f0eacdba05b200f972204270d._comment

@@ -6,4 +6,6 @@
 I tried this and the result is that git-annex get from S3 fails. While I do
 think it should be writing the creds cache file, the failure to get is the
 actual bug symptom.
+
+Fixed this reversion.
 """]]