gcrypt: now supports rsync
Use rsync for gcrypt remotes that are not local to the disk. (Note that I have punted on supporting http transport for now, it doesn't seem likely to be very useful.) This was mostly quite easy, it just uses the rsync special remote to handle the transfers. The git repository url is converted to a RsyncOptions structure, which required parsing it separately, since the rsync special remote only supports rsync urls, which use a different format. Note that annexed objects are now stored at the top of the gcrypt repo, rather than inside annex/objects. This simplified the rsync suport, since it doesn't have to arrange to create that directory. And git-annex is not going to be run directly within gcrypt repos -- or if in some strance scenario it was, it would make sense for it to not see the encrypted objects. This commit was sponsored by Sheila Miguez
This commit is contained in:
Joey Hess
parent
9477a07cbf
commit
3e079cdcd1
4 changed files with 105 additions and 64 deletions
101
Remote/GCrypt.hs
101
Remote/GCrypt.hs
|
|
@ -28,6 +28,9 @@ import Remote.Helper.Encryptable
|
|||
import Utility.Metered
|
||||
import Crypto
|
||||
import Annex.UUID
|
||||
import Annex.Ssh
|
||||
import qualified Remote.Rsync
|
||||
import Utility.Rsync
|
||||
|
||||
remote :: RemoteType
|
||||
remote = RemoteType {
|
||||
|
|
@ -52,33 +55,47 @@ gen gcryptr u c gc = do
|
|||
gen' r'' u c gc
|
||||
|
||||
gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
||||
gen' r u c gc = new <$> remoteCost gc defcst
|
||||
where
|
||||
defcst = if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
|
||||
new cst = encryptableRemote c
|
||||
(store this)
|
||||
(retrieve this)
|
||||
gen' r u c gc = do
|
||||
cst <- remoteCost gc $
|
||||
if repoCheap r then nearlyCheapRemoteCost else expensiveRemoteCost
|
||||
(rsynctransport, rsyncurl) <- rsyncTransport r
|
||||
let rsyncopts = Remote.Rsync.genRsyncOpts c gc rsynctransport rsyncurl
|
||||
let this = Remote
|
||||
{ uuid = u
|
||||
, cost = cst
|
||||
, name = Git.repoDescribe r
|
||||
, storeKey = \_ _ _ -> noCrypto
|
||||
, retrieveKeyFile = \_ _ _ _ -> noCrypto
|
||||
, retrieveKeyFileCheap = \_ _ -> return False
|
||||
, removeKey = remove this rsyncopts
|
||||
, hasKey = checkPresent this rsyncopts
|
||||
, hasKeyCheap = repoCheap r
|
||||
, whereisKey = Nothing
|
||||
, config = M.empty
|
||||
, localpath = localpathCalc r
|
||||
, repo = r
|
||||
, gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r }
|
||||
, readonly = Git.repoIsHttp r
|
||||
, globallyAvailable = globallyAvailableCalc r
|
||||
, remotetype = remote
|
||||
}
|
||||
return $ encryptableRemote c
|
||||
(store this rsyncopts)
|
||||
(retrieve this rsyncopts)
|
||||
this
|
||||
where
|
||||
this = Remote
|
||||
{ uuid = u
|
||||
, cost = cst
|
||||
, name = Git.repoDescribe r
|
||||
, storeKey = \_ _ _ -> noCrypto
|
||||
, retrieveKeyFile = \_ _ _ _ -> noCrypto
|
||||
, retrieveKeyFileCheap = \_ _ -> return False
|
||||
, removeKey = remove this
|
||||
, hasKey = checkPresent this
|
||||
, hasKeyCheap = repoCheap r
|
||||
, whereisKey = Nothing
|
||||
, config = M.empty
|
||||
, localpath = localpathCalc r
|
||||
, repo = r
|
||||
, gitconfig = gc { remoteGitConfig = Just $ extractGitConfig r }
|
||||
, readonly = Git.repoIsHttp r
|
||||
, globallyAvailable = globallyAvailableCalc r
|
||||
, remotetype = remote
|
||||
}
|
||||
|
||||
rsyncTransport :: Git.Repo -> Annex ([CommandParam], String)
|
||||
rsyncTransport r
|
||||
| "ssh://" `isPrefixOf` loc = sshtransport $ break (== '/') $ drop (length "ssh://") loc
|
||||
| "//:" `isInfixOf` loc = othertransport
|
||||
| ":" `isInfixOf` loc = sshtransport $ separate (== ':') loc
|
||||
| otherwise = othertransport
|
||||
where
|
||||
loc = Git.repoLocation r
|
||||
sshtransport (host, path) = do
|
||||
opts <- sshCachingOptions (host, Nothing) []
|
||||
return (rsyncShell $ Param "ssh" : opts, host ++ ":" ++ path)
|
||||
othertransport = return ([], loc)
|
||||
|
||||
noCrypto :: Annex a
|
||||
noCrypto = error "cannot use gcrypt remote without encryption enabled"
|
||||
|
|
@ -131,28 +148,29 @@ gCryptSetup mu c = go $ M.lookup "gitrepo" c
|
|||
then return (c', u)
|
||||
else error "uuid mismatch"
|
||||
|
||||
store :: Remote -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
|
||||
store r (cipher, enck) k p
|
||||
store :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
|
||||
store r rsyncopts (cipher, enck) k p
|
||||
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $
|
||||
sendwith $ \meterupdate h -> do
|
||||
createDirectoryIfMissing True $ parentDir dest
|
||||
readBytes (meteredWriteFile meterupdate dest) h
|
||||
return True
|
||||
| Git.repoIsSsh (repo r) = sendwith $ \meterupdate h -> undefined
|
||||
| Git.repoIsSsh (repo r) = Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p
|
||||
| otherwise = unsupportedUrl
|
||||
where
|
||||
gpgopts = getGpgEncParams r
|
||||
dest = gCryptLocation r enck
|
||||
sendwith a = metered (Just p) k $ \meterupdate ->
|
||||
Annex.Content.sendAnnex k noop $ \src ->
|
||||
liftIO $ catchBoolIO $
|
||||
encrypt (getGpgEncParams r) cipher (feedFile src) (a meterupdate)
|
||||
encrypt gpgopts cipher (feedFile src) (a meterupdate)
|
||||
|
||||
retrieve :: Remote -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
|
||||
retrieve r (cipher, enck) k d p
|
||||
retrieve :: Remote -> Remote.Rsync.RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
|
||||
retrieve r rsyncopts (cipher, enck) k d p
|
||||
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
|
||||
retrievewith $ L.readFile src
|
||||
return True
|
||||
| Git.repoIsSsh (repo r) = undefined
|
||||
| Git.repoIsSsh (repo r) = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p
|
||||
| otherwise = unsupportedUrl
|
||||
where
|
||||
src = gCryptLocation r enck
|
||||
|
|
@ -161,26 +179,29 @@ retrieve r (cipher, enck) k d p
|
|||
decrypt cipher (feedBytes b)
|
||||
(readBytes $ meteredWriteFile meterupdate d)
|
||||
|
||||
remove :: Remote -> Key -> Annex Bool
|
||||
remove r k
|
||||
remove :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex Bool
|
||||
remove r rsyncopts k
|
||||
| not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
|
||||
liftIO $ removeDirectoryRecursive (parentDir dest)
|
||||
return True
|
||||
| Git.repoIsSsh (repo r) = undefined
|
||||
| Git.repoIsSsh (repo r) = Remote.Rsync.remove rsyncopts k
|
||||
| otherwise = unsupportedUrl
|
||||
where
|
||||
dest = gCryptLocation r k
|
||||
|
||||
checkPresent :: Remote -> Key -> Annex (Either String Bool)
|
||||
checkPresent r k
|
||||
checkPresent :: Remote -> Remote.Rsync.RsyncOpts -> Key -> Annex (Either String Bool)
|
||||
checkPresent r rsyncopts k
|
||||
| not $ Git.repoIsUrl (repo r) =
|
||||
guardUsable (repo r) unknown $
|
||||
liftIO $ catchDefaultIO unknown $
|
||||
Right <$> doesFileExist (gCryptLocation r k)
|
||||
| Git.repoIsSsh (repo r) = undefined
|
||||
| Git.repoIsSsh (repo r) = Remote.Rsync.checkPresent (repo r) rsyncopts k
|
||||
| otherwise = unsupportedUrl
|
||||
where
|
||||
unknown = Left $ "unable to check " ++ Git.repoDescribe (repo r) ++ show (repo r)
|
||||
|
||||
{- Annexed objects are stored directly under the top of the gcrypt repo
|
||||
- (not in annex/objects), and are hashed using lower-case directories for max
|
||||
- portability. -}
|
||||
gCryptLocation :: Remote -> Key -> FilePath
|
||||
gCryptLocation r key = Git.repoLocation (repo r) </> annexLocation key hashDirLower
|
||||
gCryptLocation r key = Git.repoLocation (repo r) </> keyPath key hashDirLower
|
||||
|
|
|
|||
|
|
@ -7,7 +7,16 @@
|
|||
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Remote.Rsync (remote) where
|
||||
module Remote.Rsync (
|
||||
remote,
|
||||
storeEncrypted,
|
||||
retrieveEncrypted,
|
||||
remove,
|
||||
checkPresent,
|
||||
withRsyncScratchDir,
|
||||
genRsyncOpts,
|
||||
RsyncOpts
|
||||
) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.Map as M
|
||||
|
|
@ -52,9 +61,10 @@ remote = RemoteType {
|
|||
gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
|
||||
gen r u c gc = do
|
||||
cst <- remoteCost gc expensiveRemoteCost
|
||||
(transport, url) <- rsyncTransport
|
||||
let o = RsyncOpts url (transport ++ opts) escape
|
||||
islocal = rsyncUrlIsPath $ rsyncUrl o
|
||||
(transport, url) <- rsyncTransport gc $
|
||||
fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
|
||||
let o = genRsyncOpts c gc transport url
|
||||
let islocal = rsyncUrlIsPath $ rsyncUrl o
|
||||
return $ encryptableRemote c
|
||||
(storeEncrypted o $ getGpgEncParams (c,gc))
|
||||
(retrieveEncrypted o)
|
||||
|
|
@ -79,6 +89,9 @@ gen r u c gc = do
|
|||
, globallyAvailable = not $ islocal
|
||||
, remotetype = remote
|
||||
}
|
||||
|
||||
genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts
|
||||
genRsyncOpts c gc transport url = RsyncOpts url (transport ++ opts) escape
|
||||
where
|
||||
opts = map Param $ filter safe $ remoteAnnexRsyncOptions gc
|
||||
escape = M.lookup "shellescape" c /= Just "no"
|
||||
|
|
@ -89,28 +102,30 @@ gen r u c gc = do
|
|||
| opt == "--delete" = False
|
||||
| opt == "--delete-excluded" = False
|
||||
| otherwise = True
|
||||
rawurl = fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
|
||||
|
||||
rsyncTransport :: RemoteGitConfig -> RsyncUrl -> Annex ([CommandParam], RsyncUrl)
|
||||
rsyncTransport gc rawurl
|
||||
| rsyncUrlIsShell rawurl =
|
||||
(\rsh -> return (rsyncShell rsh, resturl)) =<<
|
||||
case fromNull ["ssh"] (remoteAnnexRsyncTransport gc) of
|
||||
"ssh":sshopts -> do
|
||||
let (port, sshopts') = sshReadPort sshopts
|
||||
host = takeWhile (/=':') resturl
|
||||
-- Connection caching
|
||||
(Param "ssh":) <$> sshCachingOptions
|
||||
(host, port)
|
||||
(map Param $ loginopt ++ sshopts')
|
||||
"rsh":rshopts -> return $ map Param $ "rsh" :
|
||||
loginopt ++ rshopts
|
||||
rsh -> error $ "Unknown Rsync transport: "
|
||||
++ unwords rsh
|
||||
| otherwise = return ([], rawurl)
|
||||
where
|
||||
(login,resturl) = case separate (=='@') rawurl of
|
||||
(h, "") -> (Nothing, h)
|
||||
(l, h) -> (Just l, h)
|
||||
(h, "") -> (Nothing, h)
|
||||
(l, h) -> (Just l, h)
|
||||
loginopt = maybe [] (\l -> ["-l",l]) login
|
||||
fromNull as xs | null xs = as
|
||||
| otherwise = xs
|
||||
rsyncTransport = if rsyncUrlIsShell rawurl
|
||||
then (\rsh -> return (rsyncShell rsh, resturl)) =<<
|
||||
case fromNull ["ssh"] (remoteAnnexRsyncTransport gc) of
|
||||
"ssh":sshopts -> do
|
||||
let (port, sshopts') = sshReadPort sshopts
|
||||
host = takeWhile (/=':') resturl
|
||||
-- Connection caching
|
||||
(Param "ssh":) <$> sshCachingOptions
|
||||
(host, port)
|
||||
(map Param $ loginopt ++ sshopts')
|
||||
"rsh":rshopts -> return $ map Param $ "rsh" :
|
||||
loginopt ++ rshopts
|
||||
rsh -> error $ "Unknown Rsync transport: "
|
||||
++ unwords rsh
|
||||
else return ([], rawurl)
|
||||
fromNull as xs = if null xs then as else xs
|
||||
|
||||
rsyncSetup :: Maybe UUID -> RemoteConfig -> Annex (RemoteConfig, UUID)
|
||||
rsyncSetup mu c = do
|
||||
|
|
|
|||
3
debian/changelog
vendored
3
debian/changelog
vendored
|
|
@ -24,6 +24,9 @@ git-annex (4.20130828) UNRELEASED; urgency=low
|
|||
* Remind user when annex-ignore is set for some remotes, if unable to
|
||||
get or drop a file, possibly because it's on an ignored remote.
|
||||
* gpg: Force --no-textmode in case the user has it turned on in config.
|
||||
* Added gcrypt support. This combines a fully encrypted git
|
||||
repository (using git-remote-gcrypt) with an encrypted git-annex special
|
||||
remote.
|
||||
|
||||
-- Joey Hess <joeyh@debian.org> Tue, 27 Aug 2013 11:03:00 -0400
|
||||
|
||||
|
|
|
|||
|
|
@ -21,6 +21,8 @@ gcrypt:
|
|||
for gcrypt to use. This repository should be either empty, or an existing
|
||||
gcrypt repositry.
|
||||
|
||||
* `shellescape` - See [[rsync]] for the details of this option.
|
||||
|
||||
## notes
|
||||
|
||||
For git-annex to store files in a repository on a remote server, you need
|
||||
|
|
|
|||
Loading…
Reference in a new issue