diff options
| -rw-r--r-- | Annex/Content.hs | 13 | ||||
| -rw-r--r-- | CmdLine.hs | 12 | ||||
| -rw-r--r-- | Command/RecvKey.hs | 4 | ||||
| -rw-r--r-- | Command/Uninit.hs | 2 | ||||
| -rw-r--r-- | GitAnnex.hs | 2 | ||||
| -rw-r--r-- | Remote/Bup.hs | 15 | ||||
| -rw-r--r-- | Remote/Git.hs | 11 | ||||
| -rw-r--r-- | Upgrade/V2.hs | 2 | ||||
| -rw-r--r-- | debian/changelog | 6 | ||||
| -rw-r--r-- | git-annex-shell.hs | 2 |
10 files changed, 38 insertions, 31 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index c21ac405e..dcfd43866 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -291,11 +291,16 @@ getKeysPresent' dir = do let files = concat contents return $ mapMaybe (fileKey . takeFileName) files -{- Things to do to record changes to content. -} -saveState :: Annex () -saveState = do +{- Things to do to record changes to content when shutting down. + - + - It's acceptable to avoid committing changes to the branch, + - especially if performing a short-lived action. + -} +saveState :: Bool -> Annex () +saveState oneshot = do Annex.Queue.flush False - Annex.Branch.commit "update" + unless oneshot $ + Annex.Branch.commit "update" {- Downloads content from any of a list of urls. -} downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool diff --git a/CmdLine.hs b/CmdLine.hs index 29b95d01b..61e6c26bb 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -29,8 +29,8 @@ type Params = [String] type Flags = [Annex ()] {- Runs the passed command line. -} -dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO () -dispatch args cmds commonoptions header getgitrepo = do +dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO () +dispatch oneshot args cmds commonoptions header getgitrepo = do setupConsole r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo) case r of @@ -40,7 +40,7 @@ dispatch args cmds commonoptions header getgitrepo = do (actions, state') <- Annex.run state $ do sequence_ flags prepCommand cmd params - tryRun state' cmd $ [startup] ++ actions ++ [shutdown] + tryRun state' cmd $ [startup] ++ actions ++ [shutdown oneshot] where (flags, cmd, params) = parseCmd args cmds commonoptions header @@ -89,9 +89,9 @@ startup :: Annex Bool startup = return True {- Cleanup actions. -} -shutdown :: Annex Bool -shutdown = do - saveState +shutdown :: Bool -> Annex Bool +shutdown oneshot = do + saveState oneshot liftIO Git.Command.reap -- zombies from long-running git processes sshCleanup -- ssh connection caching return True diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 5243fa9d4..a27a5efdf 100644 --- a/Command/RecvKey.hs +++ b/Command/RecvKey.hs @@ -28,7 +28,7 @@ start key = do if ok then do -- forcibly quit after receiving one key, - -- and shutdown cleanly so queued git commands run - _ <- shutdown + -- and shutdown cleanly + _ <- shutdown True liftIO exitSuccess else liftIO exitFailure diff --git a/Command/Uninit.hs b/Command/Uninit.hs index cef89a5cf..ec6d0abf3 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -57,7 +57,7 @@ cleanup = do mapM_ removeAnnex =<< getKeysPresent liftIO $ removeDirectoryRecursive annexdir -- avoid normal shutdown - saveState + saveState False inRepo $ Git.Command.run "branch" [Param "-D", Param $ show Annex.Branch.name] liftIO exitSuccess diff --git a/GitAnnex.hs b/GitAnnex.hs index 4af10a9ce..1ca89315a 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -129,4 +129,4 @@ header :: String header = "Usage: git-annex command [option ..]" run :: [String] -> IO () -run args = dispatch args cmds options header Git.Construct.fromCurrent +run args = dispatch False args cmds options header Git.Construct.fromCurrent diff --git a/Remote/Bup.hs b/Remote/Bup.hs index 583358f24..9b54d8c85 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -11,8 +11,6 @@ import qualified Data.ByteString.Lazy.Char8 as L import System.IO.Error import qualified Data.Map as M import System.Process -import System.Posix.Env (getEnvironment) -import System.Path (brackettmpdir) import Common.Annex import Types.Remote @@ -85,21 +83,10 @@ bupParams :: String -> BupRepo -> [CommandParam] -> [CommandParam] bupParams command buprepo params = Param command : [Param "-r", Param buprepo] ++ params -isLocal :: BupRepo -> Bool -isLocal buprepo = not (elem ':' buprepo) - bup :: String -> BupRepo -> [CommandParam] -> Annex Bool bup command buprepo params = do showOutput -- make way for bup output - liftIO action - where - action | isLocal buprepo = runBup lparams buprepo - | otherwise = brackettmpdir "bupXXXXXX" $ runBup rparams - lparams = Param command : params - rparams = bupParams command buprepo params - runBup params bupdir = do - env <- getEnvironment - boolSystemEnv "bup" params (Just (("BUP_DIR", bupdir) : env)) + liftIO $ boolSystem "bup" $ bupParams command buprepo params pipeBup :: [CommandParam] -> Maybe Handle -> Maybe Handle -> IO Bool pipeBup params inh outh = do diff --git a/Remote/Git.hs b/Remote/Git.hs index efe182961..829ad1ccb 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -20,6 +20,7 @@ import qualified Git.Command import qualified Git.Config import qualified Git.Construct import qualified Annex +import Logs.Presence import Annex.UUID import qualified Annex.Content import qualified Annex.BranchState @@ -192,6 +193,14 @@ keyUrls r key = map tourl (annexLocations key) dropKey :: Git.Repo -> Key -> Annex Bool dropKey r key + | not $ Git.repoIsUrl r = liftIO $ onLocal r $ do + ensureInitialized + whenM (Annex.Content.inAnnex key) $ do + Annex.Content.lockContent key $ + Annex.Content.removeAnnex key + Annex.Content.logStatus key InfoMissing + Annex.Content.saveState True + return True | Git.repoIsHttp r = error "dropping from http repo not supported" | otherwise = onRemote r (boolSystem, False) "dropkey" [ Params "--quiet --force" @@ -230,7 +239,7 @@ copyToRemote r key -- run copy from perspective of remote liftIO $ onLocal r $ do ensureInitialized - Annex.Content.saveState `after` + Annex.Content.saveState True `after` Annex.Content.getViaTmp key (rsyncOrCopyFile params keysrc) | Git.repoIsSsh r = do diff --git a/Upgrade/V2.hs b/Upgrade/V2.hs index ffc2f6002..c57b0bf68 100644 --- a/Upgrade/V2.hs +++ b/Upgrade/V2.hs @@ -50,7 +50,7 @@ upgrade = do mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs mapM_ (\f -> inject f f) =<< logFiles old - saveState + saveState False showProgress when e $ do diff --git a/debian/changelog b/debian/changelog index e1c861d19..96234d927 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,6 +1,12 @@ git-annex (3.20120124) UNRELEASED; urgency=low * Use the haskell IfElse library. + * 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. -- Joey Hess <joeyh@debian.org> Tue, 24 Jan 2012 16:21:55 -0400 diff --git a/git-annex-shell.hs b/git-annex-shell.hs index 4fdeae1a8..e747a447b 100644 --- a/git-annex-shell.hs +++ b/git-annex-shell.hs @@ -82,7 +82,7 @@ builtins = map cmdname cmds builtin :: String -> String -> [String] -> IO () builtin cmd dir params = do checkNotReadOnly cmd - dispatch (cmd : filterparams params) cmds options header $ + dispatch True (cmd : filterparams params) cmds options header $ Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath external :: [String] -> IO () |