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:
Joey Hess 2014-08-02 18:36:26 -04:00
parent 0c7c39840d
commit b261df735d
3 changed files with 38 additions and 62 deletions

View file

@ -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