git-annex 7.20191009 → 7.20191017

raw patch · 59 files changed

+847/−466 lines, 59 filesdep ~containers

Dependency ranges changed: containers

Files

• Annex/Branch.hs +24/−19
• Annex/Branch/Transitions.hs +46/−21
• Annex/Import.hs +5/−3
• Annex/SpecialRemote.hs +54/−31
• Annex/SpecialRemote/Config.hs +103/−0
• Assistant/Gpg.hs +6/−5
• Assistant/MakeRemote.hs +17/−10
• Assistant/WebApp/Configurators/AWS.hs +2/−1
• Assistant/WebApp/Configurators/IA.hs +2/−1
• Assistant/WebApp/Configurators/Ssh.hs +5/−2
• Assistant/WebApp/Configurators/WebDAV.hs +2/−1
• Assistant/WebApp/Gpg.hs +2/−1
• CHANGELOG +17/−0
• CmdLine/GitAnnex/Options.hs +5/−1
• Command/EnableRemote.hs +21/−16
• Command/InitRemote.hs +53/−21
• Command/RenameRemote.hs +13/−8
• Command/TestRemote.hs +1/−0
• Config.hs +2/−1
• Creds.hs +5/−5
• Crypto.hs +4/−3
• Database/ContentIdentifier.hs +15/−13
• Database/Handle.hs +14/−6
• Logs/ContentIdentifier.hs +5/−4
• Logs/MetaData.hs +8/−5
• Logs/Remote.hs +7/−72
• Logs/Remote/Pure.hs +104/−0
• Logs/RemoteState.hs +5/−4
• Remote/Adb.hs +3/−2
• Remote/BitTorrent.hs +3/−2
• Remote/Bup.hs +3/−2
• Remote/Ddar.hs +3/−2
• Remote/Directory.hs +5/−4
• Remote/External.hs +22/−16
• Remote/External/Types.hs +5/−3
• Remote/GCrypt.hs +12/−11
• Remote/Git.hs +11/−9
• Remote/GitLFS.hs +24/−23
• Remote/Glacier.hs +4/−3
• Remote/Helper/AWS.hs +1/−1
• Remote/Helper/Chunked.hs +3/−2
• Remote/Helper/Encryptable.hs +15/−12
• Remote/Helper/ExportImport.hs +6/−6
• Remote/Helper/Special.hs +4/−1
• Remote/Hook.hs +6/−4
• Remote/List.hs +9/−6
• Remote/P2P.hs +4/−3
• Remote/Rsync.hs +3/−2
• Remote/S3.hs +68/−66
• Remote/Tahoe.hs +20/−19
• Remote/Web.hs +3/−2
• Remote/WebDAV.hs +5/−4
• Types/GitConfig.hs +2/−0
• Types/Remote.hs +7/−4
• Types/RemoteState.hs +19/−0
• doc/git-annex-initremote.mdwn +19/−0
• doc/git-annex-renameremote.mdwn +1/−1
• doc/git-annex.mdwn +5/−0
• git-annex.cabal +5/−2

@@ -1,6 +1,6 @@ {- management of the git-annex branch  -- - Copyright 2011-2018 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -63,6 +63,7 @@ import Logs.Transitions import Logs.File import Logs.Trust.Pure+import Logs.Remote.Pure import Logs.Difference.Pure import qualified Annex.Queue import Annex.Branch.Transitions@@ -574,27 +575,30 @@ 	run [] = noop 	run changers = do 		trustmap <- calcTrustMap <$> getStaged trustLog+		remoteconfigmap <- calcRemoteConfigMap <$> getStaged remoteLog+		-- partially apply, improves performance+		let changers' = map (\c -> c trustmap remoteconfigmap) changers 		fs <- branchFiles 		forM_ fs $ \f -> do 			content <- getStaged f-			apply changers f content trustmap-	apply [] _ _ _ = return ()-	apply (changer:rest) file content trustmap =-		case changer file content trustmap of-			RemoveFile -> do-				Annex.Queue.addUpdateIndex-					=<< inRepo (Git.UpdateIndex.unstageFile file)-				-- File is deleted; can't run any other-				-- transitions on it.-				return ()-			ChangeFile builder -> do-				let content' = toLazyByteString builder-				sha <- hashBlob content'-				Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $-					Git.UpdateIndex.updateIndexLine sha TreeFile (asTopFilePath file)-				apply rest file content' trustmap-			PreserveFile ->-				apply rest file content trustmap+			apply changers' f content+	apply [] _ _ = return ()+	apply (changer:rest) file content = case changer file content of+		PreserveFile -> apply rest file content+		ChangeFile builder -> do+			let content' = toLazyByteString builder+			if L.null content'+				then do+					Annex.Queue.addUpdateIndex+						=<< inRepo (Git.UpdateIndex.unstageFile file)+					-- File is deleted; can't run any other+					-- transitions on it.+					return ()+				else do+					sha <- hashBlob content'+					Annex.Queue.addUpdateIndex $ Git.UpdateIndex.pureStreamer $+						Git.UpdateIndex.updateIndexLine sha TreeFile (asTopFilePath file)+					apply rest file content'  checkBranchDifferences :: Git.Ref -> Annex () checkBranchDifferences ref = do@@ -662,3 +666,4 @@ 	-- and the index was updated to that above, so it's safe to 	-- say that the index contains c'. 	setIndexSha c'+

@@ -17,9 +17,12 @@ import qualified Logs.Presence.Pure as Presence import qualified Logs.Chunk.Pure as Chunk import qualified Logs.MetaData.Pure as MetaData+import qualified Logs.Remote.Pure as Remote import Types.TrustLevel import Types.UUID import Types.MetaData+import Types.Remote+import Annex.SpecialRemote.Config  import qualified Data.Map as M import qualified Data.Set as S@@ -29,45 +32,67 @@  data FileTransition 	= ChangeFile Builder-	| RemoveFile 	| PreserveFile -type TransitionCalculator = FilePath -> L.ByteString -> TrustMap -> FileTransition+type TransitionCalculator = TrustMap -> M.Map UUID RemoteConfig -> FilePath -> L.ByteString -> FileTransition  getTransitionCalculator :: Transition -> Maybe TransitionCalculator getTransitionCalculator ForgetGitHistory = Nothing getTransitionCalculator ForgetDeadRemotes = Just dropDead -dropDead :: FilePath -> L.ByteString -> TrustMap -> FileTransition-dropDead f content trustmap = case getLogVariety f of+-- Removes data about all dead repos.+--+-- The trust log is not changed, because other, unmerged clones+-- may contain other data about the dead repos. So we need to rememebr+-- which are dead to later remove that.+--+-- When the remote log contains a sameas-uuid pointing to a dead uuid,+-- the uuid of that remote configuration is also effectively dead,+-- though not in the trust log. There may be per-remote state stored using+-- the latter uuid, that also needs to be removed. The sameas-uuid+-- is not removed from the remote log, for the same reason the trust log+-- is not changed.+dropDead :: TransitionCalculator+dropDead trustmap remoteconfigmap f content = case getLogVariety f of 	Just OldUUIDBasedLog-		-- Don't remove the dead repo from the trust log,-		-- because git remotes may still exist, and they need-		-- to still know it's dead. 		| f == trustLog -> PreserveFile+		| f == remoteLog -> ChangeFile $+			Remote.buildRemoteConfigLog $+				M.mapWithKey minimizesameasdead $+					dropDeadFromMapLog trustmap id $+						Remote.parseRemoteConfigLog content 		| otherwise -> ChangeFile $ 			UUIDBased.buildLogOld byteString $-				dropDeadFromMapLog trustmap id $+				dropDeadFromMapLog trustmap' id $ 					UUIDBased.parseLogOld A.takeByteString content 	Just NewUUIDBasedLog -> ChangeFile $ 		UUIDBased.buildLogNew byteString $-			dropDeadFromMapLog trustmap id $+			dropDeadFromMapLog trustmap' id $ 				UUIDBased.parseLogNew A.takeByteString content 	Just (ChunkLog _) -> ChangeFile $-		Chunk.buildLog $ dropDeadFromMapLog trustmap fst $ Chunk.parseLog content-	Just (PresenceLog _) ->-		let newlog = Presence.compactLog $-			dropDeadFromPresenceLog trustmap $ Presence.parseLog content-		in if null newlog-			then RemoveFile-			else ChangeFile $ Presence.buildLog newlog-	Just RemoteMetaDataLog ->-		let newlog = dropDeadFromRemoteMetaDataLog trustmap $ MetaData.simplifyLog $ MetaData.parseLog content-		in if S.null newlog-			then RemoveFile-			else ChangeFile $ MetaData.buildLog newlog+		Chunk.buildLog $ dropDeadFromMapLog trustmap' fst $+			Chunk.parseLog content+	Just (PresenceLog _) -> ChangeFile $ Presence.buildLog $+		Presence.compactLog $+			dropDeadFromPresenceLog trustmap' $+				Presence.parseLog content+	Just RemoteMetaDataLog -> ChangeFile $ MetaData.buildLog $+		dropDeadFromRemoteMetaDataLog trustmap' $+			MetaData.simplifyLog $ MetaData.parseLog content 	Just OtherLog -> PreserveFile 	Nothing -> PreserveFile+  where+	trustmap' = trustmap `M.union`+		M.map (const DeadTrusted) (M.filter sameasdead remoteconfigmap)+	sameasdead cm =+		case toUUID <$> M.lookup sameasUUIDField cm of+			Nothing -> False+			Just u' -> M.lookup u' trustmap == Just DeadTrusted+	minimizesameasdead u l+		| M.lookup u trustmap' == Just DeadTrusted =+			l { UUIDBased.value = minimizesameasdead' (UUIDBased.value l) }+		| otherwise = l+	minimizesameasdead' c = M.restrictKeys c (S.singleton sameasUUIDField)  dropDeadFromMapLog :: TrustMap -> (k -> UUID) -> M.Map k v -> M.Map k v dropDeadFromMapLog trustmap getuuid =

@@ -382,7 +382,7 @@ 			getTopFilePath subdir </> fromImportLocation loc  	getcidkey cidmap db cid = liftIO $-		CIDDb.getContentIdentifierKeys db (Remote.uuid remote) cid >>= \case+		CIDDb.getContentIdentifierKeys db rs cid >>= \case 			[] -> atomically $ 				maybeToList . M.lookup cid <$> readTVar cidmap 			l -> return l@@ -390,8 +390,10 @@ 	recordcidkey cidmap db cid k = do 		liftIO $ atomically $ modifyTVar' cidmap $ 			M.insert cid k-		liftIO $ CIDDb.recordContentIdentifier db (Remote.uuid remote) cid k-		CIDLog.recordContentIdentifier (Remote.uuid remote) cid k+		liftIO $ CIDDb.recordContentIdentifier db rs cid k+		CIDLog.recordContentIdentifier rs cid k++	rs = Remote.remoteStateHandle remote  {- Temporary key used for import of a ContentIdentifier while downloading  - content, before generating its real key. -}

