implement exporttree=yes configuration

* Only export to remotes that were initialized to support it.
* Prevent storing key/value on export remotes.
* Prevent enabling exporttree=yes and encryption in the same remote.

SetupStage Enable was changed to take the old RemoteConfig.
This allowed only setting exporttree when initially setting up a
remote, and not configuring it later after stuff might already be stored
in the remote.

Went with =yes rather than =true for consistency with other parts of
git-annex. Changed docs accordingly.

This commit was supported by the NSF-funded DataLad project.

6 files changed, 51 insertions, 9 deletions

diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index e2e517b84..6adf6477a 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -37,14 +37,14 @@ remote = RemoteType {
 	typename = "directory",
 	enumerate = const (findSpecialRemotes "directory"),
 	generate = gen,
-	setup = directorySetup
+	setup = exportableRemoteSetup directorySetup
 }
 
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	cst <- remoteCost gc cheapRemoteCost
 	let chunkconfig = getChunkConfig c
-	return $ Just $ specialRemote c
+	return $ Just $ exportableRemote $ specialRemote c
 		(prepareStore dir chunkconfig)
 		(retrieve dir chunkconfig)
 		(simplyPrepare $ remove dir)
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 129d5e171..64fb51af8 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -111,7 +111,7 @@ gitSetup Init mu _ c _ = do
 	if isNothing mu || mu == Just u
 		then return (c, u)
 		else error "git remote did not have specified uuid"
-gitSetup Enable (Just u) _ c _ = do
+gitSetup (Enable _) (Just u) _ c _ = do
 	inRepo $ Git.Command.run
 		[ Param "remote"
 		, Param "add"
@@ -119,7 +119,7 @@ gitSetup Enable (Just u) _ c _ = do
 		, Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
 		]
 	return (c, u)
-gitSetup Enable Nothing _ _ _ = error "unable to enable git remote with no specified uuid"
+gitSetup (Enable _) Nothing _ _ _ = error "unable to enable git remote with no specified uuid"
 
 {- It's assumed to be cheap to read the config of non-URL remotes, so this is
  - done each time git-annex is run in a way that uses remotes.
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index b21167aaf..67e1b8b2e 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -89,8 +89,9 @@ glacierSetup' ss u mcreds c gc = do
 	(c', encsetup) <- encryptionSetup c gc
 	c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 	let fullconfig = c'' `M.union` defaults
-	when (ss == Init) $
-		genVault fullconfig gc u
+	case ss of
+		Init -> genVault fullconfig gc u
+		_ -> return ()
 	gitConfigSpecialRemote u fullconfig "glacier" "true"
 	return (fullconfig, u)
   where
diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs
index 1fe6d75be..97e55a415 100644
--- a/Remote/Helper/Encryptable.hs
+++ b/Remote/Helper/Encryptable.hs
@@ -15,6 +15,7 @@ module Remote.Helper.Encryptable (
 	embedCreds,
 	cipherKey,
 	extractCipher,
+	isEncrypted,
 	describeEncryption,
 ) where
 
@@ -57,7 +58,7 @@ encryptionSetup c gc = do
 	encryption = M.lookup "encryption" c
 	-- Generate a new cipher, depending on the chosen encryption scheme
 	genCipher cmd = case encryption of
-		_ | M.member "cipher" c || M.member "cipherkeys" c || M.member "pubkeys" c -> cannotchange
+		_ | hasEncryptionConfig c -> cannotchange
 		Just "none" -> return (c, NoEncryption)
 		Just "shared" -> encsetup $ genSharedCipher cmd
 		-- hybrid encryption is the default when a keyid is
@@ -167,6 +168,15 @@ extractCipher c = case (M.lookup "cipher" c,
   where
 	readkeys = KeyIds . splitc ','
 
+isEncrypted :: RemoteConfig -> Bool
+isEncrypted c = case M.lookup "encryption" c of
+	Just "none" -> False
+	Just _ -> True
+	Nothing -> hasEncryptionConfig c
+
+hasEncryptionConfig :: RemoteConfig -> Bool
+hasEncryptionConfig c = M.member "cipher" c || M.member "cipherkeys" c || M.member "pubkeys" c
+
 describeEncryption :: RemoteConfig -> String
 describeEncryption c = case extractCipher c of
 	Nothing -> "none"
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index d623818e7..9bbbb1f59 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -9,7 +9,12 @@ module Remote.Helper.Export where
 
 import Annex.Common
 import Types.Remote
+import Types.Creds
+import Remote.Helper.Encryptable (isEncrypted)
 
+import qualified Data.Map as M
+
+-- | Use for remotes that do not support exports.
 exportUnsupported :: ExportActions Annex
 exportUnsupported = ExportActions
 	{ exportSupported = return False
@@ -19,3 +24,28 @@ exportUnsupported = ExportActions
 	, checkPresentExport = \_ _ -> return False
 	, renameExport = \_ _ _ -> return False
 	}
+
+-- | A remote that supports exports when configured with exporttree=yes,
+-- and otherwise does not.
+exportableRemote :: Remote -> Remote
+exportableRemote r = case M.lookup "exporttree" (config r) of
+	Just "yes" -> r
+		{ storeKey = \_ _ _ -> do
+			warning "remote is configured with exporttree=yes; use `git-annex export` to store content on it"
+			return False
+		}
+	_ -> r
+		{ exportActions = exportUnsupported }
+
+exportableRemoteSetup :: (SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)) -> SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)
+exportableRemoteSetup setupaction st mu cp c gc = case st of
+	Init -> case M.lookup "exporttree" c of
+		Just "yes" | isEncrypted c ->
+			giveup "cannot enable both encryption and exporttree"
+		_ -> cont
+	Enable oldc
+		| M.lookup "exporttree" c /= M.lookup "exporttree" oldc ->
+			giveup "cannot change exporttree of existing special remote"
+		| otherwise -> cont
+  where
+	cont = setupaction st mu cp c gc
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 341d14b4e..ffa6a11bb 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -129,8 +129,9 @@ s3Setup' ss u mcreds c gc
 		(c', encsetup) <- encryptionSetup c gc
 		c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
 		let fullconfig = c'' `M.union` defaults
-		when (ss == Init) $
-			genBucket fullconfig gc u
+		case ss of
+			Init -> genBucket fullconfig gc u
+			_ -> return ()
 		use fullconfig
 
 	archiveorg = do