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.
This commit is contained in:
parent
a4328b49d2
commit
28e2cad849
14 changed files with 69 additions and 29 deletions
|
@ -81,7 +81,7 @@ autoEnable = do
|
||||||
(Just name, Right t) -> whenM (canenable u) $ do
|
(Just name, Right t) -> whenM (canenable u) $ do
|
||||||
showSideAction $ "Auto enabling special remote " ++ name
|
showSideAction $ "Auto enabling special remote " ++ name
|
||||||
dummycfg <- liftIO dummyRemoteGitConfig
|
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
|
case res of
|
||||||
Left e -> warning (show e)
|
Left e -> warning (show e)
|
||||||
Right _ -> return ()
|
Right _ -> return ()
|
||||||
|
|
|
@ -52,7 +52,7 @@ makeRsyncRemote name location = makeRemote name location $ const $ void $
|
||||||
go Nothing = setupSpecialRemote name Rsync.remote config Nothing
|
go Nothing = setupSpecialRemote name Rsync.remote config Nothing
|
||||||
(Nothing, R.Init, Annex.SpecialRemote.newConfig name)
|
(Nothing, R.Init, Annex.SpecialRemote.newConfig name)
|
||||||
go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
|
go (Just (u, c)) = setupSpecialRemote name Rsync.remote config Nothing
|
||||||
(Just u, R.Enable, c)
|
(Just u, R.Enable c, c)
|
||||||
config = M.fromList
|
config = M.fromList
|
||||||
[ ("encryption", "shared")
|
[ ("encryption", "shared")
|
||||||
, ("rsyncurl", location)
|
, ("rsyncurl", location)
|
||||||
|
@ -91,7 +91,7 @@ enableSpecialRemote name remotetype mcreds config = do
|
||||||
r <- Annex.SpecialRemote.findExisting name
|
r <- Annex.SpecialRemote.findExisting name
|
||||||
case r of
|
case r of
|
||||||
Nothing -> error $ "Cannot find a special remote named " ++ name
|
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 :: RemoteName -> RemoteType -> R.RemoteConfig -> Maybe CredPair -> (Maybe UUID, R.SetupStage, R.RemoteConfig) -> Annex RemoteName
|
||||||
setupSpecialRemote = setupSpecialRemote' True
|
setupSpecialRemote = setupSpecialRemote' True
|
||||||
|
|
|
@ -81,11 +81,11 @@ startSpecialRemote name config (Just (u, c)) = do
|
||||||
gc <- maybe (liftIO dummyRemoteGitConfig)
|
gc <- maybe (liftIO dummyRemoteGitConfig)
|
||||||
(return . Remote.gitconfig)
|
(return . Remote.gitconfig)
|
||||||
=<< Remote.byUUID u
|
=<< Remote.byUUID u
|
||||||
next $ performSpecialRemote t u fullconfig gc
|
next $ performSpecialRemote t u c fullconfig gc
|
||||||
|
|
||||||
performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
|
performSpecialRemote :: RemoteType -> UUID -> R.RemoteConfig -> R.RemoteConfig -> RemoteGitConfig -> CommandPerform
|
||||||
performSpecialRemote t u c gc = do
|
performSpecialRemote t u oldc c gc = do
|
||||||
(c', u') <- R.setup t R.Enable (Just u) Nothing c gc
|
(c', u') <- R.setup t (R.Enable oldc) (Just u) Nothing c gc
|
||||||
next $ cleanupSpecialRemote u' c'
|
next $ cleanupSpecialRemote u' c'
|
||||||
|
|
||||||
cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
|
cleanupSpecialRemote :: UUID -> R.RemoteConfig -> CommandCleanup
|
||||||
|
|
|
@ -37,14 +37,14 @@ remote = RemoteType {
|
||||||
typename = "directory",
|
typename = "directory",
|
||||||
enumerate = const (findSpecialRemotes "directory"),
|
enumerate = const (findSpecialRemotes "directory"),
|
||||||
generate = gen,
|
generate = gen,
|
||||||
setup = directorySetup
|
setup = exportableRemoteSetup directorySetup
|
||||||
}
|
}
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote)
|
||||||
gen r u c gc = do
|
gen r u c gc = do
|
||||||
cst <- remoteCost gc cheapRemoteCost
|
cst <- remoteCost gc cheapRemoteCost
|
||||||
let chunkconfig = getChunkConfig c
|
let chunkconfig = getChunkConfig c
|
||||||
return $ Just $ specialRemote c
|
return $ Just $ exportableRemote $ specialRemote c
|
||||||
(prepareStore dir chunkconfig)
|
(prepareStore dir chunkconfig)
|
||||||
(retrieve dir chunkconfig)
|
(retrieve dir chunkconfig)
|
||||||
(simplyPrepare $ remove dir)
|
(simplyPrepare $ remove dir)
|
||||||
|
|
|
@ -111,7 +111,7 @@ gitSetup Init mu _ c _ = do
|
||||||
if isNothing mu || mu == Just u
|
if isNothing mu || mu == Just u
|
||||||
then return (c, u)
|
then return (c, u)
|
||||||
else error "git remote did not have specified uuid"
|
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
|
inRepo $ Git.Command.run
|
||||||
[ Param "remote"
|
[ Param "remote"
|
||||||
, Param "add"
|
, Param "add"
|
||||||
|
@ -119,7 +119,7 @@ gitSetup Enable (Just u) _ c _ = do
|
||||||
, Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
|
, Param $ fromMaybe (giveup "no location") (M.lookup "location" c)
|
||||||
]
|
]
|
||||||
return (c, u)
|
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
|
{- 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.
|
- done each time git-annex is run in a way that uses remotes.
|
||||||
|
|
|
@ -89,8 +89,9 @@ glacierSetup' ss u mcreds c gc = do
|
||||||
(c', encsetup) <- encryptionSetup c gc
|
(c', encsetup) <- encryptionSetup c gc
|
||||||
c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
|
c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
|
||||||
let fullconfig = c'' `M.union` defaults
|
let fullconfig = c'' `M.union` defaults
|
||||||
when (ss == Init) $
|
case ss of
|
||||||
genVault fullconfig gc u
|
Init -> genVault fullconfig gc u
|
||||||
|
_ -> return ()
|
||||||
gitConfigSpecialRemote u fullconfig "glacier" "true"
|
gitConfigSpecialRemote u fullconfig "glacier" "true"
|
||||||
return (fullconfig, u)
|
return (fullconfig, u)
|
||||||
where
|
where
|
||||||
|
|
|
@ -15,6 +15,7 @@ module Remote.Helper.Encryptable (
|
||||||
embedCreds,
|
embedCreds,
|
||||||
cipherKey,
|
cipherKey,
|
||||||
extractCipher,
|
extractCipher,
|
||||||
|
isEncrypted,
|
||||||
describeEncryption,
|
describeEncryption,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -57,7 +58,7 @@ encryptionSetup c gc = do
|
||||||
encryption = M.lookup "encryption" c
|
encryption = M.lookup "encryption" c
|
||||||
-- Generate a new cipher, depending on the chosen encryption scheme
|
-- Generate a new cipher, depending on the chosen encryption scheme
|
||||||
genCipher cmd = case encryption of
|
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 "none" -> return (c, NoEncryption)
|
||||||
Just "shared" -> encsetup $ genSharedCipher cmd
|
Just "shared" -> encsetup $ genSharedCipher cmd
|
||||||
-- hybrid encryption is the default when a keyid is
|
-- hybrid encryption is the default when a keyid is
|
||||||
|
@ -167,6 +168,15 @@ extractCipher c = case (M.lookup "cipher" c,
|
||||||
where
|
where
|
||||||
readkeys = KeyIds . splitc ','
|
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 :: RemoteConfig -> String
|
||||||
describeEncryption c = case extractCipher c of
|
describeEncryption c = case extractCipher c of
|
||||||
Nothing -> "none"
|
Nothing -> "none"
|
||||||
|
|
|
@ -9,7 +9,12 @@ module Remote.Helper.Export where
|
||||||
|
|
||||||
import Annex.Common
|
import Annex.Common
|
||||||
import Types.Remote
|
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 Annex
|
||||||
exportUnsupported = ExportActions
|
exportUnsupported = ExportActions
|
||||||
{ exportSupported = return False
|
{ exportSupported = return False
|
||||||
|
@ -19,3 +24,28 @@ exportUnsupported = ExportActions
|
||||||
, checkPresentExport = \_ _ -> return False
|
, checkPresentExport = \_ _ -> return False
|
||||||
, renameExport = \_ _ _ -> 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
|
||||||
|
|
|
@ -129,8 +129,9 @@ s3Setup' ss u mcreds c gc
|
||||||
(c', encsetup) <- encryptionSetup c gc
|
(c', encsetup) <- encryptionSetup c gc
|
||||||
c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
|
c'' <- setRemoteCredPair encsetup c' gc (AWS.creds u) mcreds
|
||||||
let fullconfig = c'' `M.union` defaults
|
let fullconfig = c'' `M.union` defaults
|
||||||
when (ss == Init) $
|
case ss of
|
||||||
genBucket fullconfig gc u
|
Init -> genBucket fullconfig gc u
|
||||||
|
_ -> return ()
|
||||||
use fullconfig
|
use fullconfig
|
||||||
|
|
||||||
archiveorg = do
|
archiveorg = do
|
||||||
|
|
|
@ -44,8 +44,7 @@ type RemoteConfigKey = String
|
||||||
|
|
||||||
type RemoteConfig = M.Map RemoteConfigKey String
|
type RemoteConfig = M.Map RemoteConfigKey String
|
||||||
|
|
||||||
data SetupStage = Init | Enable
|
data SetupStage = Init | Enable RemoteConfig
|
||||||
deriving (Eq)
|
|
||||||
|
|
||||||
{- There are different types of remotes. -}
|
{- There are different types of remotes. -}
|
||||||
data RemoteTypeA a = RemoteType {
|
data RemoteTypeA a = RemoteType {
|
||||||
|
|
|
@ -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
|
from an existing special remote and reuse it, but there does not seem much
|
||||||
benefit in doing so.)
|
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`:
|
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
|
It does not make sense to encrypt an export, so exporttree=yes requires
|
||||||
(and can even imply) encryption=false.
|
encryption=none.
|
||||||
|
|
||||||
Note that the particular tree to export is not specified yet. This is
|
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.
|
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
|
repositories can export a special remote, they can be out of sync about
|
||||||
what files are exported to it.
|
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
|
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
|
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
|
except for when the WORM or URL backend is used. So, prevent the user
|
||||||
|
|
|
@ -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.
|
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
|
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).
|
when initially setting it up with [[git-annex-initremote]](1).
|
||||||
|
|
||||||
Repeated exports are done efficiently, by diffing the old and new tree,
|
Repeated exports are done efficiently, by diffing the old and new tree,
|
||||||
|
|
|
@ -31,7 +31,7 @@ remote:
|
||||||
Do not use for new remotes. It is not safe to change the chunksize
|
Do not use for new remotes. It is not safe to change the chunksize
|
||||||
setting of an existing remote.
|
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
|
by [[git-annex-export]]. It will not be usable as a general-purpose
|
||||||
special remote.
|
special remote.
|
||||||
|
|
||||||
|
|
|
@ -17,12 +17,9 @@ there need to be a new interface in supported remotes?
|
||||||
|
|
||||||
Work is in progress. Todo list:
|
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.
|
* Use retrieveExport when getting from export remotes.
|
||||||
|
(Needs a map from key to ExportLocation)
|
||||||
* Efficient handling of renames.
|
* 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
|
* If the same content is present in two different files, export
|
||||||
location tracking can be messed up.
|
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
|
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
|
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.)
|
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.
|
||||||
|
|
Loading…
Reference in a new issue