partially complete gcrypt remote (local send done; rest not)

This is a git-remote-gcrypt encrypted special remote. Only sending files
in to the remote works, and only for local repositories.

Most of the work so far has involved making initremote work. A particular
problem is that remote setup in this case needs to generate its own uuid,
derivied from the gcrypt-id. That required some larger changes in the code
to support.

For ssh remotes, this will probably just reuse Remote.Rsync's code, so
should be easy enough. And for downloading from a web remote, I will need
to factor out the part of Remote.Git that does that.

One particular thing that will need work is supporting hot-swapping a local
gcrypt remote. I think it needs to store the gcrypt-id in the git config of the
local remote, so that it can check it every time, and compare with the
cached annex-uuid for the remote. If there is a mismatch, it can change
both the cached annex-uuid and the gcrypt-id. That should work, and I laid
some groundwork for it by already reading the remote's config when it's
local. (Also needed for other reasons.)

This commit was sponsored by Daniel Callahan.

Assistant/MakeRemote.hs

@@ -68,8 +68,8 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
 	go =<< Command.InitRemote.findExisting name
   where
   	go Nothing = setupSpecialRemote name Rsync.remote config
-		=<< Command.InitRemote.generateNew name
-	go (Just v) = setupSpecialRemote name Rsync.remote config v
+		(Nothing, Command.InitRemote.newConfig name)
+	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config (Just u, c)
 	config = M.fromList
 		[ ("encryption", "shared")
 		, ("rsyncurl", location)
@@ -89,7 +89,7 @@ initSpecialRemote name remotetype config = go 0
 		r <- Command.InitRemote.findExisting fullname
 		case r of
 			Nothing -> setupSpecialRemote fullname remotetype config
-				=<< Command.InitRemote.generateNew fullname
+				(Nothing, Command.InitRemote.newConfig fullname)
 			Just _ -> go (n + 1)
 
 {- Enables an existing special remote. -}
@@ -98,15 +98,15 @@ enableSpecialRemote name remotetype config = do
 	r <- Command.InitRemote.findExisting name
 	case r of
 		Nothing -> error $ "Cannot find a special remote named " ++ name
-		Just v -> setupSpecialRemote name remotetype config v
+		Just (u, c) -> setupSpecialRemote name remotetype config (Just u, c)
 
-setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (UUID, R.RemoteConfig) -> Annex RemoteName
-setupSpecialRemote name remotetype config (u, c) = do
+setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> (Maybe UUID, R.RemoteConfig) -> Annex RemoteName
+setupSpecialRemote name remotetype config (mu, c) = do
 	{- Currently, only 'weak' ciphers can be generated from the
 	 - assistant, because otherwise GnuPG may block once the entropy
 	 - pool is drained, and as of now there's no way to tell the user
 	 - to perform IO actions to refill the pool. -}
-	c' <- R.setup remotetype u $
+	(c', u) <- R.setup remotetype mu $
 		M.insert "highRandomQuality" "false" $ M.union config c
 	describeUUID u name
 	configSet u c'

Command/EnableRemote.hs

@@ -47,8 +47,8 @@ unknownNameError prefix = do
 
 perform :: RemoteType -> UUID -> R.RemoteConfig -> CommandPerform
 perform t u c = do
-	c' <- R.setup t u c
-	next $ cleanup u c'
+	(c', u') <- R.setup t (Just u) c
+	next $ cleanup u' c'
 
 cleanup :: UUID -> R.RemoteConfig -> CommandCleanup
 cleanup u c = do

Command/InitRemote.hs

@@ -14,7 +14,6 @@ import Command
 import qualified Remote
 import qualified Logs.Remote
 import qualified Types.Remote as R
-import Annex.UUID
 import Logs.UUID
 import Logs.Trust
 
@@ -34,18 +33,18 @@ start (name:ws) = ifM (isJust <$> findExisting name)
 	( error $ "There is already a special remote named \"" ++ name ++
 		"\". (Use enableremote to enable an existing special remote.)"
 	, do
-		(u, c) <- generateNew name
+		let c = newConfig name
 		t <- findType config
 
 		showStart "initremote" name
-		next $ perform t u name $ M.union config c
+		next $ perform t name $ M.union config c
 	)
   where
 	config = Logs.Remote.keyValToConfig ws
 
-perform :: RemoteType -> UUID -> String -> R.RemoteConfig -> CommandPerform
-perform t u name c = do
-	c' <- R.setup t u c
+perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform
+perform t name c = do
+	(c', u) <- R.setup t Nothing c
 	next $ cleanup u name c'
 
 cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup
@@ -63,10 +62,8 @@ findExisting name = do
 		<$> Logs.Remote.readRemoteLog
 	return $ headMaybe matches
 
-generateNew :: String -> Annex (UUID, R.RemoteConfig)
-generateNew name = do
-	uuid <- liftIO genUUID
-	return (uuid, M.singleton nameKey name)
+newConfig :: String -> R.RemoteConfig
+newConfig name = M.singleton nameKey name
 
 findByName :: String ->  M.Map UUID R.RemoteConfig -> [(UUID, R.RemoteConfig)]
 findByName n = filter (matching . snd) . M.toList

Git/GCrypt.hs

@@ -44,23 +44,25 @@ encryptedRepo baserepo = go
 	go _ = notencrypted
 	notencrypted = error "not a gcrypt encrypted repository"
 
+type RemoteName = String
+
 {- gcrypt gives each encrypted repository a uique gcrypt-id,
  - which is stored in the repository (in encrypted form)
  - and cached in a per-remote gcrypt-id configuration setting. -}
-remoteRepoId :: Repo -> Repo -> Maybe String
+remoteRepoId :: Repo -> Maybe RemoteName -> Maybe String
 remoteRepoId = getRemoteConfig "gcrypt-id"
 
-getRemoteConfig :: String -> Repo -> Repo -> Maybe String
-getRemoteConfig field baserepo remote = do
-	name <- remoteName remote
-	Config.getMaybe (remoteConfigKey field name) baserepo
+getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String
+getRemoteConfig field repo remotename = do
+	n <- remotename
+	Config.getMaybe (remoteConfigKey field n) repo
 
 {- Gpg keys that the remote is encrypted for.
  - If empty, gcrypt uses --default-recipient-self -}
-particiantList :: Maybe Repo -> Repo -> Repo -> KeyIds
-particiantList globalconfigrepo baserepo remote = KeyIds $ parse $ firstJust
-	[ getRemoteConfig "participants" baserepo remote
-	, Config.getMaybe defaultkey baserepo
+getParticiantList :: Maybe Repo -> Repo -> Maybe RemoteName -> KeyIds
+getParticiantList globalconfigrepo repo remotename = KeyIds $ parse $ firstJust
+	[ getRemoteConfig "gcrypt-participants" repo remotename
+	, Config.getMaybe defaultkey repo
 	, Config.getMaybe defaultkey =<< globalconfigrepo
 	]
   where
@@ -69,5 +71,8 @@ particiantList globalconfigrepo baserepo remote = KeyIds $ parse $ firstJust
 	parse (Just l) = words l
 	parse Nothing = []
 
-remoteConfigKey :: String -> String -> String
-remoteConfigKey key field = "remote." ++ field ++ "." ++ key
+remoteParticipantConfigKey :: RemoteName -> String
+remoteParticipantConfigKey = remoteConfigKey "gcrypt-participants"
+
+remoteConfigKey :: String -> RemoteName -> String
+remoteConfigKey key remotename = "remote." ++ remotename ++ "." ++ key

Remote/Bup.hs

@@ -29,6 +29,7 @@ import Data.ByteString.Lazy.UTF8 (fromString)
 import Data.Digest.Pure.SHA
 import Utility.UserInfo
 import Annex.Content
+import Annex.UUID
 import Utility.Metered
 
 type BupRepo = String
@@ -78,8 +79,10 @@ gen r u c gc = do
   where
 	buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
 
-bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
-bupSetup u c = do
+bupSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+bupSetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
+
 	-- verify configuration is sane
 	let buprepo = fromMaybe (error "Specify buprepo=") $
 		M.lookup "buprepo" c
@@ -96,7 +99,7 @@ bupSetup u c = do
 	-- persistant state, so it can vary between hosts.
 	gitConfigSpecialRemote u c' "buprepo" buprepo
 
-	return c'
+	return (c', u)
 
 bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam]
 bupParams command buprepo params = 

Remote/Directory.hs

@@ -26,6 +26,7 @@ import Remote.Helper.Encryptable
 import Remote.Helper.Chunked
 import Crypto
 import Annex.Content
+import Annex.UUID
 import Utility.Metered
 
 remote :: RemoteType
@@ -65,8 +66,9 @@ gen r u c gc = do
   where
 	dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
 
-directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
-directorySetup u c = do
+directorySetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+directorySetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let dir = fromMaybe (error "Specify directory=") $
 		M.lookup "directory" c
@@ -78,7 +80,7 @@ directorySetup u c = do
 	-- The directory is stored in git config, not in this remote's
 	-- persistant state, so it can vary between hosts.
 	gitConfigSpecialRemote u c' "directory" absdir
-	return $ M.delete "directory" c'
+	return (M.delete "directory" c', u)
 
 {- Locations to try to access a given Key in the Directory.
  - We try more than since we used to write to different hash directories. -}

Remote/GCrypt.hs

@@ -0,0 +1,164 @@
+{- git remotes encrypted using git-remote-gcrypt
+ -
+ - Copyright 2013 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.GCrypt (remote, gen) where
+
+import qualified Data.Map as M
+
+import Common.Annex
+import Types.Remote
+import Types.GitConfig
+import Types.Crypto
+import qualified Git
+import qualified Git.Command
+import qualified Git.Config
+import qualified Git.GCrypt
+import qualified Git.Types as Git ()
+import qualified Annex.Branch
+import qualified Annex.Content
+import Config
+import Config.Cost
+import Remote.Helper.Git
+import Remote.Helper.Encryptable
+import Utility.Metered
+import Crypto
+import Annex.UUID
+
+remote :: RemoteType
+remote = RemoteType {
+	typename = "gcrypt",
+	-- Remote.Git takes care of enumerating gcrypt remotes too,
+	-- and will call our gen on them.
+	enumerate = return [],
+	generate = gen,
+	setup = gCryptSetup
+}
+
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen gcryptr u c gc = do
+	g <- gitRepo
+	-- get underlying git repo with real path, not gcrypt path
+	r <- liftIO $ Git.GCrypt.encryptedRepo g gcryptr
+	let r' = r { Git.remoteName = Git.remoteName gcryptr }
+	-- read config of underlying repo if it's local
+	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
+gen' r u c gc = new <$> remoteCost gc defcst
+  where
+	defcst = if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
+	new cst = encryptableRemote c
+		(store this)
+		(retrieve this)
+		this
+	  where
+		this = Remote 
+			{ uuid = u
+			, cost = cst
+			, name = Git.repoDescribe r
+			, storeKey = \_ _ _ -> noCrypto
+			, retrieveKeyFile = \_ _ _ _ -> noCrypto
+			, retrieveKeyFileCheap = \_ _ -> return False
+			, removeKey = remove
+			, hasKey = checkPresent this
+			, hasKeyCheap = repoCheap r
+			, whereisKey = Nothing
+			, config = M.empty
+			, localpath = localpathCalc r
+			, repo = r
+			, gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r }
+			, readonly = Git.repoIsHttp r
+			, globallyAvailable = globallyAvailableCalc r
+			, remotetype = remote
+			}
+
+noCrypto :: Annex a
+noCrypto = error "cannot use gcrypt remote without encryption enabled"
+
+gCryptSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+gCryptSetup mu c = go $ M.lookup "gitrepo" c
+  where
+	remotename = fromJust (M.lookup "name" c)
+  	go Nothing = error "Specify gitrepo="
+	go (Just gitrepo) = do
+		c' <- encryptionSetup c
+		inRepo $ Git.Command.run 
+			[ Params "remote add"
+			, Param remotename
+			, 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
+
+		{- 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
+		 - will use the remote as a ggcrypt remote. The fetch is
+		 - needed if the repo already exists; the push is needed
+		 - if the repo has not yet been initialized by gcrypt. -}
+		void $ inRepo $ Git.Command.runBool
+			[ Param "fetch"
+			, Param remotename
+			]
+		void $ inRepo $ Git.Command.runBool
+			[ Param "push"
+			, Param remotename
+			, Param $ show $ Annex.Branch.fullname
+			]
+		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
+				if Just u == mu || mu == Nothing
+					then return (c', u)
+					else error "uuid mismatch"
+
+store :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+store r (cipher, enck) k p
+	| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $
+		sendwith $ \meterupdate h -> do
+			createDirectoryIfMissing True $ parentDir dest
+			readBytes (meteredWriteFile meterupdate dest) h
+			return True
+	| Git.repoIsSsh (repo r) = sendwith $ \h -> undefined
+	| otherwise = error "storing on non-ssh remote repo not supported"
+  where
+	dest = gCryptLocation r enck
+  	sendwith a = metered (Just p) k $ \meterupdate ->
+		Annex.Content.sendAnnex k noop $ \src ->
+			liftIO $ catchBoolIO $
+				encrypt (getGpgEncParams r) cipher (feedFile src) (a meterupdate)
+
+retrieve :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
+retrieve r (cipher, enck) k d p = undefined
+
+remove :: Key -> Annex Bool
+remove k = undefined
+
+checkPresent :: Remote -> Key -> Annex (Either String Bool)
+checkPresent r k
+	| not $ Git.repoIsUrl (repo r) =
+		guardUsable (repo r) unknown $
+			liftIO $ catchDefaultIO unknown $
+				Right <$> doesFileExist (gCryptLocation r k)
+	| Git.repoIsSsh (repo r) = undefined
+	| otherwise = error "storing on non-ssh remote repo not supported"
+  where
+	unknown = Left $ "unable to check " ++ Git.repoDescribe (repo r) ++ show (repo r)
+
+gCryptLocation :: Remote -> Key -> FilePath
+gCryptLocation r key = Git.repoLocation (repo r) </> annexLocation key hashDirLower

Remote/Git.hs

@@ -13,9 +13,6 @@ module Remote.Git (
 	repoAvail,
 ) where
 
-import qualified Data.Map as M
-import Control.Exception.Extensible
-
 import Common.Annex
 import Utility.Rsync
 import Remote.Helper.Ssh
@@ -47,10 +44,14 @@ import Utility.Metered
 #ifndef mingw32_HOST_OS
 import Utility.CopyFile
 #endif
+import Remote.Helper.Git
+import qualified Remote.GCrypt
 
 import Control.Concurrent
 import Control.Concurrent.MSampleVar
 import System.Process (std_in, std_err)
+import qualified Data.Map as M
+import Control.Exception.Extensible
 
 remote :: RemoteType
 remote = RemoteType {
@@ -91,11 +92,10 @@ configRead r = do
 		(False, _, NoUUID) -> tryGitConfigRead r
 		_ -> return r
 
-repoCheap :: Git.Repo -> Bool
-repoCheap = not . Git.repoIsUrl
-
 gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
-gen r u _ gc = go <$> remoteCost gc defcst
+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
@@ -112,14 +112,12 @@ gen r u _ gc = go <$> remoteCost gc defcst
 			, hasKeyCheap = repoCheap r
 			, whereisKey = Nothing
 			, config = M.empty
-			, localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
-				then Just $ Git.repoPath r
-				else Nothing
+			, localpath = localpathCalc r
 			, repo = r
 			, gitconfig = gc
 				{ remoteGitConfig = Just $ extractGitConfig r }
 			, readonly = Git.repoIsHttp r
-			, globallyAvailable = not $ Git.repoIsLocal r || Git.repoIsLocalUnknown r
+			, globallyAvailable = globallyAvailableCalc r
 			, remotetype = remote
 			}
 
@@ -131,13 +129,6 @@ repoAvail r
 	| Git.repoIsLocalUnknown r = return False
 	| otherwise = liftIO $ catchBoolIO $ onLocal r $ return True
 
-{- Avoids performing an action on a local repository that's not usable.
- - Does not check that the repository is still available on disk. -}
-guardUsable :: Git.Repo -> a -> Annex a -> Annex a
-guardUsable r onerr a
-	| Git.repoIsLocalUnknown r = return onerr
-	| otherwise = a
-
 {- Tries to read the config for a specified remote, updates state, and
  - returns the updated repo. -}
 tryGitConfigRead :: Git.Repo -> Annex Git.Repo
@@ -154,8 +145,9 @@ tryGitConfigRead r
 		headers <- getHttpHeaders
 		store $ geturlconfig headers
 	| Git.GCrypt.isEncrypted r = do
+		-- Generate a UUID from the gcrypt-id
 		g <- gitRepo
-		case Git.GCrypt.remoteRepoId g r of
+		case Git.GCrypt.remoteRepoId g (Git.remoteName r) of
 			Nothing -> return r
 			Just v -> store $ liftIO $ setUUID r $
 				genUUIDInNameSpace gCryptNameSpace v
@@ -261,17 +253,6 @@ inAnnex r key
 	unknown = Left $ "unable to check " ++ Git.repoDescribe r
 	showchecking = showAction $ "checking " ++ Git.repoDescribe r
 
-{- Runs an action on a local repository inexpensively, by making an annex
- - monad using that repository. -}
-onLocal :: Git.Repo -> Annex a -> IO a
-onLocal r a = do
-	s <- Annex.new r
-	Annex.eval s $ do
-		-- No need to update the branch; its data is not used
-		-- for anything onLocal is used to do.
-		Annex.BranchState.disableUpdate
-		a
-
 keyUrls :: Git.Repo -> Key -> [String]
 keyUrls r key = map tourl locs
   where
@@ -415,15 +396,16 @@ copyToRemote r key file p
 							(\d -> rsyncOrCopyFile params object d p)
 			)
 
-rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
-rsyncHelper callback params = do
-	showOutput -- make way for progress bar
-	ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
-		( return True
-		, do
-			showLongNote "rsync failed -- run git annex again to resume file transfer"
-			return False
-		)
+{- Runs an action on a local repository inexpensively, by making an annex
+ - monad using that repository. -}
+onLocal :: Git.Repo -> Annex a -> IO a
+onLocal r a = do
+	s <- Annex.new r
+	Annex.eval s $ do
+		-- No need to update the branch; its data is not used
+		-- for anything onLocal is used to do.
+		Annex.BranchState.disableUpdate
+		a
 
 {- Copys a file with rsync unless both locations are on the same
  - filesystem. Then cp could be faster. -}
@@ -456,6 +438,16 @@ rsyncOrCopyFile rsyncparams src dest p =
 	dorsync = rsyncHelper (Just p) $
 		rsyncparams ++ [File src, File dest]
 
+rsyncHelper :: Maybe MeterUpdate -> [CommandParam] -> Annex Bool
+rsyncHelper callback params = do
+	showOutput -- make way for progress bar
+	ifM (liftIO $ (maybe rsync rsyncProgress callback) params)
+		( return True
+		, do
+			showLongNote "rsync failed -- run git annex again to resume file transfer"
+			return False
+		)
+
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
 rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]

Remote/Glacier.hs

@@ -25,6 +25,7 @@ import Creds
 import Utility.Metered
 import qualified Annex
 import Annex.Content
+import Annex.UUID
 
 import System.Process
 
@@ -67,13 +68,18 @@ gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
 			remotetype = remote
 		}
 
-glacierSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
-glacierSetup u c = do
+glacierSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+glacierSetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
+	glacierSetup' u c
+glacierSetup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+glacierSetup' u c = do
 	c' <- encryptionSetup c
 	let fullconfig = c' `M.union` defaults
 	genVault fullconfig u
 	gitConfigSpecialRemote u fullconfig "glacier" "true"
-	setRemoteCredPair fullconfig (AWS.creds u)
+	c'' <- setRemoteCredPair fullconfig (AWS.creds u)
+	return (c'', u)
   where
 	remotename = fromJust (M.lookup "name" c)
 	defvault = remotename ++ "-" ++ fromUUID u

Remote/Helper/Git.hs

@@ -0,0 +1,30 @@
+{- Utilities for git remotes.
+ -
+ - Copyright 2011-2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Remote.Helper.Git where
+
+import Common.Annex
+import qualified Git
+
+repoCheap :: Git.Repo -> Bool
+repoCheap = not . Git.repoIsUrl
+
+localpathCalc :: Git.Repo -> Maybe FilePath
+localpathCalc r = if globallyAvailableCalc r
+	then Nothing
+	else Just $ Git.repoPath r
+
+globallyAvailableCalc :: Git.Repo -> Bool
+globallyAvailableCalc r = not $
+	Git.repoIsLocal r || Git.repoIsLocalUnknown r
+
+{- Avoids performing an action on a local repository that's not usable.
+ - Does not check that the repository is still available on disk. -}
+guardUsable :: Git.Repo -> a -> Annex a -> Annex a
+guardUsable r onerr a
+	| Git.repoIsLocalUnknown r = return onerr
+	| otherwise = a

Remote/Hook.hs

@@ -18,6 +18,7 @@ import qualified Git
 import Config
 import Config.Cost
 import Annex.Content
+import Annex.UUID
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
 import Crypto
@@ -62,13 +63,14 @@ gen r u c gc = do
   where
 	hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc	
 
-hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
-hookSetup u c = do
+hookSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+hookSetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
 	let hooktype = fromMaybe (error "Specify hooktype=") $
 		M.lookup "hooktype" c
 	c' <- encryptionSetup c
 	gitConfigSpecialRemote u c' "hooktype" hooktype
-	return c'
+	return (c', u)
 
 hookEnv :: Action -> Key -> Maybe FilePath -> IO (Maybe [(String, String)])
 hookEnv action k f = Just <$> mergeenv (fileenv f ++ keyenv)

Remote/List.hs

@@ -22,6 +22,7 @@ import qualified Git
 import qualified Git.Config
 
 import qualified Remote.Git
+import qualified Remote.GCrypt
 #ifdef WITH_S3
 import qualified Remote.S3
 #endif
@@ -38,6 +39,7 @@ import qualified Remote.Hook
 remoteTypes :: [RemoteType]
 remoteTypes =
 	[ Remote.Git.remote
+	, Remote.GCrypt.remote
 #ifdef WITH_S3
 	, Remote.S3.remote
 #endif

Remote/Rsync.hs

@@ -23,6 +23,7 @@ import qualified Git
 import Config
 import Config.Cost
 import Annex.Content
+import Annex.UUID
 import Annex.Ssh
 import Remote.Helper.Special
 import Remote.Helper.Encryptable
@@ -111,8 +112,9 @@ gen r u c gc = do
 					++ unwords rsh
 		else return ([], rawurl)
 
-rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
-rsyncSetup u c = do
+rsyncSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+rsyncSetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
 	-- verify configuration is sane
 	let url = fromMaybe (error "Specify rsyncurl=") $
 		M.lookup "rsyncurl" c
@@ -121,7 +123,7 @@ rsyncSetup u c = do
 	-- The rsyncurl is stored in git config, not only in this remote's
 	-- persistant state, so it can vary between hosts.
 	gitConfigSpecialRemote u c' "rsyncurl" url
-	return c'
+	return (c', u)
 
 rsyncEscape :: RsyncOpts -> String -> String
 rsyncEscape o s

Remote/S3.hs

@@ -30,6 +30,7 @@ import Crypto
 import Creds
 import Utility.Metered
 import Annex.Content
+import Annex.UUID
 import Logs.Web
 
 type Bucket = String
@@ -70,8 +71,12 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			remotetype = remote
 		}
 
-s3Setup :: UUID -> RemoteConfig -> Annex RemoteConfig
-s3Setup u c = if isIA c then archiveorg else defaulthost
+s3Setup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+s3Setup mu c = do
+	u <- maybe (liftIO genUUID) return mu
+	s3Setup' u c
+s3Setup' :: UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+s3Setup' u c = if isIA c then archiveorg else defaulthost
   where
 	remotename = fromJust (M.lookup "name" c)
 	defbucket = remotename ++ "-" ++ fromUUID u
@@ -85,7 +90,8 @@ s3Setup u c = if isIA c then archiveorg else defaulthost
 		
 	use fullconfig = do
 		gitConfigSpecialRemote u fullconfig "s3" "true"
-		setRemoteCredPair fullconfig (AWS.creds u)
+		c' <- setRemoteCredPair fullconfig (AWS.creds u)
+		return (c', u)
 
 	defaulthost = do
 		c' <- encryptionSetup c

Remote/WebDAV.hs

@@ -32,6 +32,7 @@ import Crypto
 import Creds
 import Utility.Metered
 import Annex.Content
+import Annex.UUID
 
 type DavUrl = String
 type DavUser = B8.ByteString
@@ -73,15 +74,17 @@ gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
 			remotetype = remote
 		}
 
-webdavSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
-webdavSetup u c = do
+webdavSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
+webdavSetup mu c = do
+	u <- maybe (liftIO genUUID) return mu
 	let url = fromMaybe (error "Specify url=") $
 		M.lookup "url" c
 	c' <- encryptionSetup c
 	creds <- getCreds c' u
 	testDav url creds
 	gitConfigSpecialRemote u c' "webdav" "true"
-	setRemoteCredPair c' (davCreds u)
+	c'' <- setRemoteCredPair c' (davCreds u)
+	return (c'', u)
 
 store :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
 store r k _f p = metered (Just p) k $ \meterupdate ->

Types/Crypto.hs

@@ -70,4 +70,4 @@ calcMac mac = case mac of
 	HmacSha384 -> showDigest $* hmacSha384
 	HmacSha512 -> showDigest $* hmacSha512
   where
-  ($*) g f x y = g $ f x y
+	($*) g f x y = g $ f x y

Types/Remote.hs

@@ -31,7 +31,7 @@ data RemoteTypeA a = RemoteType {
 	-- generates a remote of this type
 	generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
 	-- initializes or changes a remote
-	setup :: UUID -> RemoteConfig -> a RemoteConfig
+	setup :: Maybe UUID -> RemoteConfig -> a (RemoteConfig, UUID)
 }
 
 instance Eq (RemoteTypeA a) where