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:
parent
6c450aad1d
commit
f5f961215b
3 changed files with 37 additions and 38 deletions
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue