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.

11 files changed, 272 insertions, 60 deletions

diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 9ef335218..09e89e38f 100644
--- a/Remote/Bup.hs
+++ b/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 = 
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 0b3ce443b..8eb317418 100644
--- a/Remote/Directory.hs
+++ b/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. -}
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
new file mode 100644
index 000000000..f839f6647
--- /dev/null
+++ b/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
diff --git a/Remote/Git.hs b/Remote/Git.hs
index b3f64bfb8..93c923853 100644
--- a/Remote/Git.hs
+++ b/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]
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index d81066415..f351c66e9 100644
--- a/Remote/Glacier.hs
+++ b/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
diff --git a/Remote/Helper/Git.hs b/Remote/Helper/Git.hs
new file mode 100644
index 000000000..7c24ff2e7
--- /dev/null
+++ b/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
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 338d95ce7..6a8e44ab5 100644
--- a/Remote/Hook.hs
+++ b/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)
diff --git a/Remote/List.hs b/Remote/List.hs
index 0651d83aa..c106e9ad9 100644
--- a/Remote/List.hs
+++ b/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
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 4ad0fdadd..0887877e9 100644
--- a/Remote/Rsync.hs
+++ b/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
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 814dd3a23..4f04bb7af 100644
--- a/Remote/S3.hs
+++ b/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
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index c444a7f2b..7c1949047 100644
--- a/Remote/WebDAV.hs
+++ b/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 ->