@@ -1,19 +1,26 @@ {- git-annex special remote configuration  -- - Copyright 2011-2015 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} -module Annex.SpecialRemote where+module Annex.SpecialRemote (+	module Annex.SpecialRemote,+	module Annex.SpecialRemote.Config+) where  import Annex.Common-import Remote (remoteTypes, remoteMap)-import Types.Remote (RemoteConfig, RemoteConfigKey, SetupStage(..), typename, setup)+import Annex.SpecialRemote.Config+import Remote (remoteTypes)+import Types.Remote (RemoteConfig, SetupStage(..), typename, setup) import Types.GitConfig+import Config+import Remote.List import Logs.Remote import Logs.Trust import qualified Git.Config+import qualified Types.Remote as Remote import Git.Types (RemoteName)  import qualified Data.Map as M@@ -22,38 +29,54 @@ {- See if there's an existing special remote with this name.  -  - Prefer remotes that are not dead when a name appears multiple times. -}-findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig))+findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig, Maybe (ConfigFrom UUID))) findExisting name = do 	t <- trustMap 	headMaybe-		. sortBy (comparing $ \(u, _c) -> Down $ M.lookup u t)+		. sortBy (comparing $ \(u, _, _) -> Down $ M.lookup u t) 		. findByName name 		<$> Logs.Remote.readRemoteLog -newConfig :: RemoteName -> RemoteConfig-newConfig = M.singleton nameKey--findByName :: RemoteName ->  M.Map UUID RemoteConfig -> [(UUID, RemoteConfig)]-findByName n = filter (matching . snd) . M.toList+findByName :: RemoteName ->  M.Map UUID RemoteConfig -> [(UUID, RemoteConfig, Maybe (ConfigFrom UUID))]+findByName n = map sameasuuid . filter (matching . snd) . M.toList   where-	matching c = case M.lookup nameKey c of+	matching c = case lookupName c of 		Nothing -> False 		Just n' 			| n' == n -> True 			| otherwise -> False+	sameasuuid (u, c) = case M.lookup sameasUUIDField c of+		Nothing -> (u, c, Nothing)+		Just u' -> (toUUID u', c, Just (ConfigFrom u)) +newConfig+	:: RemoteName+	-> Maybe (Sameas UUID)+	-> RemoteConfig+	-- ^ configuration provided by the user+	-> M.Map UUID RemoteConfig+	-- ^ configuration of other special remotes, to inherit from+	-- when sameas is used+	-> RemoteConfig+newConfig name sameas fromuser m = case sameas of+	Nothing -> M.insert nameField name fromuser+	Just (Sameas u) -> addSameasInherited m $ M.fromList+		[ (sameasNameField, name)+		, (sameasUUIDField, fromUUID u)+		] `M.union` fromuser+ specialRemoteMap :: Annex (M.Map UUID RemoteName) specialRemoteMap = do 	m <- Logs.Remote.readRemoteLog 	return $ M.fromList $ mapMaybe go (M.toList m)   where-	go (u, c) = case M.lookup nameKey c of+	go (u, c) = case lookupName c of 		Nothing -> Nothing 		Just n -> Just (u, n) -{- find the specified remote type -}+{- find the remote type -} findType :: RemoteConfig -> Either String RemoteType-findType config = maybe unspecified specified $ M.lookup typeKey config+findType config = maybe unspecified specified $ M.lookup typeField config   where 	unspecified = Left "Specify the type of remote with type=" 	specified s = case filter (findtype s) remoteTypes of@@ -61,31 +84,31 @@ 		(t:_) -> Right t 	findtype s i = typename i == s -{- The name of a configured remote is stored in its config using this key. -}-nameKey :: RemoteConfigKey-nameKey = "name"--{- The type of a remote is stored in its config using this key. -}-typeKey :: RemoteConfigKey-typeKey = "type"--autoEnableKey :: RemoteConfigKey-autoEnableKey = "autoenable"- autoEnable :: Annex () autoEnable = do 	remotemap <- M.filter configured <$> readRemoteLog-	enabled <- remoteMap id-	forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do-		case (M.lookup nameKey c, findType c) of+	enabled <- getenabledremotes+	forM_ (M.toList remotemap) $ \(cu, c) -> unless (cu `M.member` enabled) $ do+		let u = case findSameasUUID c of+			Just (Sameas u') -> u'+			Nothing -> cu+		case (lookupName c, findType c) of 			(Just name, Right t) -> whenM (canenable u) $ do 				showSideAction $ "Auto enabling special remote " ++ name 				dummycfg <- liftIO dummyRemoteGitConfig 				tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case 					Left e -> warning (show e)-					Right _ -> return ()+					Right (_c, _u) ->+						when (cu /= u) $+							setConfig (remoteConfig c "config-uuid") (fromUUID cu) 			_ -> return ()   where 	configured rc = fromMaybe False $-		Git.Config.isTrue =<< M.lookup autoEnableKey rc+		Git.Config.isTrue =<< M.lookup autoEnableField rc 	canenable u = (/= DeadTrusted) <$> lookupTrust u+	getenabledremotes = M.fromList+		. map (\r -> (getcu r, r))+		<$> remoteList+	getcu r = fromMaybe+		(Remote.uuid r)+		(remoteAnnexConfigUUID (Remote.gitconfig r))

@@ -0,0 +1,103 @@+{- git-annex special remote configuration+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Annex.SpecialRemote.Config where++import Common+import Types.Remote (RemoteConfigField, RemoteConfig)+import Types.UUID++import qualified Data.Map as M+import qualified Data.Set as S++newtype Sameas t = Sameas t+	deriving (Show)++newtype ConfigFrom t = ConfigFrom t+	deriving (Show)++{- The name of a configured remote is stored in its config using this key. -}+nameField :: RemoteConfigField+nameField = "name"++{- The name of a sameas remote is stored using this key instead. + - This prevents old versions of git-annex getting confused. -}+sameasNameField :: RemoteConfigField+sameasNameField = "sameas-name"++lookupName :: RemoteConfig -> Maybe String+lookupName c = M.lookup nameField c <|> M.lookup sameasNameField c++{- The uuid that a sameas remote is the same as is stored in this key. -}+sameasUUIDField :: RemoteConfigField+sameasUUIDField = "sameas-uuid"++{- The type of a remote is stored in its config using this key. -}+typeField :: RemoteConfigField+typeField = "type"++autoEnableField :: RemoteConfigField+autoEnableField = "autoenable"++encryptionField :: RemoteConfigField+encryptionField = "encryption"++macField :: RemoteConfigField+macField = "mac"++cipherField :: RemoteConfigField+cipherField = "cipher"++cipherkeysField :: RemoteConfigField+cipherkeysField = "cipherkeys"++pubkeysField :: RemoteConfigField+pubkeysField = "pubkeys"++chunksizeField :: RemoteConfigField+chunksizeField = "chunksize"++{- A remote with sameas-uuid set will inherit these values from the config+ - of that uuid. These values cannot be overridden in the remote's config. -}+sameasInherits :: S.Set RemoteConfigField+sameasInherits = S.fromList+	-- encryption configuration is necessarily the same for two+	-- remotes that access the same data store+	[ encryptionField+	, macField+	, cipherField+	, cipherkeysField+	, pubkeysField+	-- legacy chunking was either enabled or not, so has to be the same+	-- across configs for remotes that access the same data+	-- (new-style chunking does not have that limitation)+	, chunksizeField+	]++{- Each RemoteConfig that has a sameas-uuid inherits some fields+ - from it. Such fields can only be set by inheritance; the RemoteConfig+ - cannot provide values from them. -}+addSameasInherited :: M.Map UUID RemoteConfig -> RemoteConfig -> RemoteConfig+addSameasInherited m c = case findSameasUUID c of+	Nothing -> c+	Just (Sameas sameasuuid) -> case M.lookup sameasuuid m of+		Nothing -> c+		Just parentc -> +			M.withoutKeys c sameasInherits			+				`M.union`+			M.restrictKeys parentc sameasInherits++findSameasUUID :: RemoteConfig -> Maybe (Sameas UUID)+findSameasUUID c = Sameas . toUUID <$> M.lookup sameasUUIDField c++{- Remove any fields inherited from a sameas-uuid. When storing a+ - RemoteConfig, those fields don't get stored, since they were already+ - inherited. -}+removeSameasInherited :: RemoteConfig -> RemoteConfig+removeSameasInherited c = case M.lookup sameasUUIDField c of+	Nothing -> c+	Just _ -> M.withoutKeys c sameasInherits

@@ -9,7 +9,8 @@  import Utility.Gpg import Utility.UserInfo-import Types.Remote (RemoteConfigKey)+import Types.Remote (RemoteConfigField)+import Annex.SpecialRemote.Config  import qualified Data.Map as M import Control.Applicative@@ -30,7 +31,7 @@ 	deriving (Eq)  {- Generates Remote configuration for encryption. -}-configureEncryption :: EnableEncryption -> (RemoteConfigKey, String)-configureEncryption SharedEncryption = ("encryption", "shared")-configureEncryption NoEncryption = ("encryption", "none")-configureEncryption HybridEncryption = ("encryption", "hybrid")+configureEncryption :: EnableEncryption -> (RemoteConfigField, String)+configureEncryption SharedEncryption = (encryptionField, "shared")+configureEncryption NoEncryption = (encryptionField, "none")+configureEncryption HybridEncryption = (encryptionField, "hybrid")

@@ -18,6 +18,7 @@ import qualified Git.Command import qualified Annex import qualified Annex.SpecialRemote+import Annex.SpecialRemote.Config import Logs.UUID import Logs.Remote import Git.Remote@@ -26,6 +27,7 @@ import Assistant.Gpg import Utility.Gpg (KeyId) import Types.GitConfig+import Config  import qualified Data.Map as M @@ -51,11 +53,11 @@ 	go =<< Annex.SpecialRemote.findExisting name   where 	go Nothing = setupSpecialRemote name Rsync.remote config Nothing-		(Nothing, R.Init, Annex.SpecialRemote.newConfig name)-	go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing-		(Just u, R.Enable c, c)+		(Nothing, R.Init, Annex.SpecialRemote.newConfig name Nothing mempty mempty) Nothing+	go (Just (u, c, mcu)) = setupSpecialRemote name Rsync.remote config Nothing+		(Just u, R.Enable c, c) mcu 	config = M.fromList-		[ ("encryption", "shared")+		[ (encryptionField, "shared") 		, ("rsyncurl", location) 		, ("type", "rsync") 		]@@ -82,7 +84,7 @@ 		let fullname = if n == 0  then name else name ++ show n 		Annex.SpecialRemote.findExisting fullname >>= \case 			Nothing -> setupSpecialRemote fullname remotetype config mcreds-				(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname)+				(Nothing, R.Init, Annex.SpecialRemote.newConfig fullname Nothing mempty mempty) Nothing 			Just _ -> go (n + 1)  {- Enables an existing special remote. -}@@ -90,13 +92,13 @@ enableSpecialRemote name remotetype mcreds config = 	Annex.SpecialRemote.findExisting name >>= \case 		Nothing -> error $ "Cannot find a special remote named " ++ name-		Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c)+		Just (u, c, mcu) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c) mcu -setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName+setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> Annex RemoteName setupSpecialRemote = setupSpecialRemote' True -setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName-setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) = do+setupSpecialRemote' :: Bool -> RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> Annex RemoteName+setupSpecialRemote' setdesc name remotetype config mcreds (mu, ss, c) mcu = 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@@ -104,7 +106,12 @@ 	let weakc = M.insert "highRandomQuality" "false" $ M.union config c 	dummycfg <- liftIO dummyRemoteGitConfig 	(c', u) <- R.setup remotetype ss mu mcreds weakc dummycfg-	configSet u c'+	case mcu of+		Nothing ->+			configSet u c'+		Just (Annex.SpecialRemote.ConfigFrom cu) -> do+			setConfig (remoteConfig c' "config-uuid") (fromUUID cu)+			configSet cu c' 	when setdesc $ 		whenM (isNothing . M.lookup u <$> uuidDescMap) $ 			describeUUID u (toUUIDDesc name)

@@ -24,6 +24,7 @@ import Creds import Assistant.Gpg import Git.Types (RemoteName)+import Annex.SpecialRemote.Config  import qualified Data.Text as T import qualified Data.Map as M@@ -195,7 +196,7 @@ 	case result of 		FormSuccess creds -> liftH $ do 			m <- liftAnnex readRemoteLog-			let name = fromJust $ M.lookup "name" $+			let name = fromJust $ lookupName $ 				fromJust $ M.lookup uuid m 			makeAWSRemote enableSpecialRemote remotetype SmallArchiveGroup creds name M.empty 		_ -> do

@@ -24,6 +24,7 @@ import Types.Remote (RemoteConfig) import qualified Annex.Url as Url import Creds+import Annex.SpecialRemote.Config  import qualified Data.Text as T import qualified Data.Map as M@@ -169,7 +170,7 @@ 	case result of 		FormSuccess creds -> liftH $ do 			m <- liftAnnex readRemoteLog-			let name = fromJust $ M.lookup "name" $+			let name = fromJust $ lookupName $ 				fromJust $ M.lookup uuid m 			AWS.makeAWSRemote enableSpecialRemote S3.remote PublicGroup creds name M.empty 		_ -> do

@@ -27,6 +27,7 @@ import qualified Annex.Branch import Annex.UUID import Logs.UUID+import Annex.SpecialRemote.Config import Assistant.RemoteControl import Types.Creds import Assistant.CredPairCache@@ -208,7 +209,7 @@ enableSshRemote :: (RemoteConfig -> Maybe SshData) -> (SshInput -> RemoteName -> Handler Html) -> (SshData -> UUID -> Handler Html) -> UUID -> Handler Html enableSshRemote getsshdata rsyncnetsetup genericsetup u = do 	m <- fromMaybe M.empty . M.lookup u <$> liftAnnex readRemoteLog-	case (unmangle <$> getsshdata m, M.lookup "name" m) of+	case (unmangle <$> getsshdata m, lookupName m) of 		(Just sshdata, Just reponame) -> sshConfigurator $ do 			((result, form), enctype) <- liftH $ 				runFormPostNoToken $ renderBootstrap3 bootstrapFormLayout $@@ -546,7 +547,9 @@ 		let c = fromMaybe M.empty (M.lookup (Remote.uuid r) m) 		let c' = M.insert "location" (genSshUrl sshdata) $ 			M.insert "type" "git" $-			M.insert "name" (fromMaybe (Remote.name r) (M.lookup "name" c)) c+			case M.lookup nameField c of+				Just _ -> c+				Nothing -> M.insert nameField (Remote.name r) c 		configSet (Remote.uuid r) c'  makeSshRepoConnection :: RepoStatus -> Annex RemoteName -> (Remote -> Annex ()) -> Handler Html

@@ -21,6 +21,7 @@ import Git.Types (RemoteName) import Assistant.Gpg import Types.GitConfig+import Annex.SpecialRemote.Config  import qualified Data.Map as M #endif@@ -56,7 +57,7 @@ postEnableWebDAVR uuid = do 	m <- liftAnnex readRemoteLog 	let c = fromJust $ M.lookup uuid m-	let name = fromJust $ M.lookup "name" c+	let name = fromJust $ lookupName c 	let url = fromJust $ M.lookup "url" c 	mcreds <- liftAnnex $ do 		dummycfg <- liftIO dummyRemoteGitConfig

@@ -21,6 +21,7 @@ import qualified Remote.GCrypt as GCrypt import Git.Types (RemoteName) import Assistant.WebApp.MakeRemote+import Annex.SpecialRemote.Config import Logs.Remote  import qualified Data.Map as M@@ -79,7 +80,7 @@ 	mname <- ifM (inRepo $ Git.Command.runBool [Param "fetch", Param tmpremote]) 		( do 			void Annex.Branch.forceUpdate-			(M.lookup "name" <=< M.lookup u) <$> readRemoteLog+			(lookupName <=< M.lookup u) <$> readRemoteLog 		, return Nothing 		) 	void $ inRepo $ Git.Remote.Remove.remove tmpremote

@@ -1,3 +1,20 @@+git-annex (7.20191017) upstream; urgency=medium++  * initremote: Added --sameas option, allows for two special remotes that+    access the same data store.+  * Note that due to complications of the sameas feature, any external+    special remotes that try to send SETSTATE or GETSTATE during INITREMOTE+    or EXPORTSUPPORTED will now get back an ERROR. That would be a very+    hackish thing for an external special remote to do, needing some kind+    of hard-coded key value to be used, so probably nothing will be affected.+  * forget --drop-dead: Remove several classes of git-annex log files+    when they become empty, further reducing the size of the git-annex branch.+  * OSX: Deal with symbolic link problem that caused git to not be included in+    the git-annex.dmg.+  * Fix build with persistent-2.10.++ -- Joey Hess <id@joeyh.name>  Thu, 17 Oct 2019 18:19:12 -0400+ git-annex (7.20191009) upstream; urgency=medium    * Fix bug in handling of annex.largefiles that use largerthan/smallerthan.

@@ -1,6 +1,6 @@ {- git-annex command-line option parsing  -- - Copyright 2010-2018 Joey Hess <id@joeyh.name>+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -113,6 +113,10 @@ parseRemoteOption = DeferredParse  	. (fromJust <$$> Remote.byNameWithUUID) 	. Just++parseUUIDOption :: String -> DeferredParse UUID+parseUUIDOption = DeferredParse+	. (Remote.nameToUUID)  -- | From or To a remote. data FromToOptions

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2013-2016 Joey Hess <id@joeyh.name>+ - Copyright 2013-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -13,7 +13,7 @@ import qualified Types.Remote as R import qualified Git import qualified Git.Types as Git-import qualified Annex.SpecialRemote+import qualified Annex.SpecialRemote as SpecialRemote import qualified Remote import qualified Types.Remote as Remote import qualified Remote.Git@@ -40,7 +40,7 @@   where 	matchingname r = Git.remoteName r == Just name 	go [] = startSpecialRemote name (Logs.Remote.keyValToConfig rest)-		=<< Annex.SpecialRemote.findExisting name+		=<< SpecialRemote.findExisting name 	go (r:_) = do 		-- This could be either a normal git remote or a special 		-- remote that has an url (eg gcrypt).@@ -62,32 +62,37 @@ 	| otherwise = giveup $ 		"That is a normal git remote; passing these parameters does not make sense: " ++ unwords restparams -startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig) -> CommandStart+startSpecialRemote :: Git.RemoteName -> Remote.RemoteConfig -> Maybe (UUID, Remote.RemoteConfig, Maybe (SpecialRemote.ConfigFrom UUID)) -> CommandStart startSpecialRemote name config Nothing = do-	m <- Annex.SpecialRemote.specialRemoteMap+	m <- SpecialRemote.specialRemoteMap 	confm <- Logs.Remote.readRemoteLog 	Remote.nameToUUID' name >>= \case 		Right u | u `M.member` m -> 			startSpecialRemote name config $-				Just (u, fromMaybe M.empty (M.lookup u confm))+				Just (u, fromMaybe M.empty (M.lookup u confm), Nothing) 		_ -> unknownNameError "Unknown remote name."-startSpecialRemote name config (Just (u, c)) =+startSpecialRemote name config (Just (u, c, mcu)) = 	starting "enableremote" (ActionItemOther (Just name)) $ do 		let fullconfig = config `M.union` c	-		t <- either giveup return (Annex.SpecialRemote.findType fullconfig)+		t <- either giveup return (SpecialRemote.findType fullconfig) 		gc <- maybe (liftIO dummyRemoteGitConfig)  			(return . Remote.gitconfig) 			=<< Remote.byUUID u-		performSpecialRemote t u c fullconfig gc+		performSpecialRemote t u c fullconfig gc mcu -performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform-performSpecialRemote t u oldc c gc = do+performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandPerform+performSpecialRemote t u oldc c gc mcu = do 	(c', u') <- R.setup t (R.Enable oldc) (Just u) Nothing c gc-	next $ cleanupSpecialRemote u' c'+	next $ cleanupSpecialRemote u' c' mcu -cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup-cleanupSpecialRemote u c = do-	Logs.Remote.configSet u c+cleanupSpecialRemote :: UUID -> R.RemoteConfig -> Maybe (SpecialRemote.ConfigFrom UUID) -> CommandCleanup+cleanupSpecialRemote u c mcu = do+	case mcu of+		Nothing -> +			Logs.Remote.configSet u c+		Just (SpecialRemote.ConfigFrom cu) -> do+			setConfig (remoteConfig c "config-uuid") (fromUUID cu)+			Logs.Remote.configSet cu c 	Remote.byUUID u >>= \case 		Nothing -> noop 		Just r -> do@@ -97,7 +102,7 @@  unknownNameError :: String -> Annex a unknownNameError prefix = do-	m <- Annex.SpecialRemote.specialRemoteMap+	m <- SpecialRemote.specialRemoteMap 	descm <- M.unionWith Remote.addName 		<$> uuidDescMap 		<*> pure (M.map toUUIDDesc m)

@@ -1,6 +1,6 @@ {- git-annex command  -- - Copyright 2011,2013 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -14,50 +14,82 @@ import qualified Remote import qualified Logs.Remote import qualified Types.Remote as R+import Annex.UUID import Logs.UUID+import Logs.Remote import Types.GitConfig+import Config  cmd :: Command cmd = command "initremote" SectionSetup 	"creates a special (non-git) remote" 	(paramPair paramName $ paramOptional $ paramRepeating paramKeyValue)-	(withParams seek)+	(seek <$$> optParser) -seek :: CmdParams -> CommandSeek-seek = withWords (commandAction . start)+data InitRemoteOptions = InitRemoteOptions+	{ cmdparams :: CmdParams+	, sameas :: Maybe (DeferredParse UUID)+	} -start :: [String] -> CommandStart-start [] = giveup "Specify a name for the remote."-start (name:ws) = ifM (isJust <$> findExisting name)+optParser :: CmdParamsDesc -> Parser InitRemoteOptions+optParser desc = InitRemoteOptions+	<$> cmdParams desc+	<*> optional parseSameasOption++parseSameasOption :: Parser (DeferredParse UUID)+parseSameasOption = parseUUIDOption <$> strOption+	( long "sameas"+	<> metavar (paramRemote `paramOr` paramDesc `paramOr` paramUUID)+	<> help "new remote that accesses the same data"+	<> completeRemotes+	)++seek :: InitRemoteOptions -> CommandSeek+seek o = withWords (commandAction . (start o)) (cmdparams o)++start :: InitRemoteOptions -> [String] -> CommandStart+start _ [] = giveup "Specify a name for the remote."+start o (name:ws) = ifM (isJust <$> findExisting name) 	( giveup $ "There is already a special remote named \"" ++ name ++ 		"\". (Use enableremote to enable an existing special remote.)" 	, do 		ifM (isJust <$> Remote.byNameOnly name) 			( giveup $ "There is already a remote named \"" ++ name ++ "\"" 			, do-				let c = newConfig name-				t <- either giveup return (findType config)+				sameasuuid <- maybe+					(pure Nothing)+					(Just . Sameas <$$> getParsed)+					(sameas o) +				c <- newConfig name sameasuuid+					(Logs.Remote.keyValToConfig ws)+					<$> readRemoteLog+				t <- either giveup return (findType c) 				starting "initremote" (ActionItemOther (Just name)) $-					perform t name $ M.union config c+					perform t name c o 			) 	)-  where-	config = Logs.Remote.keyValToConfig ws -perform :: RemoteType -> String -> R.RemoteConfig -> CommandPerform-perform t name c = do+perform :: RemoteType -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandPerform+perform t name c o = do 	dummycfg <- liftIO dummyRemoteGitConfig-	(c', u) <- R.setup t R.Init cu Nothing c dummycfg-	next $ cleanup u name c'+	(c', u) <- R.setup t R.Init (sameasu <|> uuidfromuser) Nothing c dummycfg+	next $ cleanup u name c' o   where-	cu = case M.lookup "uuid" c of+	uuidfromuser = case M.lookup "uuid" c of 		Just s 			| isUUID s -> Just (toUUID s) 			| otherwise -> giveup "invalid uuid" 		Nothing -> Nothing+	sameasu = toUUID <$> M.lookup sameasUUIDField c -cleanup :: UUID -> String -> R.RemoteConfig -> CommandCleanup-cleanup u name c = do-	describeUUID u (toUUIDDesc name)-	Logs.Remote.configSet u c+cleanup :: UUID -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandCleanup+cleanup u name c o = do+	case sameas o of+		Nothing -> do+			describeUUID u (toUUIDDesc name)+			Logs.Remote.configSet u c+		Just _ -> do+			cu <- liftIO genUUID+			setConfig (remoteConfig c "config-uuid") (fromUUID cu)+			Logs.Remote.configSet cu c 	return True

@@ -9,6 +9,7 @@  import Command import qualified Annex.SpecialRemote+import Annex.SpecialRemote.Config (nameField, sameasNameField) import qualified Logs.Remote import qualified Types.Remote as R import qualified Remote@@ -26,9 +27,9 @@  start :: [String] -> CommandStart start (oldname:newname:[]) = Annex.SpecialRemote.findExisting oldname >>= \case-	Just (u, cfg) -> Annex.SpecialRemote.findExisting newname >>= \case+	Just (u, cfg, mcu) -> Annex.SpecialRemote.findExisting newname >>= \case 		Just _ -> giveup $ "The name " ++ newname ++ " is already used by a special remote."-		Nothing -> go u cfg+		Nothing -> go u cfg mcu 	-- Support lookup by uuid or description as well as remote name, 	-- as a fallback when there is nothing with the name in the 	-- special remote log.@@ -38,13 +39,17 @@ 			m <- Logs.Remote.readRemoteLog 			case M.lookup u m of 				Nothing -> giveup "That is not a special remote."-				Just cfg -> go u cfg+				Just cfg -> go u cfg Nothing   where-	go u cfg = starting "rename" (ActionItemOther Nothing) $-		perform u cfg newname+	go u cfg mcu = starting "rename" (ActionItemOther Nothing) $+		perform u cfg mcu newname start _ = giveup "Specify an old name (or uuid or description) and a new name." -perform :: UUID -> R.RemoteConfig -> String -> CommandPerform-perform u cfg newname = do-	Logs.Remote.configSet u (M.insert "name" newname cfg)+perform :: UUID -> R.RemoteConfig -> Maybe (Annex.SpecialRemote.ConfigFrom UUID) -> String -> CommandPerform+perform u cfg mcu newname = do+	let (namefield, cu) = case mcu of+		Nothing -> (nameField, u)+		Just (Annex.SpecialRemote.ConfigFrom u') -> (sameasNameField, u')+	Logs.Remote.configSet cu (M.insert namefield newname cfg)+	 	next $ return True

@@ -153,6 +153,7 @@ 		(Remote.uuid r) 		(adjustconfig (Remote.config r)) 		(Remote.gitconfig r)+		(Remote.remoteStateHandle r)  test :: Annex.AnnexState -> Remote -> Key -> [TestTree] test st r k = catMaybes

@@ -19,6 +19,7 @@ import Types.Availability import Git.Types import qualified Types.Remote as Remote+import qualified Annex.SpecialRemote.Config as SpecialRemote  import qualified Data.Map as M @@ -62,7 +63,7 @@ 	getRemoteName = Remote.name  instance RemoteNameable Remote.RemoteConfig where-	getRemoteName c = fromMaybe "" (M.lookup "name" c)+	getRemoteName c = fromMaybe "" (SpecialRemote.lookupName c)  {- A per-remote config setting in git config. -} remoteConfig :: RemoteNameable r => r -> UnqualifiedConfigKey -> ConfigKey

@@ -26,7 +26,7 @@ import Annex.Perms import Utility.FileMode import Crypto-import Types.Remote (RemoteConfig, RemoteConfigKey)+import Types.Remote (RemoteConfig, RemoteConfigField) import Remote.Helper.Encryptable (remoteCipher, remoteCipher', embedCreds, EncryptionIsSetup, extractCipher) import Utility.Env (getEnv) @@ -39,7 +39,7 @@ data CredPairStorage = CredPairStorage 	{ credPairFile :: FilePath 	, credPairEnvironment :: (String, String)-	, credPairRemoteKey :: RemoteConfigKey+	, credPairRemoteField :: RemoteConfigField 	}  {- Stores creds in a remote's configuration, if the remote allows@@ -58,7 +58,7 @@ 		=<< getRemoteCredPair c gc storage 	Just creds 		| embedCreds c ->-			let key = credPairRemoteKey storage+			let key = credPairRemoteField storage 			in storeconfig creds key =<< flip remoteCipher gc =<< localcache creds 		| otherwise -> localcache creds   where@@ -84,7 +84,7 @@ 	fromenv = liftIO $ getEnvCredPair storage 	fromcache = maybe fromconfig (return . Just) =<< readCacheCredPair storage 	fromconfig = do-		let key = credPairRemoteKey storage+		let key = credPairRemoteField storage 		mcipher <- remoteCipher' c gc 		case (M.lookup key c, mcipher) of 			(Nothing, _) -> return Nothing@@ -190,7 +190,7 @@ 		Just _ -> do 			let (uenv, penv) = credPairEnvironment storage 			ret $ "from environment variables (" ++ unwords [uenv, penv] ++ ")"-		Nothing -> case (`M.lookup` c) (credPairRemoteKey storage) of+		Nothing -> case (`M.lookup` c) (credPairRemoteField storage) of 			Nothing -> ifM (existsCacheCredPair storage) 				( ret "stored locally" 				, ret "not available"

@@ -45,6 +45,7 @@ import Types.Crypto import Types.Remote import Types.Key+import Annex.SpecialRemote.Config  {- The beginning of a Cipher is used for MAC'ing; the remainder is used  - as the GPG symmetric encryption passphrase when using the hybrid@@ -236,9 +237,9 @@ 	getGpgEncParams (c,gc) = getGpgEncParamsBase (c,gc) ++  		{- When the remote is configured to use public-key encryption, 		 - look up the recipient keys and add them to the option list. -}-		case M.lookup "encryption" c of-			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "cipherkeys" c-			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup "pubkeys" c+		case M.lookup encryptionField c of+			Just "pubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup cipherkeysField c+			Just "sharedpubkey" -> Gpg.pkEncTo $ maybe [] (splitc ',') $ M.lookup pubkeysField c 			_ -> [] 	getGpgDecParams (_c,gc) = map Param (remoteAnnexGnupgDecryptOptions gc) 

@@ -34,6 +34,7 @@ import Annex.Common hiding (delete) import qualified Annex.Branch import Types.Import+import Types.RemoteState import Git.Types import Git.Sha import Git.FilePath@@ -89,20 +90,21 @@ flushDbQueue (ContentIdentifierHandle h) = H.flushDbQueue h  -- Be sure to also update the git-annex branch when using this.-recordContentIdentifier :: ContentIdentifierHandle -> UUID -> ContentIdentifier -> Key -> IO ()-recordContentIdentifier h u cid k = queueDb h $ do+recordContentIdentifier :: ContentIdentifierHandle -> RemoteStateHandle -> ContentIdentifier -> Key -> IO ()+recordContentIdentifier h (RemoteStateHandle u) cid k = queueDb h $ do 	void $ insert_ $ ContentIdentifiers u cid (toIKey k) -getContentIdentifiers :: ContentIdentifierHandle -> UUID -> Key -> IO [ContentIdentifier]-getContentIdentifiers (ContentIdentifierHandle h) u k = H.queryDbQueue h $ do-	l <- selectList-		[ ContentIdentifiersKey ==. toIKey k-		, ContentIdentifiersRemote ==. u-		] []-	return $ map (contentIdentifiersCid . entityVal) l+getContentIdentifiers :: ContentIdentifierHandle -> RemoteStateHandle -> Key -> IO [ContentIdentifier]+getContentIdentifiers (ContentIdentifierHandle h) (RemoteStateHandle u) k = +	H.queryDbQueue h $ do+		l <- selectList+			[ ContentIdentifiersKey ==. toIKey k+			, ContentIdentifiersRemote ==. u+			] []+		return $ map (contentIdentifiersCid . entityVal) l -getContentIdentifierKeys :: ContentIdentifierHandle -> UUID -> ContentIdentifier -> IO [Key]-getContentIdentifierKeys (ContentIdentifierHandle h) u cid = +getContentIdentifierKeys :: ContentIdentifierHandle -> RemoteStateHandle -> ContentIdentifier -> IO [Key]+getContentIdentifierKeys (ContentIdentifierHandle h) (RemoteStateHandle u) cid =  	H.queryDbQueue h $ do 		l <- selectList 			[ ContentIdentifiersCid ==. cid@@ -147,6 +149,6 @@ 		Nothing -> return () 		Just k -> do 			l <- Log.getContentIdentifiers k-			liftIO $ forM_ l $ \(u, cids) ->+			liftIO $ forM_ l $ \(rs, cids) -> 				forM_ cids $ \cid ->-					recordContentIdentifier db u cid k+					recordContentIdentifier db rs cid k

@@ -244,10 +244,15 @@  -- Like withSqlConn, but more robust. withSqlConnRobustly-	 :: (MonadUnliftIO m, MonadLogger m, IsPersistBackend backend, BaseBackend backend ~ SqlBackend)-	 => (LogFunc -> IO backend)-	 -> (backend -> m a)-	 -> m a+	:: (MonadUnliftIO m+		, MonadLogger m+		, IsPersistBackend backend+		, BaseBackend backend ~ SqlBackend+		, BackendCompatible SqlBackend backend+	    )+	=> (LogFunc -> IO backend)+	-> (backend -> m a)+	-> m a withSqlConnRobustly open f = do 	logFunc <- askLogFunc 	withRunInIO $ \run -> bracket@@ -258,8 +263,11 @@ -- Sqlite can throw ErrorBusy while closing a database; this catches -- the exception and retries. closeRobustly-	 :: (IsPersistBackend backend, BaseBackend backend ~ SqlBackend)-	 => backend+	:: (IsPersistBackend backend+		, BaseBackend backend ~ SqlBackend+		, BackendCompatible SqlBackend backend+	   )+	=> backend 	-> IO () closeRobustly conn = go maxretries briefdelay   where

@@ -15,6 +15,7 @@ import Logs import Logs.MapLog import Types.Import+import Types.RemoteState import qualified Annex.Branch import Logs.ContentIdentifier.Pure as X import qualified Annex@@ -27,8 +28,8 @@ -- -- A remote may use multiple content identifiers for the same key over time, -- so ones that were recorded before are preserved.-recordContentIdentifier :: UUID -> ContentIdentifier -> Key -> Annex ()-recordContentIdentifier u cid k = do+recordContentIdentifier :: RemoteStateHandle -> ContentIdentifier -> Key -> Annex ()+recordContentIdentifier (RemoteStateHandle u) cid k = do 	c <- liftIO currentVectorClock 	config <- Annex.getGitConfig 	Annex.Branch.change (remoteContentIdentifierLogFile config k) $@@ -39,9 +40,9 @@ 		m = simpleMap l  -- | Get all known content identifiers for a key.-getContentIdentifiers :: Key -> Annex [(UUID, [ContentIdentifier])]+getContentIdentifiers :: Key -> Annex [(RemoteStateHandle, [ContentIdentifier])] getContentIdentifiers k = do 	config <- Annex.getGitConfig-	map (\(u, l) -> (u, NonEmpty.toList l) )+	map (\(u, l) -> (RemoteStateHandle u, NonEmpty.toList l) ) 		. M.toList . simpleMap . parseLog 		<$> Annex.Branch.get (remoteContentIdentifierLogFile config k)

@@ -19,6 +19,7 @@  - after the other remote redundantly set foo +x, it was unset,  - and so foo currently has no value.  -+ - Copyright 2014-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -}@@ -35,6 +36,7 @@  import Annex.Common import Types.MetaData+import Types.RemoteState import Annex.MetaData.StandardFields import Annex.VectorClock import qualified Annex.Branch@@ -84,8 +86,8 @@ 			Unknown -> 0 	showts = formatPOSIXTime "%F@%H-%M-%S" -getCurrentRemoteMetaData :: UUID -> Key -> Annex RemoteMetaData-getCurrentRemoteMetaData u k = extractRemoteMetaData u <$>+getCurrentRemoteMetaData :: RemoteStateHandle -> Key -> Annex RemoteMetaData+getCurrentRemoteMetaData (RemoteStateHandle u) k = extractRemoteMetaData u <$> 	getCurrentMetaData' remoteMetaDataLogFile k  {- Adds in some metadata, which can override existing values, or unset@@ -116,9 +118,10 @@   where 	metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m -addRemoteMetaData :: Key -> RemoteMetaData -> Annex ()-addRemoteMetaData k m = do-	addMetaData' remoteMetaDataLogFile k (fromRemoteMetaData m)+addRemoteMetaData :: Key -> RemoteStateHandle -> MetaData -> Annex ()+addRemoteMetaData k (RemoteStateHandle u) m = +	addMetaData' remoteMetaDataLogFile k $ fromRemoteMetaData $+		RemoteMetaData u m  getMetaDataLog :: Key -> Annex (Log MetaData) getMetaDataLog key = do

@@ -1,6 +1,6 @@ {- git-annex remote log  - - - Copyright 2011 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -   - Licensed under the GNU AGPL version 3 or higher.  -}@@ -22,86 +22,21 @@ import Types.Remote import Logs import Logs.UUIDBased+import Logs.Remote.Pure+import Annex.SpecialRemote.Config  import qualified Data.Map as M-import Data.Char-import qualified Data.Attoparsec.ByteString.Lazy as A-import Data.ByteString.Builder  {- Adds or updates a remote's config in the log. -} configSet :: UUID -> RemoteConfig -> Annex () configSet u cfg = do 	c <- liftIO currentVectorClock 	Annex.Branch.change remoteLog $-		buildLogOld (byteString . encodeBS . showConfig)-			. changeLog c u cfg-			. parseLogOld remoteConfigParser+		buildRemoteConfigLog+			. changeLog c u (removeSameasInherited cfg)+			. parseRemoteConfigLog  {- Map of remotes by uuid containing key/value config maps. -} readRemoteLog :: Annex (M.Map UUID RemoteConfig)-readRemoteLog = simpleMap . parseLogOld remoteConfigParser+readRemoteLog = calcRemoteConfigMap  	<$> Annex.Branch.get remoteLog--remoteConfigParser :: A.Parser RemoteConfig-remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString--showConfig :: RemoteConfig -> String-showConfig = unwords . configToKeyVal--{- Given Strings like "key=value", generates a RemoteConfig. -}-keyValToConfig :: [String] -> RemoteConfig-keyValToConfig ws = M.fromList $ map (/=/) ws-  where-	(/=/) s = (k, v)-	  where-		k = takeWhile (/= '=') s-		v = configUnEscape $ drop (1 + length k) s--configToKeyVal :: M.Map String String -> [String]-configToKeyVal m = map toword $ sort $ M.toList m-  where-	toword (k, v) = k ++ "=" ++ configEscape v--configEscape :: String -> String-configEscape = concatMap escape-  where-	escape c-		| isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";"-		| otherwise = [c]--configUnEscape :: String -> String-configUnEscape = unescape-  where-	unescape [] = []-	unescape (c:rest)-		| c == '&' = entity rest-		| otherwise = c : unescape rest-	entity s-		| not (null num) && ";" `isPrefixOf` r =-			chr (Prelude.read num) : unescape rest-		| otherwise =-			'&' : unescape s-	  where-		num = takeWhile isNumber s-		r = drop (length num) s-		rest = drop 1 r--{- for quickcheck -}-prop_isomorphic_configEscape :: String -> Bool-prop_isomorphic_configEscape s = s == (configUnEscape . configEscape) s--prop_parse_show_Config :: RemoteConfig -> Bool-prop_parse_show_Config c-	-- whitespace and '=' are not supported in config keys-	| any (\k -> any isSpace k || elem '=' k) (M.keys c) = True-	| any (any excluded) (M.keys c) = True-	| any (any excluded) (M.elems c) = True-	| otherwise = A.parseOnly remoteConfigParser (encodeBS $ showConfig c) ~~ Right c-  where-	normalize v = sort . M.toList <$> v-	a ~~ b = normalize a == normalize b-	-- limit to ascii alphanumerics for simplicity; characters not-	-- allowed by the current character set in the config may not-	-- round-trip in an identical representation due to the use of the-	-- filesystem encoding.-	excluded ch = not (isAlphaNum ch) || not (isAscii ch)

@@ -0,0 +1,104 @@+{- git-annex remote log, pure operations+ - + - Copyright 2011-2019 Joey Hess <id@joeyh.name>+ - + - Licensed under the GNU AGPL version 3 or higher.+ -}++module Logs.Remote.Pure (+	calcRemoteConfigMap,+	parseRemoteConfigLog,+	buildRemoteConfigLog,+        keyValToConfig,+        configToKeyVal,+        showConfig,++        prop_isomorphic_configEscape,+        prop_parse_show_Config,+) where++import Annex.Common+import Types.Remote+import Logs.UUIDBased+import Annex.SpecialRemote.Config++import qualified Data.ByteString.Lazy as L+import qualified Data.Map as M+import Data.Char+import qualified Data.Attoparsec.ByteString.Lazy as A+import Data.ByteString.Builder++calcRemoteConfigMap :: L.ByteString -> M.Map UUID RemoteConfig+calcRemoteConfigMap = (\m -> M.map (addSameasInherited m) m)+	. simpleMap+	. parseRemoteConfigLog++parseRemoteConfigLog :: L.ByteString -> Log RemoteConfig+parseRemoteConfigLog = parseLogOld remoteConfigParser++buildRemoteConfigLog :: Log RemoteConfig -> Builder+buildRemoteConfigLog = buildLogOld (byteString . encodeBS . showConfig)++remoteConfigParser :: A.Parser RemoteConfig+remoteConfigParser = keyValToConfig . words . decodeBS <$> A.takeByteString++showConfig :: RemoteConfig -> String+showConfig = unwords . configToKeyVal++{- Given Strings like "key=value", generates a RemoteConfig. -}+keyValToConfig :: [String] -> RemoteConfig+keyValToConfig ws = M.fromList $ map (/=/) ws+  where+	(/=/) s = (k, v)+	  where+		k = takeWhile (/= '=') s+		v = configUnEscape $ drop (1 + length k) s++configToKeyVal :: M.Map String String -> [String]+configToKeyVal m = map toword $ sort $ M.toList m+  where+	toword (k, v) = k ++ "=" ++ configEscape v++configEscape :: String -> String+configEscape = concatMap escape+  where+	escape c+		| isSpace c || c `elem` "&" = "&" ++ show (ord c) ++ ";"+		| otherwise = [c]++configUnEscape :: String -> String+configUnEscape = unescape+  where+	unescape [] = []+	unescape (c:rest)+		| c == '&' = entity rest+		| otherwise = c : unescape rest+	entity s+		| not (null num) && ";" `isPrefixOf` r =+			chr (Prelude.read num) : unescape rest+		| otherwise =+			'&' : unescape s+	  where+		num = takeWhile isNumber s+		r = drop (length num) s+		rest = drop 1 r++{- for quickcheck -}+prop_isomorphic_configEscape :: String -> Bool+prop_isomorphic_configEscape s = s == (configUnEscape . configEscape) s++prop_parse_show_Config :: RemoteConfig -> Bool+prop_parse_show_Config c+	-- whitespace and '=' are not supported in config keys+	| any (\k -> any isSpace k || elem '=' k) (M.keys c) = True+	| any (any excluded) (M.keys c) = True+	| any (any excluded) (M.elems c) = True+	| otherwise = A.parseOnly remoteConfigParser (encodeBS $ showConfig c) ~~ Right c+  where+	normalize v = sort . M.toList <$> v+	a ~~ b = normalize a == normalize b+	-- limit to ascii alphanumerics for simplicity; characters not+	-- allowed by the current character set in the config may not+	-- round-trip in an identical representation due to the use of the+	-- filesystem encoding.+	excluded ch = not (isAlphaNum ch) || not (isAscii ch)

@@ -11,6 +11,7 @@ ) where  import Annex.Common+import Types.RemoteState import Logs import Logs.UUIDBased import qualified Annex.Branch@@ -23,8 +24,8 @@  type RemoteState = String -setRemoteState :: UUID -> Key -> RemoteState -> Annex ()-setRemoteState u k s = do+setRemoteState :: RemoteStateHandle -> Key -> RemoteState -> Annex ()+setRemoteState (RemoteStateHandle u) k s = do 	c <- liftIO currentVectorClock 	config <- Annex.getGitConfig 	Annex.Branch.change (remoteStateLogFile config k) $@@ -33,8 +34,8 @@ buildRemoteState :: Log RemoteState -> Builder buildRemoteState = buildLogNew (byteString . encodeBS) -getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState)-getRemoteState u k = do+getRemoteState :: RemoteStateHandle -> Key -> Annex (Maybe RemoteState)+getRemoteState (RemoteStateHandle u) k = do 	config <- Annex.getGitConfig 	extract . parseRemoteState 		<$> Annex.Branch.get (remoteStateLogFile config k)

@@ -40,8 +40,8 @@ 	, importSupported = importIsSupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	let this = Remote 		{ uuid = u 		-- adb operates over USB or wifi, so is not as cheap@@ -90,6 +90,7 @@ 			] 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 		} 	return $ Just $ specialRemote c 		(simplyPrepare $ store serial adir)

@@ -52,8 +52,8 @@ 	r <- liftIO $ Git.Construct.remoteNamed "bittorrent" (pure Git.Construct.fromUnknown) 	return [r] -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r _ c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r _ c gc rs = do 	cst <- remoteCost gc expensiveRemoteCost 	return $ Just Remote 		{ uuid = bitTorrentUUID@@ -85,6 +85,7 @@ 		, getInfo = return [] 		, claimUrl = Just (pure . isSupportedUrl) 		, checkUrl = Just checkTorrentUrl+		, remoteStateHandle = rs 		}  downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)

@@ -44,8 +44,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	bupr <- liftIO $ bup2GitRemote buprepo 	cst <- remoteCost gc $ 		if bupLocal buprepo@@ -86,6 +86,7 @@ 		, getInfo = return [("repo", buprepo)] 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 		} 	return $ Just $ specialRemote' specialcfg c 		(simplyPrepare $ store this buprepo)

@@ -39,8 +39,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	cst <- remoteCost gc $ 		if ddarLocal ddarrepo 			then nearlyCheapRemoteCost@@ -85,6 +85,7 @@ 		, getInfo = return [("repo", ddarRepoLocation ddarrepo)] 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 		} 	ddarrepo = maybe (giveup "missing ddarrepo") (DdarRepo gc) (remoteAnnexDdarRepo gc) 	specialcfg = (specialRemoteCfg c)

@@ -45,8 +45,8 @@ 	, importSupported = importIsSupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	cst <- remoteCost gc cheapRemoteCost 	let chunkconfig = getChunkConfig c 	return $ Just $ specialRemote c@@ -97,11 +97,12 @@ 			, appendonly = False 			, availability = LocallyAvailable 			, remotetype = remote-			, mkUnavailable = gen r u c $-				gc { remoteAnnexDirectory = Just "/dev/null" }+			, mkUnavailable = gen r u c+				(gc { remoteAnnexDirectory = Just "/dev/null" }) rs 			, getInfo = return [("directory", dir)] 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			}   where 	dir = fromMaybe (giveup "missing directory") $ remoteAnnexDirectory gc

