summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-02-25 18:02:49 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-02-25 18:02:49 -0400
commitc3fbe07d7ad03944d0967ebfa2b8f65cbc2ad5dc (patch)
treef5c1d22fdc51b597cb291bfe689e4514b0e5610a /Remote
parenta3c9d06a265b2d6d3003af805b8345e4ddd3d87c (diff)
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.
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Git.hs31
1 files changed, 26 insertions, 5 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs
index c07ae3237..29c50e87f 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -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 ()