bup is now supported as a special type of remote.

This commit is contained in:
Joey Hess 2011-04-08 16:44:43 -04:00
parent f3cf20d22a
commit 44c65f40b7
6 changed files with 144 additions and 3 deletions

View file

@ -46,12 +46,14 @@ import Config
import qualified Remote.Git
import qualified Remote.S3
import qualified Remote.Bup
import qualified Remote.Directory
remoteTypes :: [RemoteType Annex]
remoteTypes =
[ Remote.Git.remote
, Remote.S3.remote
, Remote.Bup.remote
, Remote.Directory.remote
]

133
Remote/Bup.hs Normal file
View file

@ -0,0 +1,133 @@
{- Using bup as a remote.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Remote.Bup (remote) where
import IO
import Control.Exception.Extensible (IOException)
import qualified Data.Map as M
import Control.Monad (unless)
import Control.Monad.State (liftIO)
import System.Process
import System.Exit
import RemoteClass
import Types
import qualified GitRepo as Git
import qualified Annex
import UUID
import Locations
import LocationLog
import Config
import Utility
import Messages
import Remote.Special
remote :: RemoteType Annex
remote = RemoteType {
typename = "bup",
enumerate = findSpecialRemotes "bupremote",
generate = gen,
setup = bupSetup
}
gen :: Git.Repo -> UUID -> Maybe (M.Map String String) -> Annex (Remote Annex)
gen r u c = do
cst <- remoteCost r expensiveRemoteCost
bupremote <- getConfig r "bupremote" (error "missing bupremote")
return $ this cst bupremote
where
this cst bupremote = Remote {
uuid = u,
cost = cst,
name = Git.repoDescribe r,
storeKey = store r bupremote,
retrieveKeyFile = retrieve bupremote,
removeKey = remove,
hasKey = checkPresent u,
hasKeyCheap = True,
config = c
}
bupSetup :: UUID -> M.Map String String -> Annex (M.Map String String)
bupSetup u c = do
-- verify configuration is sane
let bupremote = case M.lookup "remote" c of
Nothing -> error "Specify remote="
Just r -> r
case M.lookup "encryption" c of
Nothing -> error "Specify encryption=key or encryption=none"
Just "none" -> return ()
Just _ -> error "encryption keys not yet supported"
-- bup init will create the repository.
-- (If the repository already exists, bup init again appears safe.)
showNote "bup init"
ok <- bup "init" bupremote []
unless ok $ error "bup init failed"
-- The bup remote is stored in git config, as well as this remote's
-- persistant state, so it can vary between hosts.
gitConfigSpecialRemote u c "bupremote" bupremote
return $ M.delete "directory" c
bupParams :: String -> String -> [CommandParam] -> [CommandParam]
bupParams command bupremote params =
(Param command) : [Param "-r", Param bupremote] ++ params
bup :: String -> String -> [CommandParam] -> Annex Bool
bup command bupremote params = do
showProgress -- make way for bup output
liftIO $ boolSystem "bup" $ bupParams command bupremote params
store :: Git.Repo -> String -> Key -> Annex Bool
store r bupremote k = do
g <- Annex.gitRepo
let src = gitAnnexLocation g k
o <- getConfig r "bup-split-options" ""
let os = map Param $ words o
bup "split" bupremote $ os ++ [Param "-n", Param (show k), File src]
retrieve :: String -> Key -> FilePath -> Annex Bool
retrieve bupremote k f = do
let params = bupParams "join" bupremote [Param $ show k]
ret <- liftIO $ try $ do
-- pipe bup's stdout directly to file
tofile <- openFile f WriteMode
p <- runProcess "bup" (toCommand params)
Nothing Nothing Nothing (Just tofile) Nothing
r <- waitForProcess p
case r of
ExitSuccess -> return True
_ -> return False
case ret of
Right r -> return r
Left e -> return False
remove :: Key -> Annex Bool
remove _ = do
warning "content cannot be removed from bup remote"
return False
{- 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
- a branch matching the name (as created by bup split -n).
-
- However, git-annex's ususal reasons for checking if a remote really
- has a key also don't really apply in the case of bup, since, short
- of deleting bup's git repository, data cannot be removed from it.
-
- So, trust git-annex's location log; if it says a bup repository has
- content, assume it's right.
-}
checkPresent :: UUID -> Key -> Annex (Either IOException Bool)
checkPresent u k = do
g <- Annex.gitRepo
liftIO $ try $ do
uuids <- keyLocations g k
return $ u `elem` uuids

View file

@ -15,6 +15,7 @@ tests =
, TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 </dev/null"
, TestCase "rsync" $ requireCmd "rsync" "rsync --version >/dev/null"
, TestCase "curl" $ testCmd "curl" "curl --version >/dev/null"
, TestCase "bup" $ testCmd "bup" "bup --version >/dev/null"
, TestCase "unicode FilePath support" $ unicodeFilePath
] ++ shaTestCases [1, 256, 512, 224, 384]

1
debian/changelog vendored
View file

@ -1,5 +1,6 @@
git-annex (0.20110402) UNRELEASED; urgency=low
* bup is now supported as a special type of remote.
* Use lowercase hash directories for locationlog files, to avoid
some issues with git on OSX with the mixed-case directories.
No migration is needed; the old mixed case hash directories are still

2
debian/control vendored
View file

@ -11,7 +11,7 @@ Package: git-annex
Architecture: any
Section: utils
Depends: ${misc:Depends}, ${shlibs:Depends}, git | git-core, uuid, openssh-client, rsync
Suggests: graphviz
Suggests: graphviz, bup
Description: manage files with git, without checking their contents into git
git-annex allows managing files with git, without checking the file
contents into git. While that may seem paradoxical, it is useful when

View file

@ -6,13 +6,17 @@ git-annex, you can have git on both the frontend and the backend.
Here's how to create a bup remote, and describe it.
# git annex initremote mybup type=bup encryption=none remote=example.com/big/mybup
initremote bup (init) ok
initremote bup (bup init)
Initialized empty Git repository in /big/mybup/
ok
# git annex describe mybup "my bup repository at example.com"
describe mybup ok
Now the remote can be used like any other remote.
# git annex move my_cool_big_file --to mybup
move my_cool_big_file (to mybup...) ok
move my_cool_big_file (to mybup...)
Receiving index from server: 1100/1100, done.
ok
See [[special_remotes/bup]] for details.