mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

assistant: Run the periodic git gc in batch mode.

Browse source
This commit is contained in:
Joey Hess 2014-01-22 17:11:41 -04:00
parent 82d6cc69e9
commit ed7c61914c
3 changed files with 11 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

3
Assistant/Threads/SanityChecker.hs
View file

@ -122,6 +122,7 @@ waitForNextCheck = do
dailyCheck :: Assistant Bool dailyCheck :: Assistant Bool
dailyCheck = do dailyCheck = do
g <- liftAnnex gitRepo g <- liftAnnex gitRepo
batchmaker <- liftIO getBatchCommandMaker
-- Find old unstaged symlinks, and add them to git. -- Find old unstaged symlinks, and add them to git.
(unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g (unstaged, cleanup) <- liftIO $ Git.LsFiles.notInRepo False ["."] g
@ -140,7 +141,7 @@ dailyCheck = do
- to have a lot of small objects and they should not be a - to have a lot of small objects and they should not be a
- significant size. -} - significant size. -}
when (Git.Config.getMaybe "gc.auto" g == Just "0") $ when (Git.Config.getMaybe "gc.auto" g == Just "0") $
liftIO $ void $ Git.Command.runBool liftIO $ void $ Git.Command.runBatch batchmaker
[ Param "-c", Param "gc.auto=670000" [ Param "-c", Param "gc.auto=670000"
, Param "gc" , Param "gc"
, Param "--auto" , Param "--auto"

11
Git/Command.hs
View file

@ -18,6 +18,7 @@ import qualified Utility.CoProcess as CoProcess
#ifdef mingw32_HOST_OS #ifdef mingw32_HOST_OS
import Git.FilePath import Git.FilePath
#endif #endif
import Utility.Batch
{- Constructs a git command line operating on the specified repo. -} {- Constructs a git command line operating on the specified repo. -}
gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] gitCommandLine :: [CommandParam] -> Repo -> [CommandParam]
@ -41,9 +42,13 @@ gitCommandLine _ repo = assertLocal repo $ error "internal"
{- Runs git in the specified repo. -} {- Runs git in the specified repo. -}
runBool :: [CommandParam] -> Repo -> IO Bool runBool :: [CommandParam] -> Repo -> IO Bool
runBool params repo = assertLocal repo $ runBool params repo = assertLocal repo $
boolSystemEnv "git" boolSystemEnv "git" (gitCommandLine params repo) (gitEnv repo)
(gitCommandLine params repo)
(gitEnv repo) {- Runs git in batch mode. -}
runBatch :: BatchCommandMaker -> [CommandParam] -> Repo -> IO Bool
runBatch batchmaker params repo = assertLocal repo $ do
let (cmd, params') = batchmaker ("git", gitCommandLine params repo)
boolSystemEnv cmd params' (gitEnv repo)
{- Runs git in the specified repo, throwing an error if it fails. -} {- Runs git in the specified repo, throwing an error if it fails. -}
run :: [CommandParam] -> Repo -> IO () run :: [CommandParam] -> Repo -> IO ()

1
debian/changelog vendored
View file

@ -19,6 +19,7 @@ git-annex (5.20140118) UNRELEASED; urgency=medium
* Client, transfer, incremental backup, and archive repositories * Client, transfer, incremental backup, and archive repositories
now want to get content that does not yet have enough copies. now want to get content that does not yet have enough copies.
* repair: Check git version at run time. * repair: Check git version at run time.
* assistant: Run the periodic git gc in batch mode.
-- Joey Hess <joeyh@debian.org> Sat, 18 Jan 2014 11:54:17 -0400 -- Joey Hess <joeyh@debian.org> Sat, 18 Jan 2014 11:54:17 -0400