@@ -50,8 +50,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs 	-- readonly mode only downloads urls; does not use external program 	| remoteAnnexReadOnly gc = do 		cst <- remoteCost gc expensiveRemoteCost@@ -67,7 +67,7 @@ 			exportUnsupported 			exportUnsupported 	| otherwise = do-		external <- newExternal externaltype u c gc+		external <- newExternal externaltype u c gc (Just rs) 		Annex.addCleanup (RemoteCleanup u) $ stopExternal external 		cst <- getCost external r gc 		avail <- getAvailability external r gc@@ -132,11 +132,12 @@ 			, availability = avail 			, remotetype = remote  				{ exportSupported = cheapexportsupported }-			, mkUnavailable = gen r u c $-				gc { remoteAnnexExternalType = Just "!dne!" }+			, mkUnavailable = gen r u c+				(gc { remoteAnnexExternalType = Just "!dne!" }) rs 			, getInfo = togetinfo 			, claimUrl = toclaimurl 			, checkUrl = tocheckurl+			, remoteStateHandle = rs 			} 		return $ Just $ specialRemote c 			(simplyPrepare tostore)@@ -155,10 +156,10 @@  	c'' <- case M.lookup "readonly" c of 		Just v | isTrue v == Just True -> do-			setConfig (remoteConfig (fromJust (M.lookup "name" c)) "readonly") (boolConfig True)+			setConfig (remoteConfig (fromJust (lookupName c)) "readonly") (boolConfig True) 			return c' 		_ -> do-			external <- newExternal externaltype u c' gc+			external <- newExternal externaltype u c' gc Nothing 			handleRequest external INITREMOTE Nothing $ \resp -> case resp of 				INITREMOTE_SUCCESS -> result () 				INITREMOTE_FAILURE errmsg -> Just $ giveup errmsg@@ -174,7 +175,7 @@ 	let externaltype = fromMaybe (giveup "Specify externaltype=") $ 		remoteAnnexExternalType gc <|> M.lookup "externaltype" c 	checkExportSupported' -		=<< newExternal externaltype NoUUID c gc+		=<< newExternal externaltype NoUUID c gc Nothing  checkExportSupported' :: External -> Annex Bool checkExportSupported' external = go `catchNonAsync` (const (return False))@@ -414,11 +415,16 @@ 			<$> preferredContentMapRaw 		send $ VALUE expr 	handleRemoteRequest (SETSTATE key state) =-		setRemoteState (externalUUID external) key state-	handleRemoteRequest (GETSTATE key) = do-		state <- fromMaybe ""-			<$> getRemoteState (externalUUID external) key-		send $ VALUE state+		case externalRemoteStateHandle external of+			Just h -> setRemoteState h key state+			Nothing -> senderror "cannot send SETSTATE here"+	handleRemoteRequest (GETSTATE key) =+		case externalRemoteStateHandle external of+			Just h -> do+				state <- fromMaybe ""+					<$> getRemoteState h key+				send $ VALUE state+			Nothing -> senderror "cannot send GETSTATE here" 	handleRemoteRequest (SETURLPRESENT key url) = 		setUrlPresent key url 	handleRemoteRequest (SETURLMISSING key url) =@@ -432,17 +438,17 @@ 		send (VALUE "") -- end of list 	handleRemoteRequest (DEBUG msg) = liftIO $ debugM "external" msg 	handleRemoteRequest (INFO msg) = showInfo msg-	handleRemoteRequest (VERSION _) =-		sendMessage st external (ERROR "too late to send VERSION")+	handleRemoteRequest (VERSION _) = senderror "too late to send VERSION"  	handleAsyncMessage (ERROR err) = giveup $ "external special remote error: " ++ err  	send = sendMessage st external+	senderror = sendMessage st external . ERROR   	credstorage setting = CredPairStorage 		{ credPairFile = base 		, credPairEnvironment = (base ++ "login", base ++ "password")-		, credPairRemoteKey = setting+		, credPairRemoteField = setting 		} 	  where 		base = replace "/" "_" $ fromUUID (externalUUID external) ++ "-" ++ setting

