do a cleanup commit after moving data from or to a git remote

Added Annex.cleanup, which is a general purpose interface for adding
actions to run at the end.

Remotes with the old git-annex-shell will commit every time, and have no
commit command, so hide stderr when running the commit command.
This commit is contained in:
Joey Hess 2012-02-25 18:02:49 -04:00
parent a3c9d06a26
commit c3fbe07d7a
5 changed files with 43 additions and 13 deletions

View file

@ -1,6 +1,6 @@
{- Standard git remotes.
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
- Copyright 2011-2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@ -24,6 +24,7 @@ import Logs.Presence
import Annex.UUID
import qualified Annex.Content
import qualified Annex.BranchState
import qualified Annex.Branch
import qualified Utility.Url as Url
import Utility.TempFile
import Config
@ -196,7 +197,7 @@ keyUrls r key = map tourl (annexLocations key)
dropKey :: Git.Repo -> Key -> Annex Bool
dropKey r key
| not $ Git.repoIsUrl r = liftIO $ onLocal r $ do
| not $ Git.repoIsUrl r = commitOnCleanup r $ liftIO $ onLocal r $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContent key $
@ -205,7 +206,7 @@ dropKey r key
Annex.Content.saveState True
return True
| Git.repoIsHttp r = error "dropping from http repo not supported"
| otherwise = onRemote r (boolSystem, False) "dropkey"
| otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey"
[ Params "--quiet --force"
, Param $ show key
]
@ -236,7 +237,7 @@ copyFromRemoteCheap r key file
{- Tries to copy a key's content to a remote's annex. -}
copyToRemote :: Git.Repo -> Key -> Annex Bool
copyToRemote r key
| not $ Git.repoIsUrl r = do
| not $ Git.repoIsUrl r = commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
params <- rsyncParams r
-- run copy from perspective of remote
@ -245,7 +246,7 @@ copyToRemote r key
Annex.Content.saveState True `after`
Annex.Content.getViaTmp key
(rsyncOrCopyFile params keysrc)
| Git.repoIsSsh r = do
| Git.repoIsSsh r = commitOnCleanup r $ do
keysrc <- inRepo $ gitAnnexLocation key
rsyncHelper =<< rsyncParamsRemote r False key keysrc
| otherwise = error "copying to non-ssh repo not supported"
@ -301,3 +302,23 @@ rsyncParams r = do
where
-- --inplace to resume partial files
options = [Params "-p --progress --inplace"]
commitOnCleanup :: Git.Repo -> Annex a -> Annex a
commitOnCleanup r a = go `after` a
where
go = Annex.addCleanup (Git.repoLocation r) cleanup
cleanup
| not $ Git.repoIsUrl r = liftIO $ onLocal r $
Annex.Branch.commit "update"
| otherwise = do
Just (shellcmd, shellparams) <-
git_annex_shell r "commit" []
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to
-- support committing.
let cmd = shellcmd ++ " "
++ unwords (map shellEscape $ toCommand shellparams)
++ ">/dev/null 2>/dev/null"
_ <- liftIO $
boolSystem "sh" [Param "-c", Param cmd]
return ()