diff options
author | 2017-09-04 12:40:33 -0400 | |
---|---|---|
committer | 2017-09-04 13:09:38 -0400 | |
commit | 5ce97e8c736c121d53af23d7036264868a461db8 (patch) | |
tree | 1c8b180a503996be3b0ea63fc667bc564f2c3fcc /Remote/Helper/Export.hs | |
parent | 2aea8192e1769c4acfbc130ba4d788abd5ee4539 (diff) |
implement exporttree=yes configuration
* Only export to remotes that were initialized to support it.
* Prevent storing key/value on export remotes.
* Prevent enabling exporttree=yes and encryption in the same remote.
SetupStage Enable was changed to take the old RemoteConfig.
This allowed only setting exporttree when initially setting up a
remote, and not configuring it later after stuff might already be stored
in the remote.
Went with =yes rather than =true for consistency with other parts of
git-annex. Changed docs accordingly.
This commit was supported by the NSF-funded DataLad project.
Diffstat (limited to 'Remote/Helper/Export.hs')
-rw-r--r-- | Remote/Helper/Export.hs | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs index d623818e7..9bbbb1f59 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 |