@@ -37,7 +37,7 @@ import Utility.Metered (BytesProcessed(..)) import Types.Transfer (Direction(..)) import Config.Cost (Cost)-import Types.Remote (RemoteConfig)+import Types.Remote (RemoteConfig, RemoteStateHandle) import Types.Export import Types.Availability (Availability(..)) import Types.Key@@ -57,16 +57,18 @@ 	, externalLastPid :: TVar PID 	, externalDefaultConfig :: RemoteConfig 	, externalGitConfig :: RemoteGitConfig+	, externalRemoteStateHandle :: Maybe RemoteStateHandle 	} -newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex External-newExternal externaltype u c gc = liftIO $ External+newExternal :: ExternalType -> UUID -> RemoteConfig -> RemoteGitConfig -> Maybe RemoteStateHandle -> Annex External+newExternal externaltype u c gc rs = liftIO $ External 	<$> pure externaltype 	<*> pure u 	<*> atomically (newTVar []) 	<*> atomically (newTVar 0) 	<*> pure c 	<*> pure gc+	<*> pure rs  type ExternalType = String 

@@ -65,16 +65,16 @@ 	, importSupported = importUnsupported 	} -chainGen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-chainGen gcryptr u c gc = do+chainGen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+chainGen gcryptr u c gc rs = do 	g <- gitRepo 	-- get underlying git repo with real path, not gcrypt path 	r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr 	let r' = r { Git.remoteName = Git.remoteName gcryptr }-	gen r' u c gc+	gen r' u c gc rs -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen baser u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen baser u c gc rs = do 	-- doublecheck that cache matches underlying repo's gcrypt-id 	-- (which might not be set), only for local repos 	(mgcryptid, r) <- getGCryptId True baser gc@@ -82,7 +82,7 @@ 	case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName baser)) of 		(Just gcryptid, Just cachedgcryptid) 			| gcryptid /= cachedgcryptid -> resetup gcryptid r-		_ -> gen' r u c gc+		_ -> gen' r u c gc rs   where 	-- A different drive may have been mounted, making a different 	-- gcrypt remote available. So need to set the cached@@ -95,15 +95,15 @@ 		case (Git.remoteName baser, v) of 			(Just remotename, Just c') -> do 				setGcryptEncryption c' remotename-				setConfig (remoteConfig baser "uuid") (fromUUID u')+				storeUUIDIn (remoteConfig baser "uuid") u' 				setConfig (ConfigKey $ Git.GCrypt.remoteConfigKey "gcrypt-id" remotename) gcryptid-				gen' r u' c' gc+				gen' r u' c' gc rs 			_ -> 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+gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen' r u c gc rs = do 	cst <- remoteCost gc $ 		if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost 	(rsynctransport, rsyncurl) <- rsyncTransportToObjects r gc@@ -137,6 +137,7 @@ 		, getInfo = gitRepoInfo this 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 	} 	return $ Just $ specialRemote' specialcfg c 		(simplyPrepare $ store this rsyncopts)@@ -183,7 +184,7 @@ gCryptSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) gCryptSetup _ mu _ c gc = go $ M.lookup "gitrepo" c   where-	remotename = fromJust (M.lookup "name" c)+	remotename = fromJust (lookupName c) 	go Nothing = giveup "Specify gitrepo=" 	go (Just gitrepo) = do 		(c', _encsetup) <- encryptionSetup c gc

@@ -32,6 +32,7 @@ import qualified Annex.BranchState import qualified Annex.Branch import qualified Annex.Url as Url+import qualified Annex.SpecialRemote.Config as SpecialRemote import Utility.Tmp import Config import Config.Cost@@ -120,7 +121,7 @@ 	inRepo $ Git.Command.run 		[ Param "remote" 		, Param "add"-		, Param $ fromMaybe (giveup "no name") (M.lookup "name" c)+		, Param $ fromMaybe (giveup "no name") (SpecialRemote.lookupName c) 		, Param $ fromMaybe (giveup "no location") (M.lookup "location" c) 		] 	return (c, u)@@ -145,17 +146,17 @@ 		(False, _, NoUUID) -> tryGitConfigRead autoinit r 		_ -> return r -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs 	-- Remote.GitLFS may be used with a repo that is also encrypted 	-- with gcrypt so is checked first.-	| remoteAnnexGitLFS gc = Remote.GitLFS.gen r u c gc-	| Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc+	| remoteAnnexGitLFS gc = Remote.GitLFS.gen r u c gc rs+	| Git.GCrypt.isEncrypted r = Remote.GCrypt.chainGen r u c gc rs 	| otherwise = case repoP2PAddress r of 		Nothing -> do 			st <- mkState r u gc 			go st <$> remoteCost gc defcst-		Just addr -> Remote.P2P.chainGen addr r u c gc+		Just addr -> Remote.P2P.chainGen addr r u c gc rs   where 	defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost 	go st cst = Just new@@ -189,14 +190,15 @@ 			, appendonly = False 			, availability = availabilityCalc r 			, remotetype = remote-			, mkUnavailable = unavailable r u c gc+			, mkUnavailable = unavailable r u c gc rs 			, getInfo = gitRepoInfo new 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			} -unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-unavailable r u c gc = gen r' u c gc+unavailable :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+unavailable r = gen r'   where 	r' = case Git.location r of 		Git.Local { Git.gitdir = d } ->

@@ -57,8 +57,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	-- If the repo uses gcrypt, get the underlaying repo without the 	-- gcrypt url, to do LFS endpoint discovery on. 	r' <- if Git.GCrypt.isEncrypted r@@ -70,10 +70,10 @@ 	h <- liftIO $ newTVarIO $ LFSHandle Nothing Nothing sem r' gc 	cst <- remoteCost gc expensiveRemoteCost 	return $ Just $ specialRemote' specialcfg c-		(simplyPrepare $ store u h)-		(simplyPrepare $ retrieve u h)+		(simplyPrepare $ store rs h)+		(simplyPrepare $ retrieve rs h) 		(simplyPrepare $ remove h)-		(simplyPrepare $ checkKey u h)+		(simplyPrepare $ checkKey rs h) 		(this cst)   where 	this cst = Remote@@ -109,6 +109,7 @@ 		, getInfo = gitRepoInfo (this cst) 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 		} 	specialcfg = (specialRemoteCfg c) 		-- chunking would not improve git-lfs@@ -157,7 +158,7 @@ 	return (c'', u)   where 	url = fromMaybe (giveup "Specify url=") (M.lookup "url" c)-	remotename = fromJust (M.lookup "name" c)+	remotename = fromJust (lookupName c)  data LFSHandle = LFSHandle 	{ downloadEndpoint :: Maybe LFS.Endpoint@@ -327,8 +328,8 @@ 	| isEncKey k = Nothing 	| otherwise = keySize k -mkUploadRequest :: UUID -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)-mkUploadRequest u k content = case (extractKeySha256 k, extractKeySize k) of+mkUploadRequest :: RemoteStateHandle -> Key -> FilePath -> Annex (LFS.TransferRequest, LFS.SHA256, Integer)+mkUploadRequest rs k content = case (extractKeySha256 k, extractKeySize k) of 	(Just sha256, Just size) -> 		ret sha256 size 	(_, Just size) -> do@@ -355,12 +356,12 @@ 			} 		return (req, sha256, size) 	-	remembersha256 sha256 = setRemoteState u k (T.unpack sha256)-	rememberboth sha256 size = setRemoteState u k $+	remembersha256 sha256 = setRemoteState rs k (T.unpack sha256)+	rememberboth sha256 size = setRemoteState rs k $ 		show size ++ " " ++ T.unpack sha256 -mkDownloadRequest :: UUID -> Key -> Annex (Maybe (LFS.TransferRequest, LFS.SHA256, Integer))-mkDownloadRequest u k = case (extractKeySha256 k, extractKeySize k) of+mkDownloadRequest :: RemoteStateHandle -> Key -> Annex (Maybe (LFS.TransferRequest, LFS.SHA256, Integer))+mkDownloadRequest rs k = case (extractKeySha256 k, extractKeySize k) of 	(Just sha256, Just size) -> ret sha256 size 	(_, Just size) -> 		remembersha256 >>= \case@@ -383,8 +384,8 @@ 			, LFS.req_objects = [obj] 			} 		return $ Just (req, sha256, size)-	remembersha256 = fmap T.pack <$> getRemoteState u k-	rememberboth = maybe Nothing parse <$> getRemoteState u k+	remembersha256 = fmap T.pack <$> getRemoteState rs k+	rememberboth = maybe Nothing parse <$> getRemoteState rs k 	  where 		parse s = case words s of 			[ssize, ssha256] -> do@@ -392,11 +393,11 @@ 				return (T.pack ssha256, size) 			_ -> Nothing -store :: UUID -> TVar LFSHandle -> Storer-store u h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \case+store :: RemoteStateHandle -> TVar LFSHandle -> Storer+store rs h = fileStorer $ \k src p -> getLFSEndpoint LFS.RequestUpload h >>= \case 	Nothing -> return False 	Just endpoint -> flip catchNonAsync failederr $ do-		(req, sha256, size) <- mkUploadRequest u k src+		(req, sha256, size) <- mkUploadRequest rs k src 		sendTransferRequest req endpoint >>= \case 			Left err -> do 				warning err@@ -424,10 +425,10 @@ 		warning (show e) 		return False -retrieve :: UUID -> TVar LFSHandle -> Retriever-retrieve u h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >>= \case+retrieve :: RemoteStateHandle -> TVar LFSHandle -> Retriever+retrieve rs h = fileRetriever $ \dest k p -> getLFSEndpoint LFS.RequestDownload h >>= \case 	Nothing -> giveup "unable to connect to git-lfs endpoint"-	Just endpoint -> mkDownloadRequest u k >>= \case+	Just endpoint -> mkDownloadRequest rs k >>= \case 		Nothing -> giveup "unable to download this object from git-lfs" 		Just (req, sha256, size) -> sendTransferRequest req endpoint >>= \case 			Left err -> giveup (show err)@@ -448,10 +449,10 @@ 					uo <- getUrlOptions 					liftIO $ downloadConduit p req dest uo -checkKey :: UUID -> TVar LFSHandle -> CheckPresent-checkKey u h key = getLFSEndpoint LFS.RequestDownload h >>= \case+checkKey :: RemoteStateHandle -> TVar LFSHandle -> CheckPresent+checkKey rs h key = getLFSEndpoint LFS.RequestDownload h >>= \case 	Nothing -> giveup "unable to connect to git-lfs endpoint"-	Just endpoint -> mkDownloadRequest u key >>= \case+	Just endpoint -> mkDownloadRequest rs key >>= \case 		-- Unable to find enough information to request the key 		-- from git-lfs, so it's not present there. 		Nothing -> return False

@@ -39,8 +39,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = new <$> remoteCost gc veryExpensiveRemoteCost   where 	new cst = Just $ specialRemote' specialcfg c 		(prepareStore this)@@ -83,6 +83,7 @@ 				[ ("glacier vault", getVault c) ] 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			} 	specialcfg = (specialRemoteCfg c) 		-- Disabled until jobList gets support for chunks.@@ -104,7 +105,7 @@ 	gitConfigSpecialRemote u fullconfig [("glacier", "true")] 	return (fullconfig, u)   where-	remotename = fromJust (M.lookup "name" c)+	remotename = fromJust (lookupName c) 	defvault = remotename ++ "-" ++ fromUUID u 	defaults = M.fromList 		[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.Glacier)

@@ -23,7 +23,7 @@ creds u = CredPairStorage 	{ credPairFile = fromUUID u 	, credPairEnvironment = ("AWS_ACCESS_KEY_ID", "AWS_SECRET_ACCESS_KEY")-	, credPairRemoteKey = "s3creds"+	, credPairRemoteField = "s3creds" 	}  data Service = S3 | Glacier

@@ -25,6 +25,7 @@ import Utility.Metered import Crypto (EncKey) import Backend (isStableKey)+import Annex.SpecialRemote.Config  import qualified Data.ByteString.Lazy as L import qualified Data.Map as M@@ -49,11 +50,11 @@  getChunkConfig :: RemoteConfig -> ChunkConfig getChunkConfig m =-	case M.lookup "chunksize" m of+	case M.lookup chunksizeField m of 		Nothing -> case M.lookup "chunk" m of 			Nothing -> NoChunks 			Just v -> readsz UnpaddedChunks v "chunk"-		Just v -> readsz LegacyChunks v "chunksize"+		Just v -> readsz LegacyChunks v chunksizeField   where 	readsz c v f = case readSize dataUnits v of 		Just size

@@ -29,6 +29,7 @@ import Crypto import Types.Crypto import qualified Annex+import Annex.SpecialRemote.Config  -- Used to ensure that encryption has been set up before trying to -- eg, store creds in the remote config that would need to use the@@ -55,7 +56,7 @@ 	maybe (genCipher cmd) (updateCipher cmd) (extractCipher c)   where 	-- The type of encryption-	encryption = M.lookup "encryption" c+	encryption = M.lookup encryptionField c 	-- Generate a new cipher, depending on the chosen encryption scheme 	genCipher cmd = case encryption of 		_ | hasEncryptionConfig c -> cannotchange@@ -68,7 +69,7 @@ 		Just "pubkey" -> encsetup $ genEncryptedCipher cmd (c, gc) key PubKey 		Just "sharedpubkey" -> encsetup $ genSharedPubKeyCipher cmd key 		_ -> giveup $ "Specify " ++ intercalate " or "-			(map ("encryption=" ++)+			(map ((encryptionField ++ "=") ++) 				["none","shared","hybrid","pubkey", "sharedpubkey"]) 			++ "." 	key = fromMaybe (giveup "Specify keyid=...") $ M.lookup "keyid" c@@ -130,30 +131,30 @@ embedCreds :: RemoteConfig -> Bool embedCreds c = case yesNo =<< M.lookup "embedcreds" c of 	Just v -> v-	Nothing -> isJust (M.lookup "cipherkeys" c) && isJust (M.lookup "cipher" c)+	Nothing -> isJust (M.lookup cipherkeysField c) && isJust (M.lookup cipherField c)  {- Gets encryption Cipher, and key encryptor. -} cipherKey :: RemoteConfig -> RemoteGitConfig -> Annex (Maybe (Cipher, EncKey)) cipherKey c gc = fmap make <$> remoteCipher c gc   where 	make ciphertext = (ciphertext, encryptKey mac ciphertext)-	mac = fromMaybe defaultMac $ M.lookup "mac" c >>= readMac+	mac = fromMaybe defaultMac $ M.lookup macField c >>= readMac  {- Stores an StorableCipher in a remote's configuration. -} storeCipher :: StorableCipher -> RemoteConfig -> RemoteConfig storeCipher cip = case cip of 	(SharedCipher t) -> addcipher t-	(EncryptedCipher t _ ks) -> addcipher t . storekeys ks "cipherkeys"-	(SharedPubKeyCipher t ks) -> addcipher t . storekeys ks "pubkeys"+	(EncryptedCipher t _ ks) -> addcipher t . storekeys ks cipherkeysField+	(SharedPubKeyCipher t ks) -> addcipher t . storekeys ks pubkeysField   where-	addcipher t = M.insert "cipher" (toB64bs t)+	addcipher t = M.insert cipherField (toB64bs t) 	storekeys (KeyIds l) n = M.insert n (intercalate "," l)  {- Extracts an StorableCipher from a remote's configuration. -} extractCipher :: RemoteConfig -> Maybe StorableCipher-extractCipher c = case (M.lookup "cipher" c,-			M.lookup "cipherkeys" c <|> M.lookup "pubkeys" c,-			M.lookup "encryption" c) of+extractCipher c = case (M.lookup cipherField c,+			M.lookup cipherkeysField c <|> M.lookup pubkeysField c,+			M.lookup encryptionField c) of 	(Just t, Just ks, encryption) | maybe True (== "hybrid") encryption -> 		Just $ EncryptedCipher (fromB64bs t) Hybrid (readkeys ks) 	(Just t, Just ks, Just "pubkey") ->@@ -167,13 +168,15 @@ 	readkeys = KeyIds . splitc ','  isEncrypted :: RemoteConfig -> Bool-isEncrypted c = case M.lookup "encryption" c of+isEncrypted c = case M.lookup encryptionField 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+hasEncryptionConfig c = M.member cipherField c+	|| M.member cipherkeysField c+	|| M.member pubkeysField c  describeEncryption :: RemoteConfig -> String describeEncryption c = case extractCipher c of

@@ -99,8 +99,8 @@ -- | Adjust a remote to support exporttree=yes and importree=yes. -- -- Note that all remotes with importree=yes also have exporttree=yes.-adjustExportImport :: Remote -> Annex Remote-adjustExportImport r = case M.lookup "exporttree" (config r) of+adjustExportImport :: Remote -> RemoteStateHandle -> Annex Remote+adjustExportImport r rs = case M.lookup "exporttree" (config r) of 	Nothing -> return $ notexport r 	Just c -> case yesNo c of 		Just True -> ifM (isExportSupported r)@@ -136,7 +136,7 @@  		let keycids k = do 			db <- getciddb ciddbv-			liftIO $ ContentIdentifier.getContentIdentifiers db (uuid r') k+			liftIO $ ContentIdentifier.getContentIdentifiers db rs k  		let checkpresent k loc =  			checkPresentExportWithContentIdentifier@@ -152,16 +152,16 @@ 					updateexportdb exportdb exportdbv 					oldks <- liftIO $ Export.getExportTreeKey exportdb loc 					oldcids <- liftIO $ concat-						<$> mapM (ContentIdentifier.getContentIdentifiers db (uuid r')) oldks+						<$> mapM (ContentIdentifier.getContentIdentifiers db rs) oldks 					storeExportWithContentIdentifier (importActions r') f k loc oldcids p >>= \case 						Left err -> do 							warning err 							return False 						Right newcid -> do 							withExclusiveLock gitAnnexContentIdentifierLock $ do-								liftIO $ ContentIdentifier.recordContentIdentifier db (uuid r') newcid k+								liftIO $ ContentIdentifier.recordContentIdentifier db rs newcid k 								liftIO $ ContentIdentifier.flushDbQueue db-							recordContentIdentifier (uuid r') newcid k+							recordContentIdentifier rs newcid k 							return True 				, removeExport = \k loc -> 					removeExportWithContentIdentifier (importActions r') k loc

@@ -30,14 +30,17 @@ 	specialRemoteCfg, 	specialRemote, 	specialRemote',+	lookupName, 	module X ) where  import Annex.Common import qualified Annex+import Annex.SpecialRemote.Config import Types.StoreRetrieve import Types.Remote import Crypto+import Annex.UUID import Config import Config.Cost import Utility.Metered@@ -70,7 +73,7 @@ gitConfigSpecialRemote u c cfgs = do 	forM_ cfgs $ \(k, v) ->  		setConfig (remoteConfig c k) v-	setConfig (remoteConfig c "uuid") (fromUUID u)+	storeUUIDIn (remoteConfig c "uuid") u  -- RetrievalVerifiableKeysSecure unless overridden by git config. --

@@ -35,8 +35,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	cst <- remoteCost gc expensiveRemoteCost 	return $ Just $ specialRemote c 		(simplyPrepare $ store hooktype)@@ -70,11 +70,13 @@ 			, appendonly = False 			, availability = GloballyAvailable 			, remotetype = remote-			, mkUnavailable = gen r u c $-				gc { remoteAnnexHookType = Just "!dne!" }+			, mkUnavailable = gen r u c+				(gc { remoteAnnexHookType = Just "!dne!" })+				rs 			, getInfo = return [("hooktype", hooktype)] 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			}   where 	hooktype = fromMaybe (giveup "missing hooktype") $ remoteAnnexHookType gc

