diff options
| -rw-r--r-- | Annex.hs | 12 | ||||
| -rw-r--r-- | CmdLine.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 31 | ||||
| -rw-r--r-- | debian/changelog | 8 | ||||
| -rw-r--r-- | doc/bugs/copy_doesn__39__t_scale.mdwn | 3 |
5 files changed, 43 insertions, 13 deletions
@@ -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]] |