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.

Assistant/Threads/MountWatcher.hs

@@ -174,14 +174,14 @@ remotesUnder dir = do
 	pairs <- liftAnnex $ mapM (checkremote repotop) rs
 	let (waschanged, rs') = unzip pairs
 	when (any id waschanged) $ do
-		liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = rs' }
+		liftAnnex $ Annex.changeState $ \s -> s { Annex.remotes = catMaybes rs' }
 		updateSyncRemotes
-	return $ map snd $ filter fst pairs
+	return $ catMaybes $ map snd $ filter fst pairs
   where
 	checkremote repotop r = case Remote.localpath r of
 		Just p | dirContains dir (absPathFrom repotop p) ->
 			(,) <$> pure True <*> updateRemote r
-		_ -> return (False, r)
+		_ -> return (False, Just r)
 
 type MountPoints = S.Set Mntent
 

Config.hs

@@ -36,8 +36,11 @@ setConfig (ConfigKey key) value = do
 
 {- Unsets a git config setting. (Leaves it in state currently.) -}
 unsetConfig :: ConfigKey -> Annex ()
-unsetConfig (ConfigKey key) = inRepo $ Git.Command.run
-	[Param "config", Param "--unset", Param key]
+unsetConfig ck@(ConfigKey key) = ifM (isJust <$> getConfigMaybe ck)
+	( inRepo $ Git.Command.run
+		[Param "config", Param "--unset", Param key]
+	, noop -- avoid unsetting something not set; that would fail
+	)
 
 {- A per-remote config setting in git config. -}
 remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey

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

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 {

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
+	-- 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 Remote
+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 $

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

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

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 {

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

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

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

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,

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

Types/Remote.hs

@@ -29,7 +29,7 @@ data RemoteTypeA a = RemoteType {
 	-- enumerates remotes of this type
 	enumerate :: a [Git.Repo],
 	-- generates a remote of this type
-	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
+	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a)),
 	-- initializes or changes a remote
 	setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID)
 }

debian/changelog

@@ -1,5 +1,6 @@
 git-annex (4.20130912) UNRELEASED; urgency=low
 
+  * Support hot-swapping of removable drives containing gcrypt repositories.
   * remotes: New command, displays a compact table of remotes that
     contain files.
     (Thanks, anarcat for display code and mastensg for inspiration.)