@@ -1,12 +1,12 @@-{-# LANGUAGE CPP #-}- {- git-annex remote list  -- - Copyright 2011,2012 Joey Hess <id@joeyh.name>+ - Copyright 2011-2019 Joey Hess <id@joeyh.name>  -  - Licensed under the GNU AGPL version 3 or higher.  -} +{-# LANGUAGE CPP #-}+ module Remote.List where  import qualified Data.Map as M@@ -15,6 +15,7 @@ import qualified Annex import Logs.Remote import Types.Remote+import Types.RemoteState import Annex.UUID import Remote.Helper.Hooks import Remote.Helper.ReadOnly@@ -105,10 +106,12 @@ remoteGen m t g = do 	u <- getRepoUUID g 	gc <- Annex.getRemoteGitConfig g-	let c = fromMaybe M.empty $ M.lookup u m-	generate t g u c gc >>= \case+	let cu = fromMaybe u $ remoteAnnexConfigUUID gc+	let rs = RemoteStateHandle cu+	let c = fromMaybe M.empty $ M.lookup cu m+	generate t g u c gc rs >>= \case 		Nothing -> return Nothing-		Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r))+		Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs  {- Updates a local git Remote, re-reading its git config. -} updateRemote :: Remote -> Annex (Maybe Remote)

@@ -35,14 +35,14 @@ 	-- Remote.Git takes care of enumerating P2P remotes, 	-- and will call chainGen on them. 	, enumerate = const (return [])-	, generate = \_ _ _ _ -> return Nothing+	, generate = \_ _ _ _ _ -> return Nothing 	, setup = error "P2P remotes are set up using git-annex p2p" 	, exportSupported = exportUnsupported 	, importSupported = importUnsupported 	} -chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-chainGen addr r u c gc = do+chainGen :: P2PAddress -> Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+chainGen addr r u c gc rs = do 	connpool <- mkConnectionPool 	cst <- remoteCost gc veryExpensiveRemoteCost 	let protorunner = runProto u addr connpool@@ -76,6 +76,7 @@ 		, getInfo = gitRepoInfo this 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 	} 	return (Just this) 

