incomplete and buggy encryption support for bup
Some kind of laziness issue that I don't want to debug right now, and decryption is not implemented.
This commit is contained in:
parent
991efddfa1
commit
480cc353c4
1 changed files with 36 additions and 7 deletions
|
@ -7,6 +7,7 @@
|
||||||
|
|
||||||
module Remote.Bup (remote) where
|
module Remote.Bup (remote) where
|
||||||
|
|
||||||
|
import qualified Data.ByteString.Lazy.Char8 as L
|
||||||
import IO
|
import IO
|
||||||
import Control.Exception.Extensible (IOException)
|
import Control.Exception.Extensible (IOException)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
@ -16,6 +17,7 @@ import System.Process
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import Data.List.Utils
|
import Data.List.Utils
|
||||||
|
import System.Cmd.Utils
|
||||||
|
|
||||||
import RemoteClass
|
import RemoteClass
|
||||||
import Types
|
import Types
|
||||||
|
@ -29,6 +31,7 @@ import Messages
|
||||||
import Ssh
|
import Ssh
|
||||||
import Remote.Special
|
import Remote.Special
|
||||||
import Remote.Encrypted
|
import Remote.Encrypted
|
||||||
|
import Crypto
|
||||||
|
|
||||||
type BupRepo = String
|
type BupRepo = String
|
||||||
|
|
||||||
|
@ -47,16 +50,17 @@ gen r u c = do
|
||||||
bupr <- liftIO $ bup2GitRemote buprepo
|
bupr <- liftIO $ bup2GitRemote buprepo
|
||||||
(u', bupr') <- getBupUUID bupr u
|
(u', bupr') <- getBupUUID bupr u
|
||||||
|
|
||||||
return $ this cst buprepo u' bupr'
|
return $ encryptedRemote c
|
||||||
where
|
(storeEncrypted r buprepo)
|
||||||
this cst buprepo u' bupr = Remote {
|
(retrieveEncrypted buprepo)
|
||||||
|
Remote {
|
||||||
uuid = u',
|
uuid = u',
|
||||||
cost = cst,
|
cost = cst,
|
||||||
name = Git.repoDescribe r,
|
name = Git.repoDescribe r,
|
||||||
storeKey = store r buprepo,
|
storeKey = store r buprepo,
|
||||||
retrieveKeyFile = retrieve buprepo,
|
retrieveKeyFile = retrieve buprepo,
|
||||||
removeKey = remove,
|
removeKey = remove,
|
||||||
hasKey = checkPresent r bupr,
|
hasKey = checkPresent r bupr',
|
||||||
hasKeyCheap = True,
|
hasKeyCheap = True,
|
||||||
config = c
|
config = c
|
||||||
}
|
}
|
||||||
|
@ -92,13 +96,34 @@ bup command buprepo params = do
|
||||||
showProgress -- make way for bup output
|
showProgress -- make way for bup output
|
||||||
liftIO $ boolSystem "bup" $ bupParams command buprepo params
|
liftIO $ boolSystem "bup" $ bupParams command buprepo params
|
||||||
|
|
||||||
|
bupSplitParams :: Git.Repo -> BupRepo -> Key -> CommandParam -> Annex [CommandParam]
|
||||||
|
bupSplitParams r buprepo k src = do
|
||||||
|
o <- getConfig r "bup-split-options" ""
|
||||||
|
let os = map Param $ words o
|
||||||
|
showProgress -- make way for bup output
|
||||||
|
return $ bupParams "split" buprepo
|
||||||
|
(os ++ [Param "-n", Param (show k), src])
|
||||||
|
|
||||||
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
|
store :: Git.Repo -> BupRepo -> Key -> Annex Bool
|
||||||
store r buprepo k = do
|
store r buprepo k = do
|
||||||
g <- Annex.gitRepo
|
g <- Annex.gitRepo
|
||||||
let src = gitAnnexLocation g k
|
let src = gitAnnexLocation g k
|
||||||
o <- getConfig r "bup-split-options" ""
|
params <- bupSplitParams r buprepo k (File src)
|
||||||
let os = map Param $ words o
|
liftIO $ boolSystem "bup" params
|
||||||
bup "split" buprepo $ os ++ [Param "-n", Param (show k), File src]
|
|
||||||
|
storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> Annex Bool
|
||||||
|
storeEncrypted r buprepo (cipher, enck) k = do
|
||||||
|
g <- Annex.gitRepo
|
||||||
|
let src = gitAnnexLocation g k
|
||||||
|
params <- bupSplitParams r buprepo enck (Param "-")
|
||||||
|
liftIO $ flip catch (const $ return False) $ do
|
||||||
|
content <- L.readFile src
|
||||||
|
-- FIXME hangs after a while
|
||||||
|
(pid, h) <- hPipeTo "bup" (toCommand params)
|
||||||
|
withEncryptedContent cipher content $ L.hPut h
|
||||||
|
hClose h
|
||||||
|
forceSuccess pid
|
||||||
|
return True
|
||||||
|
|
||||||
retrieve :: BupRepo -> Key -> FilePath -> Annex Bool
|
retrieve :: BupRepo -> Key -> FilePath -> Annex Bool
|
||||||
retrieve buprepo k f = do
|
retrieve buprepo k f = do
|
||||||
|
@ -116,6 +141,10 @@ retrieve buprepo k f = do
|
||||||
Right r -> return r
|
Right r -> return r
|
||||||
Left _ -> return False
|
Left _ -> return False
|
||||||
|
|
||||||
|
retrieveEncrypted :: BupRepo -> (Cipher, Key) -> FilePath -> Annex Bool
|
||||||
|
retrieveEncrypted bupreoo (cipher, enck) f = do
|
||||||
|
error "TODO"
|
||||||
|
|
||||||
remove :: Key -> Annex Bool
|
remove :: Key -> Annex Bool
|
||||||
remove _ = do
|
remove _ = do
|
||||||
warning "content cannot be removed from bup remote"
|
warning "content cannot be removed from bup remote"
|
||||||
|
|
Loading…
Reference in a new issue