Support hot-swapping of removable drives containing gcrypt repositories.

To support this, a core.gcrypt-id is stored by git-annex inside the git
config of a local gcrypt repository, when setting it up.

That is compared with the remote's cached gcrypt-id. When different, a
drive has been changed. git-annex then looks up the remote config for
the uuid mapped from the core.gcrypt-id, and tweaks the configuration
appropriately. When there is no known config for the uuid, it will refuse to
use the remote.

11 files changed, 76 insertions, 37 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 09e89e38f..960ed4ada 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -42,7 +42,7 @@ remote = RemoteType {
 	setup = bupSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	bupr <- liftIO $ bup2GitRemote buprepo
 	cst <- remoteCost gc $
@@ -72,7 +72,7 @@ gen r u c gc = do
 		, globallyAvailable = not $ bupLocal buprepo
 		, readonly = False
 		}
-	return $ encryptableRemote c
+	return $ Just $ encryptableRemote c
 		(storeEncrypted new buprepo)
 		(retrieveEncrypted buprepo)
 		new
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 8eb317418..1c09e0e3c 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -37,11 +37,11 @@ remote = RemoteType {
 	setup = directorySetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	cst <- remoteCost gc cheapRemoteCost
 	let chunksize = chunkSize c
-	return $ encryptableRemote c
+	return $ Just $ encryptableRemote c
 		(storeEncrypted dir (getGpgEncParams (c,gc)) chunksize)
 		(retrieveEncrypted dir chunksize)
 		Remote {
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 3c0706989..cbe804c2f 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -18,6 +18,7 @@ import qualified Git
 import qualified Git.Command
 import qualified Git.Config
 import qualified Git.GCrypt
+import qualified Git.Construct
 import qualified Git.Types as Git ()
 import qualified Annex.Branch
 import qualified Annex.Content
@@ -32,6 +33,7 @@ import Annex.UUID
 import Annex.Ssh
 import qualified Remote.Rsync
 import Utility.Rsync
+import Logs.Remote
 
 remote :: RemoteType
 remote = RemoteType {
@@ -43,7 +45,7 @@ remote = RemoteType {
 	setup = gCryptSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen gcryptr u c gc = do
 	g <- gitRepo
 	-- get underlying git repo with real path, not gcrypt path
@@ -53,9 +55,32 @@ gen gcryptr u c gc = do
 	r'' <- if Git.repoIsLocalUnknown r'
 		then liftIO $ catchDefaultIO r' $ Git.Config.read r'
 		else return r'
-	gen' r'' u c gc
-
-gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+	-- doublecheck that local cache matches underlying repo's gcrypt-id
+	-- (which might not be set)
+	case (Git.Config.getMaybe "core.gcrypt-id" r'', Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of
+		(Just gcryptid, Just cachedgcryptid)
+			| gcryptid /= cachedgcryptid -> resetup gcryptid r''
+		_ -> gen' r'' u c gc
+  where
+	-- A different drive may have been mounted, making a different
+	-- gcrypt remote available. So need to set the cached
+	-- gcrypt-id and annex-uuid of the remote to match the remote
+	-- that is now available. Also need to set the gcrypt particiants
+	-- correctly.
+	resetup gcryptid r = do
+		let u' = genUUIDInNameSpace gCryptNameSpace gcryptid
+		v <- (M.lookup u' <$> readRemoteLog)
+		case (Git.remoteName gcryptr, v) of
+			(Just remotename, Just c') -> do
+				setGcryptEncryption c' remotename
+				setConfig (remoteConfig gcryptr "uuid") (fromUUID u')
+				setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid
+				gen' r u' c' gc
+			_ -> do
+				warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r
+				return Nothing
+
+gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen' r u c gc = do
 	cst <- remoteCost gc $
 		if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
@@ -80,7 +105,7 @@ gen' r u c gc = do
 		, globallyAvailable = globallyAvailableCalc r
 		, remotetype = remote
 	}
-	return $ encryptableRemote c
+	return $ Just $ encryptableRemote c
 		(store this rsyncopts)
 		(retrieve this rsyncopts)
 		this
@@ -117,14 +142,7 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
 			, Param $ Git.GCrypt.urlPrefix ++ gitrepo
 			]
 
-		{- Configure gcrypt to use the same list of keyids that
-		 - were passed to initremote, unless shared encryption
-		 - was used. -}
-		case extractCipher c' of
-			Nothing -> noCrypto
-			Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) ->
-				setConfig (ConfigKey $ Git.GCrypt.remoteParticipantConfigKey remotename) (unwords ks)
-			_ -> noop
+		setGcryptEncryption c' remotename
 
 		{- Run a git fetch and a push to the git repo in order to get
 		 - its gcrypt-id set up, so that later git annex commands
@@ -143,14 +161,34 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
 		g <- inRepo Git.Config.reRead
 		case Git.GCrypt.remoteRepoId g (Just remotename) of
 			Nothing -> error "unable to determine gcrypt-id of remote"
-			Just v -> do
-				let u = genUUIDInNameSpace gCryptNameSpace v
+			Just gcryptid -> do
+				let u = genUUIDInNameSpace gCryptNameSpace gcryptid
 				if Just u == mu || mu == Nothing
 					then do
+						-- Store gcrypt-id in local
+						-- gcrypt repository, for later
+						-- double-check.
+						r <- inRepo $ Git.Construct.fromRemoteLocation gitrepo
+						when (Git.repoIsLocalUnknown r) $ do
+							r' <- liftIO $ Git.Config.read r
+							liftIO $ Git.Command.run [Param "config", Param "core.gcrypt-id", Param gcryptid] r'
 						gitConfigSpecialRemote u c' "gcrypt" "true"
 						return (c', u)
 					else error "uuid mismatch"
 
+{- Configure gcrypt to use the same list of keyids that
+ - were passed to initremote. (For shared encryption,
+ - gcrypt's default behavior is used.) -}
+setGcryptEncryption :: RemoteConfig -> String -> Annex ()
+setGcryptEncryption c remotename = do
+	let participants = ConfigKey $ Git.GCrypt.remoteParticipantConfigKey remotename
+	case extractCipher c of
+		Nothing -> noCrypto
+		Just (EncryptedCipher _ _ (KeyIds { keyIds = ks})) ->
+			setConfig participants (unwords ks)
+		Just (SharedCipher _) ->
+			unsetConfig participants
+
 store :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
 store r rsyncopts (cipher, enck) k p
 	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 795823ca6..d761b03ba 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -92,13 +92,13 @@ configRead r = do
 		(False, _, NoUUID) -> tryGitConfigRead r
 		_ -> return r
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc
 	| Git.GCrypt.isEncrypted r = Remote.GCrypt.gen r u c gc
 	| otherwise = go <$> remoteCost gc defcst
   where
 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
-	go cst = new
+	go cst = Just new
 	  where
 		new = Remote 
 			{ uuid = u
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index f351c66e9..ecdc6a656 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -40,10 +40,10 @@ remote = RemoteType {
 	setup = glacierSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
   where
-	new cst = encryptableRemote c
+	new cst = Just $ encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
 		this
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 6a8e44ab5..ba20f3566 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -35,10 +35,10 @@ remote = RemoteType {
 	setup = hookSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
-	return $ encryptableRemote c
+	return $ Just $ encryptableRemote c
 		(storeEncrypted hooktype $ getGpgEncParams (c,gc))
 		(retrieveEncrypted hooktype)
 		Remote {
diff --git a/Remote/List.hs b/Remote/List.hs
index f38c1daaa..271ee8794 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -67,7 +67,7 @@ remoteList = do
 			return rs'
 		else return rs
   where
-	process m t = enumerate t >>= mapM (remoteGen m t)
+	process m t = enumerate t >>= mapM (remoteGen m t) >>= return . catMaybes
 
 {- Forces the remoteList to be re-generated, re-reading the git config. -}
 remoteListRefresh :: Annex [Remote]
@@ -80,16 +80,17 @@ remoteListRefresh = do
 	remoteList
 
 {- Generates a Remote. -}
-remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
+remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
 remoteGen m t r = do
 	u <- getRepoUUID r
 	g <- fromRepo id
 	let gc = extractRemoteGitConfig g (Git.repoDescribe r)
 	let c = fromMaybe M.empty $ M.lookup u m
-	addHooks <$> generate t r u c gc
+	mrmt <- generate t r u c gc
+	return $ addHooks <$> mrmt
 
 {- Updates a local git Remote, re-reading its git config. -}
-updateRemote :: Remote -> Annex Remote
+updateRemote :: Remote -> Annex (Maybe Remote)
 updateRemote remote = do
 	m <- readRemoteLog
 	remote' <- updaterepo $ repo remote
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index b328f6560..f1e6fd85e 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -58,14 +58,14 @@ remote = RemoteType {
 	setup = rsyncSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = do
 	cst <- remoteCost gc expensiveRemoteCost
 	(transport, url) <- rsyncTransport gc $
 		fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
 	let o = genRsyncOpts c gc transport url
 	let islocal = rsyncUrlIsPath $ rsyncUrl o
-	return $ encryptableRemote c
+	return $ Just $ encryptableRemote c
 		(storeEncrypted o $ getGpgEncParams (c,gc))
 		(retrieveEncrypted o)
 		Remote
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 4f04bb7af..67d87df50 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -43,10 +43,10 @@ remote = RemoteType {
 	setup = s3Setup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
   where
-	new cst = encryptableRemote c
+	new cst = Just $ encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
 		this
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 5b8df2994..789aab698 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -43,9 +43,9 @@ list = do
 	r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
 	return [r]
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r _ _ gc = 
-	return Remote {
+	return $ Just Remote {
 		uuid = webUUID,
 		cost = expensiveRemoteCost,
 		name = Git.repoDescribe r,
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 7c1949047..97a6d96f9 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -46,10 +46,10 @@ remote = RemoteType {
 	setup = webdavSetup
 }
 
-gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
 gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
   where
-	new cst = encryptableRemote c
+	new cst = Just $ encryptableRemote c
 		(storeEncrypted this)
 		(retrieveEncrypted this)
 		this