@@ -54,8 +54,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	cst <- remoteCost gc expensiveRemoteCost 	(transport, url) <- rsyncTransport gc $ 		fromMaybe (giveup "missing rsyncurl") $ remoteAnnexRsyncUrl gc@@ -104,6 +104,7 @@ 			, getInfo = return [("url", url)] 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			}   where 	specialcfg = (specialRemoteCfg c)

@@ -44,6 +44,7 @@ import qualified Annex import Config import Config.Cost+import Annex.SpecialRemote.Config import Remote.Helper.Special import Remote.Helper.Http import Remote.Helper.Messages@@ -77,8 +78,8 @@ 	, importSupported = importIsSupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	cst <- remoteCost gc expensiveRemoteCost 	info <- extractS3Info c 	hdl <- mkS3HandleVar c gc u@@ -87,9 +88,9 @@   where 	new cst info hdl magic = Just $ specialRemote c 		(simplyPrepare $ store hdl this info magic)-		(simplyPrepare $ retrieve hdl this c info)+		(simplyPrepare $ retrieve hdl this rs c info) 		(simplyPrepare $ remove hdl this info)-		(simplyPrepare $ checkKey hdl this c info)+		(simplyPrepare $ checkKey hdl this rs c info) 		this 	  where 		this = Remote@@ -107,23 +108,23 @@ 			, checkPresent = checkPresentDummy 			, checkPresentCheap = False 			, exportActions = ExportActions-				{ storeExport = storeExportS3 hdl this info magic+				{ storeExport = storeExportS3 hdl this rs info magic 				, retrieveExport = retrieveExportS3 hdl this info-				, removeExport = removeExportS3 hdl this info+				, removeExport = removeExportS3 hdl this rs info 				, checkPresentExport = checkPresentExportS3 hdl this info 				-- S3 does not have directories. 				, removeExportDirectory = Nothing-				, renameExport = renameExportS3 hdl this info+				, renameExport = renameExportS3 hdl this rs info 				} 			, importActions = ImportActions                                 { listImportableContents = listImportableContentsS3 hdl this info-                                , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierS3 hdl this info-                                , storeExportWithContentIdentifier = storeExportWithContentIdentifierS3 hdl this info magic-                                , removeExportWithContentIdentifier = removeExportWithContentIdentifierS3 hdl this info+                                , retrieveExportWithContentIdentifier = retrieveExportWithContentIdentifierS3 hdl this rs info+                                , storeExportWithContentIdentifier = storeExportWithContentIdentifierS3 hdl this rs info magic+                                , removeExportWithContentIdentifier = removeExportWithContentIdentifierS3 hdl this rs info                                 , removeExportDirectoryWhenEmpty = Nothing                                 , checkPresentExportWithContentIdentifier = checkPresentExportWithContentIdentifierS3 hdl this info                                 }-			, whereisKey = Just (getPublicWebUrls u info c)+			, whereisKey = Just (getPublicWebUrls u rs info c) 			, remoteFsck = Nothing 			, repairRepo = Nothing 			, config = c@@ -134,10 +135,11 @@ 			, appendonly = versioning info 			, availability = GloballyAvailable 			, remotetype = remote-			, mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc+			, mkUnavailable = gen r u (M.insert "host" "!dne!" c) gc rs 			, getInfo = includeCredsInfo c (AWS.creds u) (s3Info c info) 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			}  s3Setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)@@ -150,7 +152,7 @@ 	| configIA c = archiveorg 	| otherwise = defaulthost   where-	remotename = fromJust (M.lookup "name" c)+	remotename = fromJust (lookupName c) 	defbucket = remotename ++ "-" ++ fromUUID u 	defaults = M.fromList 		[ ("datacenter", T.unpack $ AWS.defaultRegion AWS.S3)@@ -188,7 +190,7 @@ 			-- IA acdepts x-amz-* as an alias for x-archive-* 			M.mapKeys (replace "x-archive-" "x-amz-") $ 			-- encryption does not make sense here-			M.insert "encryption" "none" $+			M.insert encryptionField "none" $ 			M.insert "bucket" validbucket $ 			M.union c' $ 			-- special constraints on key names@@ -292,16 +294,16 @@ {- Implemented as a fileRetriever, that uses conduit to stream the chunks  - out to the file. Would be better to implement a byteRetriever, but  - that is difficult. -}-retrieve :: S3HandleVar -> Remote -> RemoteConfig -> S3Info -> Retriever-retrieve hv r c info = fileRetriever $ \f k p -> withS3Handle hv $ \case+retrieve :: S3HandleVar -> Remote -> RemoteStateHandle -> RemoteConfig -> S3Info -> Retriever+retrieve hv r rs c info = fileRetriever $ \f k p -> withS3Handle hv $ \case 	(Just h) -> -		eitherS3VersionID info (uuid r) c k (T.pack $ bucketObject info k) >>= \case+		eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case 			Left failreason -> do 				warning failreason 				giveup "cannot download content" 			Right loc -> retrieveHelper info h loc f p 	Nothing ->-		getPublicWebUrls' (uuid r) info c k >>= \case+		getPublicWebUrls' (uuid r) rs info c k >>= \case 			Left failreason -> do 				warning failreason 				giveup "cannot download content"@@ -329,17 +331,17 @@ 		S3.DeleteObject (T.pack $ bucketObject info k) (bucket info) 	return $ either (const False) (const True) res -checkKey :: S3HandleVar -> Remote -> RemoteConfig -> S3Info -> CheckPresent-checkKey hv r c info k = withS3Handle hv $ \case+checkKey :: S3HandleVar -> Remote -> RemoteStateHandle -> RemoteConfig -> S3Info -> CheckPresent+checkKey hv r rs c info k = withS3Handle hv $ \case 	Just h -> do 		showChecking r-		eitherS3VersionID info (uuid r) c k (T.pack $ bucketObject info k) >>= \case+		eitherS3VersionID info rs c k (T.pack $ bucketObject info k) >>= \case 			Left failreason -> do 				warning failreason 				giveup "cannot check content" 			Right loc -> checkKeyHelper info h loc 	Nothing ->-		getPublicWebUrls' (uuid r) info c k >>= \case+		getPublicWebUrls' (uuid r) rs info c k >>= \case 			Left failreason -> do 				warning failreason 				giveup "cannot check content"@@ -365,12 +367,12 @@   where 	req = limit $ S3.headObject (bucket info) o -storeExportS3 :: S3HandleVar -> Remote -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool-storeExportS3 hv r info magic f k loc p = fst-	<$> storeExportS3' hv r info magic f k loc p+storeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool+storeExportS3 hv r rs info magic f k loc p = fst+	<$> storeExportS3' hv r rs info magic f k loc p -storeExportS3' :: S3HandleVar -> Remote -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex (Bool, (Maybe S3Etag, Maybe S3VersionID))-storeExportS3' hv r info magic f k loc p = withS3Handle hv $ \case+storeExportS3' :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex (Bool, (Maybe S3Etag, Maybe S3VersionID))+storeExportS3' hv r rs info magic f k loc p = withS3Handle hv $ \case 	Just h -> catchNonAsync (go h) (\e -> warning (show e) >> return (False, (Nothing, Nothing))) 	Nothing -> do 		warning $ needS3Creds (uuid r)@@ -379,7 +381,7 @@ 	go h = do 		let o = T.pack $ bucketExportLocation info loc 		(metag, mvid) <- storeHelper info h magic f o p-		setS3VersionID info (uuid r) k mvid+		setS3VersionID info rs k mvid 		return (True, (metag, mvid))  retrieveExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool@@ -398,9 +400,9 @@ 				liftIO . Url.download p (geturl exportloc) f 	exportloc = bucketExportLocation info loc -removeExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> Annex Bool-removeExportS3 hv r info k loc = withS3Handle hv $ \case-	Just h -> checkVersioning info (uuid r) k $+removeExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> Annex Bool+removeExportS3 hv r rs info k loc = withS3Handle hv $ \case+	Just h -> checkVersioning info rs k $ 		catchNonAsync (go h) (\e -> warning (show e) >> return False) 	Nothing -> do 		warning $ needS3Creds (uuid r)@@ -422,11 +424,11 @@ 			giveup "No S3 credentials configured"  -- S3 has no move primitive; copy and delete.-renameExportS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)-renameExportS3 hv r info k src dest = Just <$> go+renameExportS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> ExportLocation -> Annex (Maybe Bool)+renameExportS3 hv r rs info k src dest = Just <$> go   where 	go = withS3Handle hv $ \case-		Just h -> checkVersioning info (uuid r) k $ +		Just h -> checkVersioning info rs k $  			catchNonAsync (go' h) (\_ -> return False) 		Nothing -> do  			warning $ needS3Creds (uuid r)@@ -542,8 +544,8 @@ 		| otherwise = 			i : removemostrecent mtime rest -retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> S3Info -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)-retrieveExportWithContentIdentifierS3 hv r info loc cid dest mkkey p = withS3Handle hv $ \case+retrieveExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> ExportLocation -> ContentIdentifier -> FilePath -> Annex (Maybe Key) -> MeterUpdate -> Annex (Maybe Key)+retrieveExportWithContentIdentifierS3 hv r rs info loc cid dest mkkey p = withS3Handle hv $ \case 	Nothing -> do 		warning $ needS3Creds (uuid r) 		return Nothing@@ -554,7 +556,7 @@ 		mk <- mkkey 		case (mk, extractContentIdentifier cid o) of 			(Just k, Right vid) -> -				setS3VersionID info (uuid r) k vid+				setS3VersionID info rs k vid 			_ -> noop 		return mk   where@@ -576,8 +578,8 @@ -- -- When the bucket is not versioned, data loss can result. -- This is why that configuration requires --force to enable.-storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)-storeExportWithContentIdentifierS3 hv r info magic src k loc _overwritablecids p+storeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Maybe Magic -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex (Either String ContentIdentifier)+storeExportWithContentIdentifierS3 hv r rs info magic src k loc _overwritablecids p 	| versioning info = go 	-- FIXME Actual aws version that supports getting Etag for a store 	-- is not known; patch not merged yet.@@ -589,7 +591,7 @@ 		Left "git-annex is built with too old a version of the aws library to support this operation" #endif   where-	go = storeExportS3' hv r info magic src k loc p >>= \case+	go = storeExportS3' hv r rs info magic src k loc p >>= \case 		(False, _) -> return $ Left "failed to store content in S3 bucket" 		(True, (_, Just vid)) -> return $ Right $ 			mkS3VersionedContentIdentifier vid@@ -604,9 +606,9 @@ --  -- When the bucket is not versioned, data loss can result. -- This is why that configuration requires --force to enable.-removeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool-removeExportWithContentIdentifierS3 hv r info k loc _removeablecids =-	removeExportS3 hv r info k loc+removeExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> RemoteStateHandle -> S3Info -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool+removeExportWithContentIdentifierS3 hv r rs info k loc _removeablecids =+	removeExportS3 hv r rs info k loc  checkPresentExportWithContentIdentifierS3 :: S3HandleVar -> Remote -> S3Info -> Key -> ExportLocation -> [ContentIdentifier] -> Annex Bool checkPresentExportWithContentIdentifierS3 hv r info _k loc knowncids =@@ -979,11 +981,11 @@ 	showstorageclass (S3.OtherStorageClass t) = T.unpack t 	showstorageclass sc = show sc -getPublicWebUrls :: UUID -> S3Info -> RemoteConfig -> Key -> Annex [URLString]-getPublicWebUrls u info c k = either (const []) id <$> getPublicWebUrls' u info c k+getPublicWebUrls :: UUID -> RemoteStateHandle -> S3Info -> RemoteConfig -> Key -> Annex [URLString]+getPublicWebUrls u rs info c k = either (const []) id <$> getPublicWebUrls' u rs info c k -getPublicWebUrls' :: UUID -> S3Info -> RemoteConfig -> Key -> Annex (Either String [URLString])-getPublicWebUrls' u info c k+getPublicWebUrls' :: UUID -> RemoteStateHandle -> S3Info -> RemoteConfig -> Key -> Annex (Either String [URLString])+getPublicWebUrls' u rs info c k 	| not (public info) = return $ Left $  		"S3 bucket does not allow public access; " ++ needS3Creds u 	| exportTree c = if versioning info@@ -999,7 +1001,7 @@ 		Nothing -> return nopublicurl   where 	nopublicurl = Left "No publicurl is configured for this remote"-	getversionid url = getS3VersionIDPublicUrls url info u k >>= \case+	getversionid url = getS3VersionIDPublicUrls url info rs k >>= \case 		[] -> return (Left "Remote is configured to use versioning, but no S3 version ID is recorded for this key") 		l -> return (Right l) @@ -1100,20 +1102,20 @@ 		"#" -> Left (T.drop 1 t) 		_ -> Right (mkS3VersionID o (Just t)) -setS3VersionID :: S3Info -> UUID -> Key -> Maybe S3VersionID -> Annex ()-setS3VersionID info u k vid-	| versioning info = maybe noop (setS3VersionID' u k) vid+setS3VersionID :: S3Info -> RemoteStateHandle -> Key -> Maybe S3VersionID -> Annex ()+setS3VersionID info rs k vid+	| versioning info = maybe noop (setS3VersionID' rs k) vid 	| otherwise = noop -setS3VersionID' :: UUID -> Key -> S3VersionID -> Annex ()-setS3VersionID' u k vid = addRemoteMetaData k $-	RemoteMetaData u (updateMetaData s3VersionField v emptyMetaData)+setS3VersionID' :: RemoteStateHandle -> Key -> S3VersionID -> Annex ()+setS3VersionID' rs k vid = addRemoteMetaData k rs $+	updateMetaData s3VersionField v emptyMetaData   where 	v = mkMetaValue (CurrentlySet True) (formatS3VersionID vid) -getS3VersionID :: UUID -> Key -> Annex [S3VersionID]-getS3VersionID u k = do-	(RemoteMetaData _ m) <- getCurrentRemoteMetaData u k+getS3VersionID :: RemoteStateHandle -> Key -> Annex [S3VersionID]+getS3VersionID rs k = do+	(RemoteMetaData _ m) <- getCurrentRemoteMetaData rs k 	return $ mapMaybe parseS3VersionID $ map unwrap $ S.toList $ 		metaDataValues s3VersionField m   where@@ -1122,9 +1124,9 @@ s3VersionField :: MetaField s3VersionField = mkMetaFieldUnchecked "V" -eitherS3VersionID :: S3Info -> UUID -> RemoteConfig -> Key -> S3.Object -> Annex (Either String (Either S3.Object S3VersionID))-eitherS3VersionID info u c k fallback-	| versioning info = getS3VersionID u k >>= return . \case+eitherS3VersionID :: S3Info -> RemoteStateHandle -> RemoteConfig -> Key -> S3.Object -> Annex (Either String (Either S3.Object S3VersionID))+eitherS3VersionID info rs c k fallback+	| versioning info = getS3VersionID rs k >>= return . \case 		[] -> if exportTree c 			then Left "Remote is configured to use versioning, but no S3 version ID is recorded for this key" 			else Right (Left fallback)@@ -1140,9 +1142,9 @@ 	, T.unpack vid -- version ID is "url ready" so no escaping needed 	] -getS3VersionIDPublicUrls :: (S3Info -> BucketObject -> URLString) -> S3Info -> UUID -> Key -> Annex [URLString]-getS3VersionIDPublicUrls mk info u k =-	map (s3VersionIDPublicUrl mk info) <$> getS3VersionID u k+getS3VersionIDPublicUrls :: (S3Info -> BucketObject -> URLString) -> S3Info -> RemoteStateHandle -> Key -> Annex [URLString]+getS3VersionIDPublicUrls mk info rs k =+	map (s3VersionIDPublicUrl mk info) <$> getS3VersionID rs k  -- Enable versioning on the bucket can only be done at init time; -- setting versioning in a bucket that git-annex has already exported@@ -1188,9 +1190,9 @@ -- were created without versioning, some unversioned files exported to -- them, and then versioning enabled, and this is to avoid data loss in -- those cases.-checkVersioning :: S3Info -> UUID -> Key -> Annex Bool -> Annex Bool-checkVersioning info u k a-	| versioning info = getS3VersionID u k >>= \case+checkVersioning :: S3Info -> RemoteStateHandle -> Key -> Annex Bool -> Annex Bool+checkVersioning info rs k a+	| versioning info = getS3VersionID rs k >>= \case 		[] -> do 			warning $ "Remote is configured to use versioning, but no S3 version ID is recorded for this key, so it cannot safely be modified." 			return False

