summaryrefslogtreecommitdiff
path: root/Remote/GCrypt.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-09-08 14:54:28 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-09-08 14:54:28 -0400
commit7ea4de429e62a0bc1c0bf8047352405a7ed5737d (patch)
tree171134498dfc150c97574ab01ead75e5a42981c0 /Remote/GCrypt.hs
parent37e41beadce0660d0abcead87de34552d8163417 (diff)
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
Diffstat (limited to 'Remote/GCrypt.hs')
-rw-r--r--Remote/GCrypt.hs101
1 files changed, 61 insertions, 40 deletions
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 396cb367e..2ff137f57 100644
--- a/Remote/GCrypt.hs
+++ b/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