diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs index f53a2ca638..c215208db2 100644 --- a/Annex/SpecialRemote.hs +++ b/Annex/SpecialRemote.hs @@ -81,7 +81,7 @@ autoEnable = do (Just name, Right t) -> whenM (canenable u) $ do showSideAction $ "Auto enabling special remote " ++ name dummycfg <- liftIO dummyRemoteGitConfig - res <- tryNonAsync $ setup t Enable (Just u) Nothing c dummycfg + res <- tryNonAsync $ setup t (Enable c) (Just u) Nothing c dummycfg case res of Left e -> warning (show e) Right _ -> return () diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index 57abb86fd0..b98e7f0237 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -52,7 +52,7 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $ 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) + (Just u, R.Enable c, c) config = M.fromList [ ("encryption", "shared") , ("rsyncurl", location) @@ -91,7 +91,7 @@ enableSpecialRemote name remotetype mcreds config = do r <- Annex.SpecialRemote.findExisting name case r of Nothing -> error $ "Cannot find a special remote named " ++ name - Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable, c) + Just (u, c) -> setupSpecialRemote' False name remotetype config mcreds (Just u, R.Enable c, c) setupSpecialRemote :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName setupSpecialRemote = setupSpecialRemote' True diff --git a/Command/EnableRemote.hs b/Command/EnableRemote.hs index a2a26009ee..fd830375a4 100644 --- a/Command/EnableRemote.hs +++ b/Command/EnableRemote.hs @@ -81,11 +81,11 @@ startSpecialRemote name config (Just (u, c)) = do gc <- maybe (liftIO dummyRemoteGitConfig) (return . Remote.gitconfig) =<< Remote.byUUID u - next $ performSpecialRemote t u fullconfig gc + next $ performSpecialRemote t u c fullconfig gc -performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform -performSpecialRemote t u c gc = do - (c', u') <- R.setup t R.Enable (Just u) Nothing c gc +performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform +performSpecialRemote t u oldc c gc = do + (c', u') <- R.setup t (R.Enable oldc) (Just u) Nothing c gc next $ cleanupSpecialRemote u' c' cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup diff --git a/Remote/Directory.hs b/Remote/Directory.hs index e2e517b842..6adf6477aa 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -37,14 +37,14 @@ remote = RemoteType { typename = "directory", enumerate = const (findSpecialRemotes "directory"), generate = gen, - setup = directorySetup + setup = exportableRemoteSetup directorySetup } gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen r u c gc = do cst <- remoteCost gc cheapRemoteCost let chunkconfig = getChunkConfig c - return $ Just $ specialRemote c + return $ Just $ exportableRemote $ specialRemote c (prepareStore dir chunkconfig) (retrieve dir chunkconfig) (simplyPrepare $ remove dir) diff --git a/Remote/Git.hs b/Remote/Git.hs index 129d5e1716..64fb51af83 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -111,7 +111,7 @@ gitSetup Init mu _ c _ = do if isNothing mu || mu == Just u then return (c, u) else error "git remote did not have specified uuid" -gitSetup Enable (Just u) _ c _ = do +gitSetup (Enable _) (Just u) _ c _ = do inRepo $ Git.Command.run [ Param "remote" , Param "add" @@ -119,7 +119,7 @@ gitSetup Enable (Just u) _ c _ = do , Param $ fromMaybe (giveup "no location") (M.lookup "location" c) ] return (c, u) -gitSetup Enable Nothing _ _ _ = error "unable to enable git remote with no specified uuid" +gitSetup (Enable _) Nothing _ _ _ = error "unable to enable git remote with no specified uuid" {- It's assumed to be cheap to read the config of non-URL remotes, so this is - done each time git-annex is run in a way that uses remotes. diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs index b21167aaf3..67e1b8b2e0 100644 --- a/Remote/Glacier.hs +++ b/Remote/Glacier.hs @@ -89,8 +89,9 @@ glacierSetup' ss u mcreds c gc = do (c', encsetup) <- encryptionSetup c gc c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds let fullconfig = c'' `M.union` defaults - when (ss == Init) $ - genVault fullconfig gc u + case ss of + Init -> genVault fullconfig gc u + _ -> return () gitConfigSpecialRemote u fullconfig "glacier" "true" return (fullconfig, u) where diff --git a/Remote/Helper/Encryptable.hs b/Remote/Helper/Encryptable.hs index 1fe6d75be5..97e55a4158 100644 --- a/Remote/Helper/Encryptable.hs +++ b/Remote/Helper/Encryptable.hs @@ -15,6 +15,7 @@ module Remote.Helper.Encryptable ( embedCreds, cipherKey, extractCipher, + isEncrypted, describeEncryption, ) where @@ -57,7 +58,7 @@ encryptionSetup c gc = do encryption = M.lookup "encryption" c -- Generate a new cipher, depending on the chosen encryption scheme genCipher cmd = case encryption of - _ | M.member "cipher" c || M.member "cipherkeys" c || M.member "pubkeys" c -> cannotchange + _ | hasEncryptionConfig c -> cannotchange Just "none" -> return (c, NoEncryption) Just "shared" -> encsetup $ genSharedCipher cmd -- hybrid encryption is the default when a keyid is @@ -167,6 +168,15 @@ extractCipher c = case (M.lookup "cipher" c, where readkeys = KeyIds . splitc ',' +isEncrypted :: RemoteConfig -> Bool +isEncrypted c = case M.lookup "encryption" 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 + describeEncryption :: RemoteConfig -> String describeEncryption c = case extractCipher c of Nothing -> "none" diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs index d623818e73..9bbbb1f59c 100644 --- a/Remote/Helper/Export.hs +++ b/Remote/Helper/Export.hs @@ -9,7 +9,12 @@ module Remote.Helper.Export where import Annex.Common import Types.Remote +import Types.Creds +import Remote.Helper.Encryptable (isEncrypted) +import qualified Data.Map as M + +-- | Use for remotes that do not support exports. exportUnsupported :: ExportActions Annex exportUnsupported = ExportActions { exportSupported = return False @@ -19,3 +24,28 @@ exportUnsupported = ExportActions , checkPresentExport = \_ _ -> return False , renameExport = \_ _ _ -> return False } + +-- | A remote that supports exports when configured with exporttree=yes, +-- and otherwise does not. +exportableRemote :: Remote -> Remote +exportableRemote r = case M.lookup "exporttree" (config r) of + Just "yes" -> r + { storeKey = \_ _ _ -> do + warning "remote is configured with exporttree=yes; use `git-annex export` to store content on it" + return False + } + _ -> r + { exportActions = exportUnsupported } + +exportableRemoteSetup :: (SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID)) -> SetupStage -> Maybe UUID -> Maybe CredPair -> RemoteConfig -> RemoteGitConfig -> Annex (RemoteConfig, UUID) +exportableRemoteSetup setupaction st mu cp c gc = case st of + Init -> case M.lookup "exporttree" c of + Just "yes" | isEncrypted c -> + giveup "cannot enable both encryption and exporttree" + _ -> cont + Enable oldc + | M.lookup "exporttree" c /= M.lookup "exporttree" oldc -> + giveup "cannot change exporttree of existing special remote" + | otherwise -> cont + where + cont = setupaction st mu cp c gc diff --git a/Remote/S3.hs b/Remote/S3.hs index 341d14b4e7..ffa6a11bbd 100644 --- a/Remote/S3.hs +++ b/Remote/S3.hs @@ -129,8 +129,9 @@ s3Setup' ss u mcreds c gc (c', encsetup) <- encryptionSetup c gc c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds let fullconfig = c'' `M.union` defaults - when (ss == Init) $ - genBucket fullconfig gc u + case ss of + Init -> genBucket fullconfig gc u + _ -> return () use fullconfig archiveorg = do diff --git a/Types/Remote.hs b/Types/Remote.hs index 169701eccb..a0174ebee4 100644 --- a/Types/Remote.hs +++ b/Types/Remote.hs @@ -44,8 +44,7 @@ type RemoteConfigKey = String type RemoteConfig = M.Map RemoteConfigKey String -data SetupStage = Init | Enable - deriving (Eq) +data SetupStage = Init | Enable RemoteConfig {- There are different types of remotes. -} data RemoteTypeA a = RemoteType { diff --git a/doc/design/exporting_trees_to_special_remotes.mdwn b/doc/design/exporting_trees_to_special_remotes.mdwn index 52a68c6b42..118f12978a 100644 --- a/doc/design/exporting_trees_to_special_remotes.mdwn +++ b/doc/design/exporting_trees_to_special_remotes.mdwn @@ -15,13 +15,13 @@ when they want to export a tree. (It would also be possible to drop all content from an existing special remote and reuse it, but there does not seem much benefit in doing so.) -Add a new `initremote` configuration `exporttree=true`, that cannot be +Add a new `initremote` configuration `exporttree=yes`, that cannot be changed by `enableremote`: - git annex initremote myexport type=... exporttree=true + git annex initremote myexport type=... exporttree=yes -It does not make sense to encrypt an export, so exporttree=true requires -(and can even imply) encryption=false. +It does not make sense to encrypt an export, so exporttree=yes requires +encryption=none. Note that the particular tree to export is not specified yet. This is because the tree that is exported to a special remote may change. @@ -137,7 +137,7 @@ key/value stores. The content of a file can change, and if multiple repositories can export a special remote, they can be out of sync about what files are exported to it. -Possible solution: Make exporttree=true cause the special remote to +Possible solution: Make exporttree=yes cause the special remote to be untrusted, and rely on annex.verify to catch cases where the content of a file on a special remote has changed. This would work well enough except for when the WORM or URL backend is used. So, prevent the user diff --git a/doc/git-annex-export.mdwn b/doc/git-annex-export.mdwn index 96a09dc9b6..abe00f09b6 100644 --- a/doc/git-annex-export.mdwn +++ b/doc/git-annex-export.mdwn @@ -15,7 +15,7 @@ keys. That is great for data storage, but your filenames are obscured. Exporting replicates the tree to the special remote as-is. Mixing key/value and exports in the same remote would be a mess and so is -not allowed. So, you have to configure a remote with `exporttree=true` +not allowed. So, you have to configure a remote with `exporttree=yes` when initially setting it up with [[git-annex-initremote]](1). Repeated exports are done efficiently, by diffing the old and new tree, diff --git a/doc/special_remotes/directory.mdwn b/doc/special_remotes/directory.mdwn index e3f7f1e45f..70610c66de 100644 --- a/doc/special_remotes/directory.mdwn +++ b/doc/special_remotes/directory.mdwn @@ -31,7 +31,7 @@ remote: Do not use for new remotes. It is not safe to change the chunksize setting of an existing remote. -* `exporttree` - Set to "true" to make this special remote usable +* `exporttree` - Set to "yes" to make this special remote usable by [[git-annex-export]]. It will not be usable as a general-purpose special remote. diff --git a/doc/todo/export.mdwn b/doc/todo/export.mdwn index 914febe34c..828e1c55bd 100644 --- a/doc/todo/export.mdwn +++ b/doc/todo/export.mdwn @@ -17,12 +17,9 @@ there need to be a new interface in supported remotes? Work is in progress. Todo list: -* Only export to remotes that were initialized to support it. -* Prevent using export remotes for key/value storage. * Use retrieveExport when getting from export remotes. + (Needs a map from key to ExportLocation) * Efficient handling of renames. -* Support export to aditional special remotes (S3 etc) -* Support export to external special remotes. * If the same content is present in two different files, export location tracking can be messed up. @@ -33,3 +30,5 @@ Work is in progress. Todo list: And, once one of the files is uploaded, the location log will say the content is present, so the pass over the tree won't try to upload the other file. (See design for a fix for this.) +* Support export to aditional special remotes (S3 etc) +* Support export to external special remotes.