finish making rsync support chunking

This breaks gcrypt, which relies on some internals of the rsync remote.
To fix next..
This commit is contained in:
Joey Hess 2014-08-03 16:54:57 -04:00
parent 6c450aad1d
commit f5f961215b
3 changed files with 37 additions and 38 deletions

View file

@ -22,6 +22,7 @@ module Crypto (
describeCipher, describeCipher,
decryptCipher, decryptCipher,
encryptKey, encryptKey,
isEncKey,
feedFile, feedFile,
feedBytes, feedBytes,
readBytes, readBytes,
@ -150,9 +151,15 @@ type EncKey = Key -> Key
encryptKey :: Mac -> Cipher -> EncKey encryptKey :: Mac -> Cipher -> EncKey
encryptKey mac c k = stubKey encryptKey mac c k = stubKey
{ keyName = macWithCipher mac c (key2file k) { keyName = macWithCipher mac c (key2file k)
, keyBackendName = "GPG" ++ showMac mac , keyBackendName = encryptedBackendNamePrefix ++ showMac mac
} }
encryptedBackendNamePrefix :: String
encryptedBackendNamePrefix = "GPG"
isEncKey :: Key -> Bool
isEncKey k = encryptedBackendNamePrefix `isPrefixOf` keyBackendName k
type Feeder = Handle -> IO () type Feeder = Handle -> IO ()
type Reader m a = Handle -> m a type Reader m a = Handle -> m a

View file

@ -299,7 +299,7 @@ store r rsyncopts (cipher, enck) k p
| otherwise = unsupportedUrl | otherwise = unsupportedUrl
where where
gpgopts = getGpgEncParams r gpgopts = getGpgEncParams r
storersync = Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p storersync = undefined -- Remote.Rsync.storeEncrypted rsyncopts gpgopts (cipher, enck) k p
storeshell = withTmp enck $ \tmp -> storeshell = withTmp enck $ \tmp ->
ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True) ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True)
( Ssh.rsyncHelper (Just p) ( Ssh.rsyncHelper (Just p)
@ -323,7 +323,7 @@ retrieve r rsyncopts (cipher, enck) k d p
a >>= \b -> a >>= \b ->
decrypt cipher (feedBytes b) decrypt cipher (feedBytes b)
(readBytes $ meteredWriteFile meterupdate d) (readBytes $ meteredWriteFile meterupdate d)
retrieversync = Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p retrieversync = undefined -- Remote.Rsync.retrieveEncrypted rsyncopts (cipher, enck) k d p
retrieveshell = withTmp enck $ \tmp -> retrieveshell = withTmp enck $ \tmp ->
ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing) ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing)
( liftIO $ catchBoolIO $ do ( liftIO $ catchBoolIO $ do

View file

@ -9,8 +9,6 @@
module Remote.Rsync ( module Remote.Rsync (
remote, remote,
storeEncrypted,
retrieveEncrypted,
remove, remove,
checkPresent, checkPresent,
withRsyncScratchDir, withRsyncScratchDir,
@ -27,7 +25,6 @@ import Annex.Content
import Annex.UUID import Annex.UUID
import Annex.Ssh import Annex.Ssh
import Remote.Helper.Special import Remote.Helper.Special
import Remote.Helper.Encryptable
import Remote.Rsync.RsyncUrl import Remote.Rsync.RsyncUrl
import Crypto import Crypto
import Utility.Rsync import Utility.Rsync
@ -37,8 +34,8 @@ import Utility.PID
import Annex.Perms import Annex.Perms
import Logs.Transfer import Logs.Transfer
import Types.Creds import Types.Creds
import Types.Key (isChunkKey)
import qualified Data.ByteString.Lazy as L
import qualified Data.Map as M import qualified Data.Map as M
remote :: RemoteType remote :: RemoteType
@ -56,15 +53,15 @@ gen r u c gc = do
fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
let o = genRsyncOpts c gc transport url let o = genRsyncOpts c gc transport url
let islocal = rsyncUrlIsPath $ rsyncUrl o let islocal = rsyncUrlIsPath $ rsyncUrl o
return $ Just $ encryptableRemote c return $ Just $ specialRemote' specialcfg c
(storeEncrypted o $ getGpgEncParams (c,gc)) (simplyPrepare $ store o)
(retrieveEncrypted o) (simplyPrepare $ retrieve o)
Remote Remote
{ uuid = u { uuid = u
, cost = cst , cost = cst
, name = Git.repoDescribe r , name = Git.repoDescribe r
, storeKey = store o , storeKey = storeKeyDummy
, retrieveKeyFile = retrieve o , retrieveKeyFile = retreiveKeyFileDummy
, retrieveKeyFileCheap = retrieveCheap o , retrieveKeyFileCheap = retrieveCheap o
, removeKey = remove o , removeKey = remove o
, hasKey = checkPresent r o , hasKey = checkPresent r o
@ -82,6 +79,10 @@ gen r u c gc = do
, availability = if islocal then LocallyAvailable else GloballyAvailable , availability = if islocal then LocallyAvailable else GloballyAvailable
, remotetype = remote , remotetype = remote
} }
where
specialcfg = (specialRemoteCfg c)
-- Rsync displays its own progress.
{ displayProgress = False }
genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts genRsyncOpts :: RemoteConfig -> RemoteGitConfig -> [CommandParam] -> RsyncUrl -> RsyncOpts
genRsyncOpts c gc transport url = RsyncOpts genRsyncOpts c gc transport url = RsyncOpts
@ -139,32 +140,17 @@ rsyncSetup mu _ c = do
gitConfigSpecialRemote u c' "rsyncurl" url gitConfigSpecialRemote u c' "rsyncurl" url
return (c', u) return (c', u)
store :: RsyncOpts -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool store :: RsyncOpts -> Storer
store o k _f p = sendAnnex k (void $ remove o k) $ rsyncSend o p k False store = fileStorer . rsyncSend
storeEncrypted :: RsyncOpts -> [CommandParam] -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool retrieve :: RsyncOpts -> Retriever
storeEncrypted o gpgOpts (cipher, enck) k p = withTmp enck $ \tmp -> retrieve o = fileRetriever $ \f k p ->
sendAnnex k (void $ remove o enck) $ \src -> do unlessM (rsyncRetrieve o k f (Just p)) $
liftIO $ encrypt gpgOpts cipher (feedFile src) $ error "rsync failed"
readBytes $ L.writeFile tmp
rsyncSend o p enck True tmp
retrieve :: RsyncOpts -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
retrieve o k _ f p = rsyncRetrieve o k f (Just p)
retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool retrieveCheap :: RsyncOpts -> Key -> FilePath -> Annex Bool
retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False ) retrieveCheap o k f = ifM (preseedTmp k f) ( rsyncRetrieve o k f Nothing , return False )
retrieveEncrypted :: RsyncOpts -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
retrieveEncrypted o (cipher, enck) _ f p = withTmp enck $ \tmp ->
ifM (rsyncRetrieve o enck tmp (Just p))
( liftIO $ catchBoolIO $ do
decrypt cipher (feedFile tmp) $
readBytes $ L.writeFile f
return True
, return False
)
remove :: RsyncOpts -> Key -> Annex Bool remove :: RsyncOpts -> Key -> Annex Bool
remove o k = do remove o k = do
ps <- sendParams ps <- sendParams
@ -238,8 +224,8 @@ withRsyncScratchDir a = do
removeDirectoryRecursive d removeDirectoryRecursive d
rsyncRetrieve :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool rsyncRetrieve :: RsyncOpts -> Key -> FilePath -> Maybe MeterUpdate -> Annex Bool
rsyncRetrieve o k dest callback = rsyncRetrieve o k dest meterupdate =
showResumable $ untilTrue (rsyncUrls o k) $ \u -> rsyncRemote Download o callback showResumable $ untilTrue (rsyncUrls o k) $ \u -> rsyncRemote Download o meterupdate
-- use inplace when retrieving to support resuming -- use inplace when retrieving to support resuming
[ Param "--inplace" [ Param "--inplace"
, Param u , Param u
@ -274,8 +260,8 @@ rsyncRemote direction o callback params = do
- (When we have the right hash directory structure, we can just - (When we have the right hash directory structure, we can just
- pass --include=X --include=X/Y --include=X/Y/file --exclude=*) - pass --include=X --include=X/Y --include=X/Y/file --exclude=*)
-} -}
rsyncSend :: RsyncOpts -> MeterUpdate -> Key -> Bool -> FilePath -> Annex Bool rsyncSend :: RsyncOpts -> Key -> FilePath -> MeterUpdate -> Annex Bool
rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do rsyncSend o k src meterupdate = withRsyncScratchDir $ \tmp -> do
let dest = tmp </> Prelude.head (keyPaths k) let dest = tmp </> Prelude.head (keyPaths k)
liftIO $ createDirectoryIfMissing True $ parentDir dest liftIO $ createDirectoryIfMissing True $ parentDir dest
ok <- liftIO $ if canrename ok <- liftIO $ if canrename
@ -285,7 +271,7 @@ rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do
else createLinkOrCopy src dest else createLinkOrCopy src dest
ps <- sendParams ps <- sendParams
if ok if ok
then showResumable $ rsyncRemote Upload o (Just callback) $ ps ++ then showResumable $ rsyncRemote Upload o (Just meterupdate) $ ps ++
[ Param "--recursive" [ Param "--recursive"
, partialParams , partialParams
-- tmp/ to send contents of tmp dir -- tmp/ to send contents of tmp dir
@ -293,3 +279,9 @@ rsyncSend o callback k canrename src = withRsyncScratchDir $ \tmp -> do
, Param $ rsyncUrl o , Param $ rsyncUrl o
] ]
else return False else return False
where
{- If the key being sent is encrypted or chunked, the file
- containing its content is a temp file, and so can be
- renamed into place. Otherwise, the file is the annexed
- object file, and has to be copied or hard linked into place. -}
canrename = isEncKey k || isChunkKey k