diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Bup.hs | 93 |
1 files changed, 33 insertions, 60 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 778832850..06679c4b8 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -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) - -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 + (os ++ [Param "-q", Param "-n", Param (bupRef k)] ++ src) -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 +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 -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 |