@@ -61,8 +61,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = do 	cst <- remoteCost gc expensiveRemoteCost 	hdl <- liftIO $ TahoeHandle 		<$> maybe (defaultTahoeConfigDir u) return (remoteAnnexTahoe gc)@@ -71,18 +71,18 @@ 		{ uuid = u 		, cost = cst 		, name = Git.repoDescribe r-		, storeKey = store u hdl-		, retrieveKeyFile = retrieve u hdl+		, storeKey = store rs hdl+		, retrieveKeyFile = retrieve rs hdl 		, retrieveKeyFileCheap = \_ _ _ -> return False 		-- Tahoe cryptographically verifies content. 		, retrievalSecurityPolicy = RetrievalAllKeysSecure 		, removeKey = remove 		, lockContent = Nothing-		, checkPresent = checkKey u hdl+		, checkPresent = checkKey rs hdl 		, checkPresentCheap = False 		, exportActions = exportUnsupported 		, importActions = importUnsupported-		, whereisKey = Just (getWhereisKey u)+		, whereisKey = Just (getWhereisKey rs) 		, remoteFsck = Nothing 		, repairRepo = Nothing 		, config = c@@ -97,6 +97,7 @@ 		, getInfo = return [] 		, claimUrl = Nothing 		, checkUrl = Nothing+		, remoteStateHandle = rs 		}  tahoeSetup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)@@ -119,14 +120,14 @@ 	furlk = "introducer-furl" 	missingfurl = giveup "Set TAHOE_FURL to the introducer furl to use." -store :: UUID -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool-store u hdl k _f _p = sendAnnex k noop $ \src ->+store :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool+store rs hdl k _f _p = sendAnnex k noop $ \src -> 	parsePut <$> liftIO (readTahoe hdl "put" [File src]) >>= maybe 		(return False)-		(\cap -> storeCapability u k cap >> return True)+		(\cap -> storeCapability rs k cap >> return True) -retrieve :: UUID -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)-retrieve u hdl k _f d _p = unVerified $ go =<< getCapability u k+retrieve :: RemoteStateHandle -> TahoeHandle -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)+retrieve rs hdl k _f d _p = unVerified $ go =<< getCapability rs k   where 	go Nothing = return False 	go (Just cap) = liftIO $ requestTahoe hdl "get" [Param cap, File d]@@ -136,8 +137,8 @@ 	warning "content cannot be removed from tahoe remote" 	return False -checkKey :: UUID -> TahoeHandle -> Key -> Annex Bool-checkKey u hdl k = go =<< getCapability u k+checkKey :: RemoteStateHandle -> TahoeHandle -> Key -> Annex Bool+checkKey rs hdl k = go =<< getCapability rs k   where 	go Nothing = return False 	go (Just cap) = liftIO $ do@@ -233,14 +234,14 @@ tahoeParams configdir command params =  	Param "-d" : File configdir : Param command : params -storeCapability :: UUID -> Key -> Capability -> Annex ()-storeCapability u k cap = setRemoteState u k cap+storeCapability :: RemoteStateHandle -> Key -> Capability -> Annex ()+storeCapability rs k cap = setRemoteState rs k cap -getCapability :: UUID -> Key -> Annex (Maybe Capability)-getCapability u k = getRemoteState u k+getCapability :: RemoteStateHandle -> Key -> Annex (Maybe Capability)+getCapability rs k = getRemoteState rs k -getWhereisKey :: UUID -> Key -> Annex [String]-getWhereisKey u k = disp <$> getCapability u k+getWhereisKey :: RemoteStateHandle -> Key -> Annex [String]+getWhereisKey rs k = disp <$> getCapability rs k   where 	disp Nothing = [] 	disp (Just c) = [c]

