convert bup to new ChunkedEncryptable API (but do not support chunking)
bup already splits files and does rolling deltas, so there is no reason to use chunking here. The new API made it easier to add progress support for storeKey, so that's done. Unfortunately, bup-split still outputs its own progress with -q, so a little ugly, but not too bad. Made dropping remove the branch for an object, for two reasons: 1. The new API calls removeKey to roll back a storeKey when the content changed unexpectedly. 2. So that testremote will be happy. Also, fixed a bug that caused a crash when removing the branch for an object in rollback.
This commit is contained in:
parent
0c7c39840d
commit
b261df735d
3 changed files with 38 additions and 62 deletions
|
@ -1,15 +1,13 @@
|
|||
{- Using bup as a remote.
|
||||
-
|
||||
- Copyright 2011 Joey Hess <joey@kitenet.net>
|
||||
- Copyright 2011-2014 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Remote.Bup (remote) where
|
||||
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
import qualified Data.Map as M
|
||||
import System.Process
|
||||
import Data.ByteString.Lazy.UTF8 (fromString)
|
||||
|
||||
import Common.Annex
|
||||
|
@ -26,12 +24,10 @@ import Config
|
|||
import Config.Cost
|
||||
import qualified Remote.Helper.Ssh as Ssh
|
||||
import Remote.Helper.Special
|
||||
import Remote.Helper.Encryptable
|
||||
import Remote.Helper.ChunkedEncryptable
|
||||
import Remote.Helper.Messages
|
||||
import Crypto
|
||||
import Utility.Hash
|
||||
import Utility.UserInfo
|
||||
import Annex.Content
|
||||
import Annex.UUID
|
||||
import Utility.Metered
|
||||
|
||||
|
@ -54,14 +50,14 @@ gen r u c gc = do
|
|||
else expensiveRemoteCost
|
||||
(u', bupr') <- getBupUUID bupr u
|
||||
|
||||
let new = Remote
|
||||
let this = Remote
|
||||
{ uuid = u'
|
||||
, cost = cst
|
||||
, name = Git.repoDescribe r
|
||||
, storeKey = store new buprepo
|
||||
, retrieveKeyFile = retrieve buprepo
|
||||
, storeKey = storeKeyDummy
|
||||
, retrieveKeyFile = retreiveKeyFileDummy
|
||||
, retrieveKeyFileCheap = retrieveCheap buprepo
|
||||
, removeKey = remove
|
||||
, removeKey = remove buprepo
|
||||
, hasKey = checkPresent r bupr'
|
||||
, hasKeyCheap = bupLocal buprepo
|
||||
, whereisKey = Nothing
|
||||
|
@ -78,9 +74,9 @@ gen r u c gc = do
|
|||
, readonly = False
|
||||
}
|
||||
return $ Just $ encryptableRemote c
|
||||
(storeEncrypted new buprepo)
|
||||
(retrieveEncrypted buprepo)
|
||||
new
|
||||
(simplyPrepare $ store this buprepo)
|
||||
(simplyPrepare $ retrieve buprepo)
|
||||
this
|
||||
where
|
||||
buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
|
||||
|
||||
|
@ -115,72 +111,49 @@ bup command buprepo params = do
|
|||
showOutput -- make way for bup output
|
||||
liftIO $ boolSystem "bup" $ bupParams command buprepo params
|
||||
|
||||
pipeBup :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool
|
||||
pipeBup params inh outh = do
|
||||
p <- runProcess "bup" (toCommand params)
|
||||
Nothing Nothing inh outh Nothing
|
||||
ok <- waitForProcess p
|
||||
case ok of
|
||||
ExitSuccess -> return True
|
||||
_ -> return False
|
||||
|
||||
bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam]
|
||||
bupSplitParams r buprepo k src = do
|
||||
let os = map Param $ remoteAnnexBupSplitOptions $ gitconfig r
|
||||
showOutput -- make way for bup output
|
||||
return $ bupParams "split" buprepo
|
||||
(os ++ [Param "-n", Param (bupRef k)] ++ src)
|
||||
(os ++ [Param "-q", Param "-n", Param (bupRef k)] ++ src)
|
||||
|
||||
store :: Remote -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
|
||||
store r buprepo k _f _p = sendAnnex k (rollback k buprepo) $ \src -> do
|
||||
params <- bupSplitParams r buprepo k [File src]
|
||||
liftIO $ boolSystem "bup" params
|
||||
store :: Remote -> BupRepo -> Storer
|
||||
store r buprepo = byteStorer $ \k b p -> do
|
||||
params <- bupSplitParams r buprepo k []
|
||||
let cmd = proc "bup" (toCommand params)
|
||||
liftIO $ withHandle StdinHandle createProcessSuccess cmd $ \h -> do
|
||||
meteredWrite p h b
|
||||
return True
|
||||
|
||||
storeEncrypted :: Remote -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
|
||||
storeEncrypted r buprepo (cipher, enck) k _p =
|
||||
sendAnnex k (rollback enck buprepo) $ \src -> do
|
||||
params <- bupSplitParams r buprepo enck []
|
||||
liftIO $ catchBoolIO $
|
||||
encrypt (getGpgEncParams r) cipher (feedFile src) $ \h ->
|
||||
pipeBup params (Just h) Nothing
|
||||
|
||||
retrieve :: BupRepo -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> Annex Bool
|
||||
retrieve buprepo k _f d _p = do
|
||||
let params = bupParams "join" buprepo [Param $ bupRef k]
|
||||
liftIO $ catchBoolIO $ withFile d WriteMode $
|
||||
pipeBup params Nothing . Just
|
||||
retrieve :: BupRepo -> Retriever
|
||||
retrieve buprepo = fileRetriever $ \d k _p ->
|
||||
liftIO $ withFile d WriteMode $ \h -> do
|
||||
let params = bupParams "join" buprepo [Param $ bupRef k]
|
||||
let p = proc "bup" (toCommand params)
|
||||
(_, _, _, pid) <- createProcess $ p { std_out = UseHandle h }
|
||||
forceSuccessProcess p pid
|
||||
|
||||
retrieveCheap :: BupRepo -> Key -> FilePath -> Annex Bool
|
||||
retrieveCheap _ _ _ = return False
|
||||
|
||||
retrieveEncrypted :: BupRepo -> (Cipher, Key) -> Key -> FilePath -> MeterUpdate -> Annex Bool
|
||||
retrieveEncrypted buprepo (cipher, enck) _ f _p = liftIO $ catchBoolIO $
|
||||
withHandle StdoutHandle createProcessSuccess p $ \h -> do
|
||||
decrypt cipher (\toh -> L.hPut toh =<< L.hGetContents h) $
|
||||
readBytes $ L.writeFile f
|
||||
return True
|
||||
where
|
||||
params = bupParams "join" buprepo [Param $ bupRef enck]
|
||||
p = proc "bup" $ toCommand params
|
||||
|
||||
remove :: Key -> Annex Bool
|
||||
remove _ = do
|
||||
warning "content cannot be removed from bup remote"
|
||||
return False
|
||||
|
||||
{- Cannot revert having stored a key in bup, but at least the data for the
|
||||
- key will be used for deltaing data of other keys stored later.
|
||||
-
|
||||
- We can, however, remove the git branch that bup created for the key.
|
||||
-}
|
||||
rollback :: Key -> BupRepo -> Annex ()
|
||||
rollback k bupr = go =<< liftIO (bup2GitRemote bupr)
|
||||
remove :: BupRepo -> Key -> Annex Bool
|
||||
remove buprepo k = do
|
||||
go =<< liftIO (bup2GitRemote buprepo)
|
||||
warning "content cannot be completely removed from bup remote"
|
||||
return True
|
||||
where
|
||||
go r
|
||||
| Git.repoIsUrl r = void $ onBupRemote r boolSystem "git" params
|
||||
| otherwise = void $ liftIO $ catchMaybeIO $
|
||||
boolSystem "git" $ Git.Command.gitCommandLine params r
|
||||
params = [ Params "branch -D", Param (bupRef k) ]
|
||||
| otherwise = void $ liftIO $ catchMaybeIO $ do
|
||||
r' <- Git.Config.read r
|
||||
boolSystem "git" $ Git.Command.gitCommandLine params r'
|
||||
params = [ Params "branch -q -D", Param (bupRef k) ]
|
||||
|
||||
{- Bup does not provide a way to tell if a given dataset is present
|
||||
- in a bup repository. One way it to check if the git repository has
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue