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,
decryptCipher,
encryptKey,
isEncKey,
feedFile,
feedBytes,
readBytes,
@ -150,9 +151,15 @@ type EncKey = Key -> Key
encryptKey :: Mac -> Cipher -> EncKey
encryptKey mac c k = stubKey
{ 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 Reader m a = Handle -> m a

View file

@ -299,7 +299,7 @@ store r rsyncopts (cipher, enck) k p
| otherwise = unsupportedUrl
where
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 ->
ifM (spoolencrypted $ readBytes $ \b -> catchBoolIO $ L.writeFile tmp b >> return True)
( Ssh.rsyncHelper (Just p)
@ -323,7 +323,7 @@ retrieve r rsyncopts (cipher, enck) k d p
a >>= \b ->
decrypt cipher (feedBytes b)
(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 ->
ifM (Ssh.rsyncHelper (Just p) =<< Ssh.rsyncParamsRemote False r Download enck tmp Nothing)
( liftIO $ catchBoolIO $ do

View file

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