summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex.hs12
-rw-r--r--CmdLine.hs2
-rw-r--r--Remote/Git.hs31
-rw-r--r--debian/changelog8
-rw-r--r--doc/bugs/copy_doesn__39__t_scale.mdwn3
5 files changed, 43 insertions, 13 deletions
diff --git a/Annex.hs b/Annex.hs
index 123c9facf..ef95ff174 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -21,6 +21,7 @@ module Annex (
setField,
getFlag,
getField,
+ addCleanup,
gitRepo,
inRepo,
fromRepo,
@@ -93,6 +94,7 @@ data AnnexState = AnnexState
, lockpool :: M.Map FilePath Fd
, flags :: M.Map String Bool
, fields :: M.Map String String
+ , cleanup :: M.Map String (Annex ())
}
newState :: Git.Repo -> AnnexState
@@ -117,6 +119,7 @@ newState gitrepo = AnnexState
, lockpool = M.empty
, flags = M.empty
, fields = M.empty
+ , cleanup = M.empty
}
{- Create and returns an Annex state object for the specified git repo. -}
@@ -132,12 +135,17 @@ eval s a = evalStateT (runAnnex a) s
{- Sets a flag to True -}
setFlag :: String -> Annex ()
setFlag flag = changeState $ \s ->
- s { flags = M.insert flag True $ flags s }
+ s { flags = M.insertWith' const flag True $ flags s }
{- Sets a field to a value -}
setField :: String -> String -> Annex ()
setField field value = changeState $ \s ->
- s { fields = M.insert field value $ fields s }
+ s { fields = M.insertWith' const field value $ fields s }
+
+{- Adds a cleanup action to perform. -}
+addCleanup :: String -> Annex () -> Annex ()
+addCleanup uid a = changeState $ \s ->
+ s { cleanup = M.insertWith' const uid a $ cleanup s }
{- Checks if a flag was set. -}
getFlag :: String -> Annex Bool
diff --git a/CmdLine.hs b/CmdLine.hs
index fbc1eaeca..05f7bfe2e 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -12,6 +12,7 @@ module CmdLine (
) where
import qualified Control.Exception as E
+import qualified Data.Map as M
import Control.Exception (throw)
import System.Console.GetOpt
@@ -95,6 +96,7 @@ startup = return True
shutdown :: Bool -> Annex Bool
shutdown oneshot = do
saveState oneshot
+ sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
liftIO Git.Command.reap -- zombies from long-running git processes
sshCleanup -- ssh connection caching
return True
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 ()
diff --git a/debian/changelog b/debian/changelog
index bb838ed60..9436d2e6d 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -29,12 +29,8 @@ git-annex (3.20120124) UNRELEASED; urgency=low
* Store web special remote url info in a more efficient location.
* Deal with NFS problem that caused a failure to remove a directory
when removing content from the annex.
- * Avoid repeated location log commits when a remote is receiving files.
- Done by adding a oneshot mode, in which location log changes are
- written to the journal, but not committed. Taking advantage of
- git-annex's existing ability to recover in this situation. This is
- used by git-annex-shell and other places where changes are made to
- a remote's location log.
+ * Make a single location log commit after a remote has received or
+ dropped files. Uses a new "git-annex-shell commit" command.
* To avoid commits of data to the git-annex branch after each command
is run, set annex.alwayscommit=false. Its data will then be committed
less frequently, when a merge or sync is done.
diff --git a/doc/bugs/copy_doesn__39__t_scale.mdwn b/doc/bugs/copy_doesn__39__t_scale.mdwn
index adbd0660a..a5ca9d9ee 100644
--- a/doc/bugs/copy_doesn__39__t_scale.mdwn
+++ b/doc/bugs/copy_doesn__39__t_scale.mdwn
@@ -33,3 +33,6 @@ are local. It seems to be just overhead.)
Oneshot mode is now implemented, making git-annex-shell and other
short lifetime processes not bother with committing changes.
[[done]] --[[Joey]]
+
+Update: Now it makes one commit at the very end of such a mass transfer.
+--[[Joey]]