@@ -40,8 +40,8 @@ 	r <- liftIO $ Git.Construct.remoteNamed "web" (pure Git.Construct.fromUnknown) 	return [r] -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r _ c gc = do+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r _ c gc rs = do 	cst <- remoteCost gc expensiveRemoteCost 	return $ Just Remote 		{ uuid = webUUID@@ -74,6 +74,7 @@ 		, getInfo = return [] 		, claimUrl = Nothing -- implicitly claims all urls 		, checkUrl = Nothing+		, remoteStateHandle = rs 		}  downloadKey :: Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex (Bool, Verification)

@@ -50,8 +50,8 @@ 	, importSupported = importUnsupported 	} -gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)-gen r u c gc = new <$> remoteCost gc expensiveRemoteCost+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> Annex (Maybe Remote)+gen r u c gc rs = new <$> remoteCost gc expensiveRemoteCost   where 	new cst = Just $ specialRemote c 		(prepareDAV this $ store chunkconfig)@@ -95,11 +95,12 @@ 			, appendonly = False 			, availability = GloballyAvailable 			, remotetype = remote-			, mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc+			, mkUnavailable = gen r u (M.insert "url" "http://!dne!/" c) gc rs 			, getInfo = includeCredsInfo c (davCreds u) $ 				[("url", fromMaybe "unknown" (M.lookup "url" c))] 			, claimUrl = Nothing 			, checkUrl = Nothing+			, remoteStateHandle = rs 			} 		chunkconfig = getChunkConfig c @@ -341,7 +342,7 @@ davCreds u = CredPairStorage 	{ credPairFile = fromUUID u 	, credPairEnvironment = ("WEBDAV_USERNAME", "WEBDAV_PASSWORD")-	, credPairRemoteKey = "davcreds"+	, credPairRemoteField = "davcreds" 	}  {- Content-Type to use for files uploaded to WebDAV. -}

@@ -246,6 +246,7 @@ 	, remoteAnnexRetry :: Maybe Integer 	, remoteAnnexRetryDelay :: Maybe Seconds 	, remoteAnnexAllowUnverifiedDownloads :: Bool+	, remoteAnnexConfigUUID :: Maybe UUID  	{- These settings are specific to particular types of remotes 	 - including special remotes. -}@@ -308,6 +309,7 @@ 			<$> getmayberead "retrydelay" 		, remoteAnnexAllowUnverifiedDownloads = (== Just "ACKTHPPT") $ 			getmaybe ("security-allow-unverified-downloads")+		, remoteAnnexConfigUUID = toUUID <$> getmaybe "config-uuid" 		, remoteAnnexShell = getmaybe "shell" 		, remoteAnnexSshOptions = getoptions "ssh-options" 		, remoteAnnexRsyncOptions = getoptions "rsync-options"

@@ -10,10 +10,11 @@ {-# LANGUAGE RankNTypes #-}  module Types.Remote-	( RemoteConfigKey+	( RemoteConfigField 	, RemoteConfig 	, RemoteTypeA(..) 	, RemoteA(..)+	, RemoteStateHandle 	, SetupStage(..) 	, Availability(..) 	, Verification(..)@@ -36,6 +37,7 @@ import Types.GitConfig import Types.Availability import Types.Creds+import Types.RemoteState import Types.UrlContents import Types.NumCopies import Types.Export@@ -47,9 +49,9 @@ import Utility.Url import Utility.DataUnits -type RemoteConfigKey = String+type RemoteConfigField = String -type RemoteConfig = M.Map RemoteConfigKey String+type RemoteConfig = M.Map RemoteConfigField String  data SetupStage = Init | Enable RemoteConfig @@ -61,7 +63,7 @@ 	-- The Bool is True if automatic initialization of remotes is desired 	, enumerate :: Bool -> a [Git.Repo] 	-- generates a remote of this type-	, generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (Maybe (RemoteA a))+	, generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> RemoteStateHandle -> a (Maybe (RemoteA a)) 	-- initializes or enables a remote 	, setup :: SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> a (RemoteConfig, UUID) 	-- check if a remote of this type is able to support export@@ -151,6 +153,7 @@ 	-- its contents, without downloading the full content. 	-- Throws an exception if the url is inaccessible. 	, checkUrl :: Maybe (URLString -> a UrlContents)+	, remoteStateHandle :: RemoteStateHandle 	}  instance Show (RemoteA a) where

@@ -0,0 +1,19 @@+{- git-annex remote state handle type+ -+ - Copyright 2019 Joey Hess <id@joeyh.name>+ -+ - Licensed under the GNU AGPL version 3 or higher.+ -}++module Types.RemoteState where++import Types.UUID++{- When per-remote state, its UUID is used to identify it.+ -+ - However, sameas remotes mean that two different Remote implementations+ - can be used for the same underlying data store. To avoid them using+ - state in conflicting ways, a different UUID needs to be used for each+ - additional sameas remote.+ -}+newtype RemoteStateHandle = RemoteStateHandle UUID

@@ -43,6 +43,25 @@   and re-run with `--fast`, which causes it to use a lower-quality source of   randomness. (Ie, /dev/urandom instead of /dev/random) +* `--sameas=remote`++  Use this when the new special remote uses the same underlying storage+  as some other remote. This will result in the new special remote having+  the same uuid as the specified remote, and either can be used to access+  the same content.++  The `remote` can be the name of a git remote, or the description+  or uuid of any git-annex repository.++  When using this option, the new remote inherits the encryption settings+  of the existing remote, so you should not specify any encryption+  parameters. No other configuration is inherited from the existing remote.++  This will only work if both remotes use the underlying storage in+  compatible ways. See this page for information about known+  compatabilities.+  <http://git-annex.branchable.com/tips/multiple_remotes_accessing_the_same_data_store/>+ # COMMON CONFIGURATION PARAMETERS  * `encryption`

@@ -10,7 +10,7 @@  Changes the name that is used to enable a special remote. -Normally the current name is used to identify the special remote, +Normally the current name is used to identify the special remote to rename,  but its uuid or description can also be used.  This is especially useful when an old special remote used a name, and now you

@@ -1268,6 +1268,11 @@    git-annex caches UUIDs of remote repositories here. +* `remote.<name>.annex-config-uuid`++  Used for some special remotes, points to a different special remote+  configuration to use.+ * `remote.<name>.annex-retry`, `annex.retry`    Configure retries of failed transfers on a per-remote and general

@@ -1,5 +1,5 @@ Name: git-annex-Version: 7.20191009+Version: 7.20191017 Cabal-Version: >= 1.8 License: AGPL-3 Maintainer: Joey Hess <id@joeyh.name>@@ -304,7 +304,7 @@    base (>= 4.11.1.0 && < 5.0),    network-uri (>= 2.6),    optparse-applicative (>= 0.14.1),-   containers (>= 0.5.7.1),+   containers (>= 0.5.8),    exceptions (>= 0.6),    stm (>= 2.3),    mtl (>= 2),@@ -653,6 +653,7 @@     Annex.ReplaceFile     Annex.RemoteTrackingBranch     Annex.SpecialRemote+    Annex.SpecialRemote.Config     Annex.Ssh     Annex.TaggedPush     Annex.Tmp@@ -896,6 +897,7 @@     Logs.Presence     Logs.Presence.Pure     Logs.Remote+    Logs.Remote.Pure     Logs.RemoteState     Logs.Schedule     Logs.SingleValue@@ -993,6 +995,7 @@     Types.NumCopies     Types.RefSpec     Types.Remote+    Types.RemoteState     Types.RepoVersion     Types.ScheduledActivity     Types.StandardGroups