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.
This commit is contained in:
parent
303666965a
commit
b81d662cbf
9 changed files with 28 additions and 17 deletions
|
@ -291,10 +291,15 @@ getKeysPresent' dir = do
|
||||||
let files = concat contents
|
let files = concat contents
|
||||||
return $ mapMaybe (fileKey . takeFileName) files
|
return $ mapMaybe (fileKey . takeFileName) files
|
||||||
|
|
||||||
{- Things to do to record changes to content. -}
|
{- Things to do to record changes to content when shutting down.
|
||||||
saveState :: Annex ()
|
-
|
||||||
saveState = do
|
- 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.Queue.flush False
|
||||||
|
unless oneshot $
|
||||||
Annex.Branch.commit "update"
|
Annex.Branch.commit "update"
|
||||||
|
|
||||||
{- Downloads content from any of a list of urls. -}
|
{- Downloads content from any of a list of urls. -}
|
||||||
|
|
12
CmdLine.hs
12
CmdLine.hs
|
@ -29,8 +29,8 @@ type Params = [String]
|
||||||
type Flags = [Annex ()]
|
type Flags = [Annex ()]
|
||||||
|
|
||||||
{- Runs the passed command line. -}
|
{- Runs the passed command line. -}
|
||||||
dispatch :: Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
|
dispatch :: Bool -> Params -> [Command] -> [Option] -> String -> IO Git.Repo -> IO ()
|
||||||
dispatch args cmds commonoptions header getgitrepo = do
|
dispatch oneshot args cmds commonoptions header getgitrepo = do
|
||||||
setupConsole
|
setupConsole
|
||||||
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
|
r <- E.try getgitrepo :: IO (Either E.SomeException Git.Repo)
|
||||||
case r of
|
case r of
|
||||||
|
@ -40,7 +40,7 @@ dispatch args cmds commonoptions header getgitrepo = do
|
||||||
(actions, state') <- Annex.run state $ do
|
(actions, state') <- Annex.run state $ do
|
||||||
sequence_ flags
|
sequence_ flags
|
||||||
prepCommand cmd params
|
prepCommand cmd params
|
||||||
tryRun state' cmd $ [startup] ++ actions ++ [shutdown]
|
tryRun state' cmd $ [startup] ++ actions ++ [shutdown oneshot]
|
||||||
where
|
where
|
||||||
(flags, cmd, params) = parseCmd args cmds commonoptions header
|
(flags, cmd, params) = parseCmd args cmds commonoptions header
|
||||||
|
|
||||||
|
@ -89,9 +89,9 @@ startup :: Annex Bool
|
||||||
startup = return True
|
startup = return True
|
||||||
|
|
||||||
{- Cleanup actions. -}
|
{- Cleanup actions. -}
|
||||||
shutdown :: Annex Bool
|
shutdown :: Bool -> Annex Bool
|
||||||
shutdown = do
|
shutdown oneshot = do
|
||||||
saveState
|
saveState oneshot
|
||||||
liftIO Git.Command.reap -- zombies from long-running git processes
|
liftIO Git.Command.reap -- zombies from long-running git processes
|
||||||
sshCleanup -- ssh connection caching
|
sshCleanup -- ssh connection caching
|
||||||
return True
|
return True
|
||||||
|
|
|
@ -28,7 +28,7 @@ start key = do
|
||||||
if ok
|
if ok
|
||||||
then do
|
then do
|
||||||
-- forcibly quit after receiving one key,
|
-- forcibly quit after receiving one key,
|
||||||
-- and shutdown cleanly so queued git commands run
|
-- and shutdown cleanly
|
||||||
_ <- shutdown
|
_ <- shutdown True
|
||||||
liftIO exitSuccess
|
liftIO exitSuccess
|
||||||
else liftIO exitFailure
|
else liftIO exitFailure
|
||||||
|
|
|
@ -57,7 +57,7 @@ cleanup = do
|
||||||
mapM_ removeAnnex =<< getKeysPresent
|
mapM_ removeAnnex =<< getKeysPresent
|
||||||
liftIO $ removeDirectoryRecursive annexdir
|
liftIO $ removeDirectoryRecursive annexdir
|
||||||
-- avoid normal shutdown
|
-- avoid normal shutdown
|
||||||
saveState
|
saveState False
|
||||||
inRepo $ Git.Command.run "branch"
|
inRepo $ Git.Command.run "branch"
|
||||||
[Param "-D", Param $ show Annex.Branch.name]
|
[Param "-D", Param $ show Annex.Branch.name]
|
||||||
liftIO exitSuccess
|
liftIO exitSuccess
|
||||||
|
|
|
@ -129,4 +129,4 @@ header :: String
|
||||||
header = "Usage: git-annex command [option ..]"
|
header = "Usage: git-annex command [option ..]"
|
||||||
|
|
||||||
run :: [String] -> IO ()
|
run :: [String] -> IO ()
|
||||||
run args = dispatch args cmds options header Git.Construct.fromCurrent
|
run args = dispatch False args cmds options header Git.Construct.fromCurrent
|
||||||
|
|
|
@ -230,7 +230,7 @@ copyToRemote r key
|
||||||
-- run copy from perspective of remote
|
-- run copy from perspective of remote
|
||||||
liftIO $ onLocal r $ do
|
liftIO $ onLocal r $ do
|
||||||
ensureInitialized
|
ensureInitialized
|
||||||
Annex.Content.saveState `after`
|
Annex.Content.saveState True `after`
|
||||||
Annex.Content.getViaTmp key
|
Annex.Content.getViaTmp key
|
||||||
(rsyncOrCopyFile params keysrc)
|
(rsyncOrCopyFile params keysrc)
|
||||||
| Git.repoIsSsh r = do
|
| Git.repoIsSsh r = do
|
||||||
|
|
|
@ -50,7 +50,7 @@ upgrade = do
|
||||||
mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs
|
mapM_ (\(k, f) -> inject f $ logFile k) =<< locationLogs
|
||||||
mapM_ (\f -> inject f f) =<< logFiles old
|
mapM_ (\f -> inject f f) =<< logFiles old
|
||||||
|
|
||||||
saveState
|
saveState False
|
||||||
showProgress
|
showProgress
|
||||||
|
|
||||||
when e $ do
|
when e $ do
|
||||||
|
|
6
debian/changelog
vendored
6
debian/changelog
vendored
|
@ -1,6 +1,12 @@
|
||||||
git-annex (3.20120124) UNRELEASED; urgency=low
|
git-annex (3.20120124) UNRELEASED; urgency=low
|
||||||
|
|
||||||
* Use the haskell IfElse library.
|
* 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
|
-- Joey Hess <joeyh@debian.org> Tue, 24 Jan 2012 16:21:55 -0400
|
||||||
|
|
||||||
|
|
|
@ -82,7 +82,7 @@ builtins = map cmdname cmds
|
||||||
builtin :: String -> String -> [String] -> IO ()
|
builtin :: String -> String -> [String] -> IO ()
|
||||||
builtin cmd dir params = do
|
builtin cmd dir params = do
|
||||||
checkNotReadOnly cmd
|
checkNotReadOnly cmd
|
||||||
dispatch (cmd : filterparams params) cmds options header $
|
dispatch True (cmd : filterparams params) cmds options header $
|
||||||
Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
|
Git.Construct.repoAbsPath dir >>= Git.Construct.fromAbsPath
|
||||||
|
|
||||||
external :: [String] -> IO ()
|
external :: [String] -> IO ()
|
||||||
|
|
Loading…
Reference in a new issue