diff --git a/Remote.hs b/Remote.hs index 26097da747..bb661c5a90 100644 --- a/Remote.hs +++ b/Remote.hs @@ -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 ] diff --git a/Remote/Bup.hs b/Remote/Bup.hs new file mode 100644 index 0000000000..ef34e2c635 --- /dev/null +++ b/Remote/Bup.hs @@ -0,0 +1,133 @@ +{- Using bup as a remote. + - + - Copyright 2011 Joey Hess + - + - 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 diff --git a/configure.hs b/configure.hs index d340f937d4..4ab3052395 100644 --- a/configure.hs +++ b/configure.hs @@ -15,6 +15,7 @@ tests = , TestCase "xargs -0" $ requireCmd "xargs_0" "xargs -0 /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] diff --git a/debian/changelog b/debian/changelog index 7f104be101..91c0c8f4b3 100644 --- a/debian/changelog +++ b/debian/changelog @@ -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 diff --git a/debian/control b/debian/control index 37e6220437..15155b9b43 100644 --- a/debian/control +++ b/debian/control @@ -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 diff --git a/doc/walkthrough/using_bup.mdwn b/doc/walkthrough/using_bup.mdwn index 1a506c2811..7e1562d12e 100644 --- a/doc/walkthrough/using_bup.mdwn +++ b/doc/walkthrough/using_bup.mdwn @@ -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.