From e96c613c026c2d0bd6cce7210b058533d3ce972c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 13:38:37 -0400 Subject: pass -c option on to all git commands run The -c option now not only modifies the git configuration seen by git-annex, but it is passed along to every git command git-annex runs. This was easy to plumb through because gitCommandLine is already used to construct every git command line, to add --git-dir and --work-tree --- Git/Command.hs | 3 ++- Git/Construct.hs | 1 + Git/Types.hs | 3 +++ GitAnnex/Options.hs | 7 +++++-- debian/changelog | 2 ++ 5 files changed, 13 insertions(+), 3 deletions(-) diff --git a/Git/Command.hs b/Git/Command.hs index 8b027d2c3..adcc53bcd 100644 --- a/Git/Command.hs +++ b/Git/Command.hs @@ -21,7 +21,8 @@ import Git.FilePath {- Constructs a git command line operating on the specified repo. -} gitCommandLine :: [CommandParam] -> Repo -> [CommandParam] -gitCommandLine params Repo { location = l@(Local _ _ ) } = setdir : settree ++ params +gitCommandLine params r@(Repo { location = l@(Local _ _ ) }) = + setdir : settree ++ gitGlobalOpts r ++ params where setdir = Param $ "--git-dir=" ++ gitpath (gitdir l) settree = case worktree l of diff --git a/Git/Construct.hs b/Git/Construct.hs index cd998591e..71a13f49f 100644 --- a/Git/Construct.hs +++ b/Git/Construct.hs @@ -230,6 +230,7 @@ newFrom l = return Repo , remotes = [] , remoteName = Nothing , gitEnv = Nothing + , gitGlobalOpts = [] } diff --git a/Git/Types.hs b/Git/Types.hs index abfb99f9f..2a33fb27d 100644 --- a/Git/Types.hs +++ b/Git/Types.hs @@ -10,6 +10,7 @@ module Git.Types where import Network.URI import qualified Data.Map as M import System.Posix.Types +import Utility.SafeCommand {- Support repositories on local disk, and repositories accessed via an URL. - @@ -38,6 +39,8 @@ data Repo = Repo , remoteName :: Maybe String -- alternate environment to use when running git commands , gitEnv :: Maybe [(String, String)] + -- global options to pass to git when running git commands + , gitGlobalOpts :: [CommandParam] } deriving (Show, Eq) {- A git ref. Can be a sha1, or a branch or tag name. -} diff --git a/GitAnnex/Options.hs b/GitAnnex/Options.hs index 7f4cb60c2..88fad948a 100644 --- a/GitAnnex/Options.hs +++ b/GitAnnex/Options.hs @@ -11,6 +11,7 @@ import System.Console.GetOpt import Common.Annex import qualified Git.Config +import Git.Types import Command import Types.TrustLevel import qualified Annex @@ -59,12 +60,14 @@ options = Option.common ++ "Trust Amazon Glacier inventory" ] ++ Option.matcher where + trustArg t = ReqArg (Remote.forceTrust t) paramRemote setnumcopies v = maybe noop (\n -> Annex.changeState $ \s -> s { Annex.forcenumcopies = Just n }) (readish v) setuseragent v = Annex.changeState $ \s -> s { Annex.useragent = Just v } - setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v) - trustArg t = ReqArg (Remote.forceTrust t) paramRemote + setgitconfig v = inRepo (Git.Config.store v) + >>= pure . (\r -> r { gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param v] }) + >>= Annex.changeGitRepo keyOptions :: [Option] keyOptions = diff --git a/debian/changelog b/debian/changelog index f8d49df09..3d5e9a394 100644 --- a/debian/changelog +++ b/debian/changelog @@ -12,6 +12,8 @@ git-annex (4.20131102) UNRELEASED; urgency=low * Fix zombie process that occurred when switching between repository views in the webapp. * map: Work when there are gcrypt remotes. + * The -c option now not only modifies the git configuration seen by + git-annex, but it is passed along to every git command git-annex runs. -- Joey Hess Sat, 02 Nov 2013 14:54:36 -0400 -- cgit v1.2.3 From 83c6fbde28cb25f377bd37d0eedde52c87874052 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 14:24:28 -0400 Subject: support direct mode repositories with core.bare=true (not yet default) Direct mode repositories can now have core.bare=true set, to prevent accidentally running git commands that try to operate on the work tree, and so do the wrong thing. This is not yet the default, and it causes known problems for git-annex sync due to receive.denyCurrentBranch not working in bare repositories. This commit was sponsored by Richard Hartmann. --- Annex.hs | 20 ++++++++++++++++---- debian/changelog | 7 +++++-- doc/direct_mode.mdwn | 47 +++++++++++++++++++++++++++-------------------- 3 files changed, 48 insertions(+), 26 deletions(-) diff --git a/Annex.hs b/Annex.hs index ae56ec5ad..1fde4cd42 100644 --- a/Annex.hs +++ b/Annex.hs @@ -12,7 +12,6 @@ module Annex ( AnnexState(..), PreferredContentMap, new, - newState, run, eval, getState, @@ -41,6 +40,7 @@ import Control.Concurrent import Common import qualified Git import qualified Git.Config +import Git.Types hiding (remotes) import Git.CatFile import Git.CheckAttr import Git.CheckIgnore @@ -112,9 +112,9 @@ data AnnexState = AnnexState } newState :: Git.Repo -> AnnexState -newState gitrepo = AnnexState - { repo = gitrepo - , gitconfig = extractGitConfig gitrepo +newState r = AnnexState + { repo = if annexDirect c then fixupDirect r else r + , gitconfig = c , backends = [] , remotes = [] , output = defaultMessageState @@ -144,6 +144,8 @@ newState gitrepo = AnnexState , inodeschanged = Nothing , useragent = Nothing } + where + c = extractGitConfig r {- Makes an Annex state object for the specified git repo. - Ensures the config is read, if it was not already. -} @@ -247,3 +249,13 @@ withCurrentState :: Annex a -> Annex (IO a) withCurrentState a = do s <- getState id return $ eval s a + +{- Direct mode repos have core.bare=true, but are not really bare. + - Fix up the Repo to be a non-bare repo, and arrange for git commands + - run by git-annex to be passed parameters that override this setting. -} +fixupDirect :: Git.Repo -> Git.Repo +fixupDirect r@(Repo { location = Local { gitdir = d, worktree = Nothing } }) = r + { location = Local { gitdir = d ".git", worktree = Just d } + , gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param "core.bare=false"] + } +fixupDirect r = r diff --git a/debian/changelog b/debian/changelog index 3d5e9a394..aba80a344 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,5 +1,10 @@ git-annex (4.20131102) UNRELEASED; urgency=low + * Direct mode repositories can now have core.bare=true set, to prevent + accidentally running git commands that try to operate on the work tree, + and so do the wrong thing. + * The -c option now not only modifies the git configuration seen by + git-annex, but it is passed along to every git command git-annex runs. * Improve local pairing behavior when two computers both try to start the pairing process separately. * sync: Work even when the local git repository is new and empty, @@ -12,8 +17,6 @@ git-annex (4.20131102) UNRELEASED; urgency=low * Fix zombie process that occurred when switching between repository views in the webapp. * map: Work when there are gcrypt remotes. - * The -c option now not only modifies the git configuration seen by - git-annex, but it is passed along to every git command git-annex runs. -- Joey Hess Sat, 02 Nov 2013 14:54:36 -0400 diff --git a/doc/direct_mode.mdwn b/doc/direct_mode.mdwn index a6a2003a7..fc39956a3 100644 --- a/doc/direct_mode.mdwn +++ b/doc/direct_mode.mdwn @@ -4,8 +4,7 @@ git, and in turn point at the content of large files that is stored in The advantage of direct mode is that you can access files directly, including modifying them. The disadvantage is that most regular git -commands cannot safely be used, and only a subset of git-annex commands -can be used. +commands cannot be used in a direct mode repository. Normally, git-annex repositories start off in indirect mode. With some exceptions: @@ -21,7 +20,7 @@ exceptions: Any repository can be converted to use direct mode at any time, and if you decide not to use it, you can convert back to indirect mode just as easily. Also, you can have one clone of a repository using direct mode, and another -using indirect mode; direct mode interoperates. +using indirect mode. To start using direct mode: @@ -52,7 +51,6 @@ computers, and manage your files, this should not be a concern for you. ## use a direct mode repository You can use most git-annex commands as usual in a direct mode repository. -A very few commands don't work in direct mode, and will refuse to do anything. Direct mode also works well with the git-annex assistant. @@ -63,23 +61,32 @@ the changes to other repositories for `git annex sync` there to pick up, and will pull and merge any changes made on other repositories into the local repository. -While you generally will just use `git annex sync`, if you want to, -you can use `git commit --staged`, or plain `git commit`. -But not `git commit -a`, or `git commit ` .. -that'd commit whole large files into git! - ## what doesn't work in direct mode -`git annex status` shows incomplete information. A few other commands, -like `git annex unlock` don't make sense in direct mode and will refuse to -run. +A very few git-annex commands don't work in direct mode, and will refuse +to do anything. For example, `git annex unlock` doesn't make sense in +direct mode. + +As for git commands, direct mode prevents using any git command that would +modify or access the work tree. So you cannot `git commit` or `git pull` +(use `git annex sync` for both instead), or run `git status`. +These git commands will complain "fatal: This operation must be run in a work tree". + +The reason for this is that git doesn't understand how git-annex uses the +work tree in direct mode. Where git expects the symlinks that get checked +into git to be checked out in the work tree, direct mode instead replaces +them with the actual content of files, as managed by git-annex. + +There are still lots of git commands you can use in direct mode. For +example, you can run `git log` on files, run `git push`, `git config`, +`git remote add` etc. + +## forcing git to use the work tree in direct mode -As for git commands, you can probably use some git working tree -manipulation commands, like `git checkout` and `git revert` in useful -ways... But beware, these commands can replace files that are present in -your repository with broken symlinks. If that file was the only copy you -had of something, it'll be lost. +This is for experts only. You can lose data doing this, or check enormous +files directly into your git repository, and it's your fault if you do! +Also, there should be no good reason to need to do this, ever. -This is one more reason it's wise to make git-annex untrust your direct mode -repositories. Still, you can lose data using these sort of git commands, so -use extreme caution. +Ok, with the warnings out of the way, all you need to do to make any +git command access the work tree in direct mode is pass it +`-c core.bare=false` -- cgit v1.2.3 From 8bb9d23f521582e51ceaee03d1aa5084cad3de08 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 15:29:56 -0400 Subject: refactored hook setup --- Annex/Hook.hs | 42 ++++++++++++++++++++++++++++++++++++++++++ Git/Hook.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ Init.hs | 47 +++++------------------------------------------ 3 files changed, 101 insertions(+), 42 deletions(-) create mode 100644 Annex/Hook.hs create mode 100644 Git/Hook.hs diff --git a/Annex/Hook.hs b/Annex/Hook.hs new file mode 100644 index 000000000..7301a0958 --- /dev/null +++ b/Annex/Hook.hs @@ -0,0 +1,42 @@ +{- git-annex git hooks + - + - Note that it's important that the scripts not change, otherwise + - removing old hooks using an old version of the script would fail. + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Annex.Hook where + +import Common.Annex +import qualified Git.Hook as Git +import Utility.Shell +import Config + +preCommitHook :: Git.Hook +preCommitHook = Git.Hook "pre-commit" (mkHookScript "git annex pre-commit .") + +mkHookScript :: String -> String +mkHookScript s = unlines + [ shebang_local + , "# automatically configured by git-annex" + , s + ] + +hookWrite :: Git.Hook -> Annex () +hookWrite h = + -- cannot have git hooks in a crippled filesystem (no execute bit) + unlessM crippledFileSystem $ + unlessM (inRepo $ Git.hookWrite h) $ + hookWarning h "already exists, not configuring" + +hookUnWrite :: Git.Hook -> Annex () +hookUnWrite h = unlessM (inRepo $ Git.hookUnWrite h) $ + hookWarning h "contents modified; not deleting. Edit it to remove call to git annex." + +hookWarning :: Git.Hook -> String -> Annex () +hookWarning h msg = do + r <- gitRepo + warning $ Git.hookName h ++ " hook (" ++ Git.hookFile h r ++ ") " ++ msg diff --git a/Git/Hook.hs b/Git/Hook.hs new file mode 100644 index 000000000..d56a4a565 --- /dev/null +++ b/Git/Hook.hs @@ -0,0 +1,54 @@ +{- git hooks + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Git.Hook where + +import Common +import Git +import Utility.Tmp + +data Hook = Hook + { hookName :: FilePath + , hookScript :: String + } + +hookFile :: Hook -> Repo -> FilePath +hookFile h r = localGitDir r "hooks" hookName h + +{- Writes a hook. Returns False if the hook already exists with a different + - content. -} +hookWrite :: Hook -> Repo -> IO Bool +hookWrite h r = do + let f = hookFile h r + ifM (doesFileExist f) + ( expectedContent h r + , do + viaTmp writeFile f (hookScript h) + p <- getPermissions f + setPermissions f $ p {executable = True} + return True + ) + +{- Removes a hook. Returns False if the hook contained something else, and + - could not be removed. -} +hookUnWrite :: Hook -> Repo -> IO Bool +hookUnWrite h r = do + let f = hookFile h r + ifM (doesFileExist f) + ( ifM (expectedContent h r) + ( do + removeFile f + return True + , return False + ) + , return True + ) + +expectedContent :: Hook -> Repo -> IO Bool +expectedContent h r = do + content <- readFile $ hookFile h r + return $ content == hookScript h diff --git a/Init.hs b/Init.hs index 7e7e5041d..80e101d37 100644 --- a/Init.hs +++ b/Init.hs @@ -12,11 +12,10 @@ module Init ( isInitialized, initialize, uninitialize, - probeCrippledFileSystem + probeCrippledFileSystem, ) where import Common.Annex -import Utility.Tmp import Utility.Network import qualified Annex import qualified Git @@ -26,7 +25,6 @@ import qualified Annex.Branch import Logs.UUID import Annex.Version import Annex.UUID -import Utility.Shell import Config import Annex.Direct import Annex.Content.Direct @@ -36,6 +34,7 @@ import Backend import Utility.UserInfo import Utility.FileMode #endif +import Annex.Hook genDescription :: Maybe String -> Annex String genDescription (Just d) = return d @@ -56,7 +55,8 @@ initialize mdescription = do setVersion defaultVersion checkCrippledFileSystem checkFifoSupport - gitPreCommitHookWrite + unlessBare $ + hookWrite preCommitHook createInodeSentinalFile u <- getUUID {- This will make the first commit to git, so ensure git is set up @@ -67,7 +67,7 @@ initialize mdescription = do uninitialize :: Annex () uninitialize = do - gitPreCommitHookUnWrite + hookUnWrite preCommitHook removeRepoUUID removeVersion @@ -87,46 +87,9 @@ ensureInitialized = getVersion >>= maybe needsinit checkVersion isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion -{- set up a git pre-commit hook, if one is not already present -} -gitPreCommitHookWrite :: Annex () -gitPreCommitHookWrite = unlessBare $ do - hook <- preCommitHook - ifM (liftIO $ doesFileExist hook) - ( do - content <- liftIO $ readFile hook - when (content /= preCommitScript) $ - warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring" - , unlessM crippledFileSystem $ - liftIO $ do - viaTmp writeFile hook preCommitScript - p <- getPermissions hook - setPermissions hook $ p {executable = True} - ) - -gitPreCommitHookUnWrite :: Annex () -gitPreCommitHookUnWrite = unlessBare $ do - hook <- preCommitHook - whenM (liftIO $ doesFileExist hook) $ - ifM (liftIO $ (==) preCommitScript <$> readFile hook) - ( liftIO $ removeFile hook - , warning $ "pre-commit hook (" ++ hook ++ - ") contents modified; not deleting." ++ - " Edit it to remove call to git annex." - ) - unlessBare :: Annex () -> Annex () unlessBare = unlessM $ fromRepo Git.repoIsLocalBare -preCommitHook :: Annex FilePath -preCommitHook = () <$> fromRepo Git.localGitDir <*> pure "hooks/pre-commit" - -preCommitScript :: String -preCommitScript = unlines - [ shebang_local - , "# automatically configured by git-annex" - , "git annex pre-commit ." - ] - {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} probeCrippledFileSystem :: Annex Bool -- cgit v1.2.3 From da9eea5dc0e86b4abb14064346eddc5689d94333 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 15:31:37 -0400 Subject: automatically set and unset core.bare when switching to/from direct mode --- Annex.hs | 13 +++++++++---- Config.hs | 5 ++++- Git/Config.hs | 5 ++++- debian/changelog | 2 +- 4 files changed, 18 insertions(+), 7 deletions(-) diff --git a/Annex.hs b/Annex.hs index 1fde4cd42..b634041db 100644 --- a/Annex.hs +++ b/Annex.hs @@ -45,6 +45,7 @@ import Git.CatFile import Git.CheckAttr import Git.CheckIgnore import Git.SharedRepository +import Git.Config import qualified Git.Queue import Types.Backend import Types.GitConfig @@ -254,8 +255,12 @@ withCurrentState a = do - Fix up the Repo to be a non-bare repo, and arrange for git commands - run by git-annex to be passed parameters that override this setting. -} fixupDirect :: Git.Repo -> Git.Repo -fixupDirect r@(Repo { location = Local { gitdir = d, worktree = Nothing } }) = r - { location = Local { gitdir = d ".git", worktree = Just d } - , gitGlobalOpts = gitGlobalOpts r ++ [Param "-c", Param "core.bare=false"] - } +fixupDirect r@(Repo { location = Local { gitdir = d, worktree = Nothing } }) = + r + { location = Local { gitdir = d ".git", worktree = Just d } + , gitGlobalOpts = gitGlobalOpts r ++ + [ Param "-c" + , Param $ coreBare ++ "=" ++ boolConfig False + ] + } fixupDirect r = r diff --git a/Config.hs b/Config.hs index ac251983a..475cb83ec 100644 --- a/Config.hs +++ b/Config.hs @@ -73,8 +73,11 @@ isDirect = annexDirect <$> Annex.getGitConfig setDirect :: Bool -> Annex () setDirect b = do - setConfig (annexConfig "direct") (Git.Config.boolConfig b) + setConfig (annexConfig "direct") val + setConfig (ConfigKey Git.Config.coreBare) val Annex.changeGitConfig $ \c -> c { annexDirect = b } + where + val = Git.Config.boolConfig b crippledFileSystem :: Annex Bool crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig diff --git a/Git/Config.hs b/Git/Config.hs index a41712add..1919ecedf 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -153,7 +153,10 @@ boolConfig True = "true" boolConfig False = "false" isBare :: Repo -> Bool -isBare r = fromMaybe False $ isTrue =<< getMaybe "core.bare" r +isBare r = fromMaybe False $ isTrue =<< getMaybe coreBare r + +coreBare :: String +coreBare = "core.bare" {- Runs a command to get the configuration of a repo, - and returns a repo populated with the configuration, as well as the raw diff --git a/debian/changelog b/debian/changelog index aba80a344..3237e2bbf 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,6 +1,6 @@ git-annex (4.20131102) UNRELEASED; urgency=low - * Direct mode repositories can now have core.bare=true set, to prevent + * Direct mode repositories now have core.bare=true set, to prevent accidentally running git commands that try to operate on the work tree, and so do the wrong thing. * The -c option now not only modifies the git configuration seen by -- cgit v1.2.3 From 4f6c8222072ace33e3acedddd31637089ae474b6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 16:42:59 -0400 Subject: v5 for direct mode, with automatic upgrade This includes storing the current state of the HEAD ref, which git annex sync is going to need, but does not make sync use it. --- Annex/Direct.hs | 30 ++++++++++++++++++++++++++++++ Annex/Version.hs | 18 ++++++------------ Command/Upgrade.hs | 8 ++++++-- Config.hs | 8 -------- Git/Ref.hs | 5 +++++ Init.hs | 8 ++++++-- Upgrade.hs | 17 +++++++++++++++-- Upgrade/V4.hs | 23 +++++++++++++++++++++++ debian/changelog | 7 +++++-- doc/git-annex.mdwn | 13 +++++++++++-- doc/todo/direct_mode_guard.mdwn | 20 ++++++++++++++++++++ doc/upgrades.mdwn | 12 ++++++++++-- 12 files changed, 137 insertions(+), 32 deletions(-) create mode 100644 Upgrade/V4.hs diff --git a/Annex/Direct.hs b/Annex/Direct.hs index ea2b577b9..7b0dbc1e0 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -8,13 +8,17 @@ module Annex.Direct where import Common.Annex +import qualified Annex import qualified Git import qualified Git.LsFiles import qualified Git.Merge import qualified Git.DiffTree as DiffTree +import qualified Git.Config +import qualified Git.Ref import Git.Sha import Git.FilePath import Git.Types +import Config import Annex.CatFile import qualified Annex.Queue import Logs.Location @@ -231,3 +235,29 @@ changedDirect oldk f = do locs <- removeAssociatedFile oldk f whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing + +{- Since direct mode repositories use core.bare=true, pushes are allowed + - that overwrite the master branch (or whatever branch is currently + - checked out) at any time. But committing when a change has been pushed + - to the current branch and not merged into the work tree will have the + - effect of reverting the pushed changes. + - + - To avoid this problem, when git annex commits in a direct mode + - repository, it does not commit to HEAD, but instead to annexhead. + - This ref always contains the last local commit. + -} +annexheadRef :: Ref +annexheadRef = Ref $ "refs" "annexhead" + +{- Enable/disable direct mode. -} +setDirect :: Bool -> Annex () +setDirect wantdirect = do + when wantdirect $ do + f <- fromRepo $ Git.Ref.file annexheadRef + v <- inRepo $ Git.Ref.sha Git.Ref.headRef + liftIO $ maybe (nukeFile f) (writeFile f . show) v + setConfig (annexConfig "direct") val + setConfig (ConfigKey Git.Config.coreBare) val + Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect } + where + val = Git.Config.boolConfig wantdirect diff --git a/Annex/Version.hs b/Annex/Version.hs index 05b3f0227..2b4a49fd2 100644 --- a/Annex/Version.hs +++ b/Annex/Version.hs @@ -19,18 +19,21 @@ defaultVersion :: Version defaultVersion = "3" directModeVersion :: Version -directModeVersion = "4" +directModeVersion = "5" supportedVersions :: [Version] supportedVersions = [defaultVersion, directModeVersion] upgradableVersions :: [Version] #ifndef mingw32_HOST_OS -upgradableVersions = ["0", "1", "2"] +upgradableVersions = ["0", "1", "2", "4"] #else -upgradableVersions = ["2"] +upgradableVersions = ["2", "4"] #endif +autoUpgradeableVersions :: [Version] +autoUpgradeableVersions = ["4"] + versionField :: ConfigKey versionField = annexConfig "version" @@ -42,12 +45,3 @@ setVersion = setConfig versionField removeVersion :: Annex () removeVersion = unsetConfig versionField - -checkVersion :: Version -> Annex () -checkVersion v - | v `elem` supportedVersions = noop - | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade" - | otherwise = err "Upgrade git-annex." - where - err msg = error $ "Repository version " ++ v ++ - " is not supported. " ++ msg diff --git a/Command/Upgrade.hs b/Command/Upgrade.hs index 88ca8622d..66ea0e0eb 100644 --- a/Command/Upgrade.hs +++ b/Command/Upgrade.hs @@ -11,6 +11,7 @@ import Common.Annex import Command import Upgrade import Annex.Version +import Config def :: [Command] def = [dontCheck repoExists $ -- because an old version may not seem to exist @@ -23,6 +24,9 @@ seek = [withNothing start] start :: CommandStart start = do showStart "upgrade" "." - r <- upgrade - setVersion defaultVersion + r <- upgrade False + ifM isDirect + ( setVersion directModeVersion + , setVersion defaultVersion + ) next $ next $ return r diff --git a/Config.hs b/Config.hs index 475cb83ec..0c6b64f50 100644 --- a/Config.hs +++ b/Config.hs @@ -71,14 +71,6 @@ getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig isDirect :: Annex Bool isDirect = annexDirect <$> Annex.getGitConfig -setDirect :: Bool -> Annex () -setDirect b = do - setConfig (annexConfig "direct") val - setConfig (ConfigKey Git.Config.coreBare) val - Annex.changeGitConfig $ \c -> c { annexDirect = b } - where - val = Git.Config.boolConfig b - crippledFileSystem :: Annex Bool crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig diff --git a/Git/Ref.hs b/Git/Ref.hs index 954b61a2e..9706f8b6c 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -40,6 +40,11 @@ exists :: Ref -> Repo -> IO Bool exists ref = runBool [Param "show-ref", Param "--verify", Param "-q", Param $ show ref] +{- The file used to record a ref. (Git also stores some refs in a + - packed-refs file.) -} +file :: Ref -> Repo -> FilePath +file ref repo = localGitDir repo show ref + {- Checks if HEAD exists. It generally will, except for in a repository - that was just created. -} headExists :: Repo -> IO Bool diff --git a/Init.hs b/Init.hs index 80e101d37..991f7d31c 100644 --- a/Init.hs +++ b/Init.hs @@ -35,6 +35,7 @@ import Utility.UserInfo import Utility.FileMode #endif import Annex.Hook +import Upgrade genDescription :: Maybe String -> Annex String genDescription (Just d) = return d @@ -74,9 +75,12 @@ uninitialize = do {- Will automatically initialize if there is already a git-annex - branch from somewhere. Otherwise, require a manual init - to avoid git-annex accidentially being run in git - - repos that did not intend to use it. -} + - repos that did not intend to use it. + - + - Checks repository version and handles upgrades too. + -} ensureInitialized :: Annex () -ensureInitialized = getVersion >>= maybe needsinit checkVersion +ensureInitialized = getVersion >>= maybe needsinit checkUpgrade where needsinit = ifM Annex.Branch.hasSibling ( initialize Nothing diff --git a/Upgrade.hs b/Upgrade.hs index f0166bf8e..59cca3fe4 100644 --- a/Upgrade.hs +++ b/Upgrade.hs @@ -16,9 +16,21 @@ import qualified Upgrade.V0 import qualified Upgrade.V1 #endif import qualified Upgrade.V2 +import qualified Upgrade.V4 -upgrade :: Annex Bool -upgrade = go =<< getVersion +checkUpgrade :: Version -> Annex () +checkUpgrade v + | v `elem` supportedVersions = noop + | v `elem` autoUpgradeableVersions = unlessM (upgrade True) $ + err "Automatic upgrade failed!" + | v `elem` upgradableVersions = err "Upgrade this repository: git-annex upgrade" + | otherwise = err "Upgrade git-annex." + where + err msg = error $ "Repository version " ++ v ++ + " is not supported. " ++ msg + +upgrade :: Bool -> Annex Bool +upgrade automatic = go =<< getVersion where #ifndef mingw32_HOST_OS go (Just "0") = Upgrade.V0.upgrade @@ -28,4 +40,5 @@ upgrade = go =<< getVersion go (Just "1") = error "upgrade from v1 on Windows not supported" #endif go (Just "2") = Upgrade.V2.upgrade + go (Just "4") = Upgrade.V4.upgrade automatic go _ = return True diff --git a/Upgrade/V4.hs b/Upgrade/V4.hs new file mode 100644 index 000000000..147ace559 --- /dev/null +++ b/Upgrade/V4.hs @@ -0,0 +1,23 @@ +{- git-annex v4 -> v5 uppgrade support + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Upgrade.V4 where + +import Common.Annex +import Config +import Annex.Direct + +{- Direct mode only upgrade. -} +upgrade :: Bool -> Annex Bool +upgrade automatic = ifM isDirect + ( do + unless automatic $ + showAction "v4 to v5" + setDirect True + return True + , return False + ) diff --git a/debian/changelog b/debian/changelog index 3237e2bbf..63ecf4e6c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,8 +1,11 @@ -git-annex (4.20131102) UNRELEASED; urgency=low +git-annex (5.20131102) UNRELEASED; urgency=low * Direct mode repositories now have core.bare=true set, to prevent accidentally running git commands that try to operate on the work tree, - and so do the wrong thing. + and so do the wrong thing in direct mode. + * annex.version is now set to 5 for direct mode repositories. + This upgrade is handled fully automatically, no need to run + git annex upgrade * The -c option now not only modifies the git configuration seen by git-annex, but it is passed along to every git command git-annex runs. * Improve local pairing behavior when two computers both try to start diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index d88957f9c..fd22fc672 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -698,12 +698,21 @@ subdirectories). * `pre-commit [path ...]` + This is meant to be called from git's pre-commit hook. `git annex init` + automatically creates a pre-commit hook using this. + Fixes up symlinks that are staged as part of a commit, to ensure they point to annexed content. Also handles injecting changes to unlocked files into the annex. - This is meant to be called from git's pre-commit hook. `git annex init` - automatically creates a pre-commit hook using this. +* `update-hook refname olvrev newrev` + + This is meant to be called from git's update hook. `git annex init` + automatically creates an update hook using this. + + This denies updates being pushed for the currently checked out branch. + While receive.denyCurrentBranch normally prevents that, it does + not for fake bare repositories, as used by direct mode. * `fromkey key file` diff --git a/doc/todo/direct_mode_guard.mdwn b/doc/todo/direct_mode_guard.mdwn index 6aab353fa..9fbb21cd3 100644 --- a/doc/todo/direct_mode_guard.mdwn +++ b/doc/todo/direct_mode_guard.mdwn @@ -77,6 +77,26 @@ This seems really promising. But of course, git-annex has its own set of behaviors in a bare repo, so will need to recognise that this repo is not really bare, and avoid them. +> [[done]]!! --[[Joey]] + (Git may also have some bare repo behaviors that are unwanted. One example is that git allows pushes to the current branch in a bare repo, even when `receive.denyCurrentBranch` is set.) + +> This is indeed a problem. Indeed, `git annex sync` successfully +> pushes changes to the master branch of a fake bare direct mode repo. +> +> And then, syncing in the repo that was pushed to causes the changes +> that were pushed to the master branch to get reverted! This happens +> because sync commits; commit sees that files are staged in index +> differing from the (pushed) master, and commits the "changes" +> which revert it. +> +> Could fix this using an update hook, to reject the updated of the master +> branch. However, won't work on crippled filesystems! (No +x bit) +> +> Could make git annex sync detect this. It could reset the master +> branch to the last one committed, before committing. Will work, +> does have the minor oddity that eg `git log` will show commits +> pushed to master before `git annex sync` has been run and so before +> those commits are reflected in the tree. diff --git a/doc/upgrades.mdwn b/doc/upgrades.mdwn index 6cf54477c..5cf4093dc 100644 --- a/doc/upgrades.mdwn +++ b/doc/upgrades.mdwn @@ -18,10 +18,18 @@ conflicts first before upgrading git-annex. ## Upgrade events, so far +### v4 -> v5 (git-annex version 5.x) + +v5 is only used for [[direct_mode]]. The upgrade from v4 to v5 is handled +automatically. + +This upgrade involves changing direct mode repositories to operate with +core.bare=true. + ### v3 -> v4 (git-annex version 4.x) -v4 is only used for [[direct_mode]], and no upgrade needs to be done from -existing v3 repositories, they will continue to work. +v4 was only used for [[direct_mode]], to ensure that a version of git-annex +that understands direct mode was used with a direct mode repository. ### v2 -> v3 (git-annex version 3.x) -- cgit v1.2.3 From 638a0190aa2797970151988fa26fe128d1804c9c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 18:20:52 -0400 Subject: factor out update --- Git/Branch.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/Git/Branch.hs b/Git/Branch.hs index 01d028f55..7b560246e 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -97,7 +97,7 @@ commit message branch parentrefs repo = do sha <- getSha "commit-tree" $ pipeWriteRead (map Param $ ["commit-tree", show tree] ++ ps) (Just $ flip hPutStr message) repo - run [Param "update-ref", Param $ show branch, Param $ show sha] repo + update branch sha repo return sha where ps = concatMap (\r -> ["-p", show r]) parentrefs @@ -105,3 +105,11 @@ commit message branch parentrefs repo = do {- A leading + makes git-push force pushing a branch. -} forcePush :: String -> String forcePush b = "+" ++ b + +{- Updates a branch (or other ref) to a new Sha. -} +update :: Branch -> Sha -> Repo -> IO () +update branch sha = run + [ Param "update-ref" + , Param $ show branch + , Param $ show sha + ] -- cgit v1.2.3 From b9d5c418cd5eb89e6ea2de58559da4fe9f487934 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 5 Nov 2013 21:08:31 -0400 Subject: work around lack of receive.denyCurrentBranch in direct mode MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Now that direct mode sets core.bare=true, git's normal prohibition about pushing into the currently checked out branch doesn't work. A simple fix for this would be an update hook which blocks the pushes.. but git hooks must be executable, and git-annex needs to be usable on eg, FAT, which lacks x bits. Instead, enabling direct mode switches the branch (eg master) to a special purpose branch (eg annex/direct/master). This branch is not pushed when syncing; instead any changes that git annex sync commits get written to master, and it's pushed (along with synced/master) to the remote. Note that initialization has been changed to always call setDirect, even if it's just setDirect False for indirect mode. This is needed because if the user has just cloned a direct mode repo, that nothing has synced with before, it may have no master branch, and only a annex/direct/master. Resulting in that branch being checked out locally too. Calling setDirect False for indirect mode moves back out of this branch, to a new master branch, and ensures that a manual "git push" doesn't push changes directly to the annex/direct/master of the remote. (It's possible that the user makes a commit w/o using git-annex and pushes it, but nothing I can do about that really.) This commit was sponsored by Jonathan Harrington. --- Annex/Direct.hs | 74 +++++++++++++++++++++++++++++++---------- Command/Sync.hs | 12 +++++-- Git/Branch.hs | 22 ++++++++++-- Git/Ref.hs | 10 ++++-- Init.hs | 45 ++++++++++++++----------- doc/todo/direct_mode_guard.mdwn | 11 +++--- 6 files changed, 126 insertions(+), 48 deletions(-) diff --git a/Annex/Direct.hs b/Annex/Direct.hs index 7b0dbc1e0..d4b73860e 100644 --- a/Annex/Direct.hs +++ b/Annex/Direct.hs @@ -15,6 +15,7 @@ import qualified Git.Merge import qualified Git.DiffTree as DiffTree import qualified Git.Config import qualified Git.Ref +import qualified Git.Branch import Git.Sha import Git.FilePath import Git.Types @@ -236,28 +237,65 @@ changedDirect oldk f = do whenM (pure (null locs) <&&> not <$> inAnnex oldk) $ logStatus oldk InfoMissing -{- Since direct mode repositories use core.bare=true, pushes are allowed - - that overwrite the master branch (or whatever branch is currently - - checked out) at any time. But committing when a change has been pushed - - to the current branch and not merged into the work tree will have the - - effect of reverting the pushed changes. - - - - To avoid this problem, when git annex commits in a direct mode - - repository, it does not commit to HEAD, but instead to annexhead. - - This ref always contains the last local commit. - -} -annexheadRef :: Ref -annexheadRef = Ref $ "refs" "annexhead" - {- Enable/disable direct mode. -} setDirect :: Bool -> Annex () setDirect wantdirect = do - when wantdirect $ do - f <- fromRepo $ Git.Ref.file annexheadRef - v <- inRepo $ Git.Ref.sha Git.Ref.headRef - liftIO $ maybe (nukeFile f) (writeFile f . show) v + if wantdirect + then do + switchHEAD + setbare + else do + setbare + switchHEADBack setConfig (annexConfig "direct") val - setConfig (ConfigKey Git.Config.coreBare) val Annex.changeGitConfig $ \c -> c { annexDirect = wantdirect } where val = Git.Config.boolConfig wantdirect + setbare = setConfig (ConfigKey Git.Config.coreBare) val + +{- Since direct mode sets core.bare=true, incoming pushes could change + - the currently checked out branch. To avoid this problem, HEAD + - is changed to a internal ref that nothing is going to push to. + - + - For refs/heads/master, use refs/heads/annex/direct/master; + - this way things that show HEAD (eg shell prompts) will + - hopefully show just "master". -} +directBranch :: Ref -> Ref +directBranch orighead = case split "/" $ show orighead of + ("refs":"heads":"annex":"direct":_) -> orighead + ("refs":"heads":rest) -> + Ref $ "refs/heads/annex/direct/" ++ intercalate "/" rest + _ -> Ref $ "refs/heads/" ++ show (Git.Ref.base orighead) + +{- Converts a directBranch back to the original branch. + - + - Any other ref is left unchanged. + -} +fromDirectBranch :: Ref -> Ref +fromDirectBranch directhead = case split "/" $ show directhead of + ("refs":"heads":"annex":"direct":rest) -> + Ref $ "refs/heads/" ++ intercalate "/" rest + _ -> directhead + +switchHEAD :: Annex () +switchHEAD = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch orighead = do + let newhead = directBranch orighead + maybe noop (inRepo . Git.Branch.update newhead) + =<< inRepo (Git.Ref.sha orighead) + inRepo $ Git.Branch.checkout newhead + +switchHEADBack :: Annex () +switchHEADBack = maybe noop switch =<< inRepo Git.Branch.currentUnsafe + where + switch currhead = do + let orighead = fromDirectBranch currhead + v <- inRepo $ Git.Ref.sha currhead + case v of + Just headsha + | orighead /= currhead -> do + inRepo $ Git.Branch.update orighead headsha + inRepo $ Git.Branch.checkout orighead + inRepo $ Git.Branch.delete currhead + _ -> inRepo $ Git.Branch.checkout orighead diff --git a/Command/Sync.hs b/Command/Sync.hs index 2a6f340e7..a37fcab98 100644 --- a/Command/Sync.hs +++ b/Command/Sync.hs @@ -75,10 +75,10 @@ prepMerge :: Annex () prepMerge = liftIO . setCurrentDirectory =<< fromRepo Git.repoPath syncBranch :: Git.Ref -> Git.Ref -syncBranch = Git.Ref.under "refs/heads/synced/" +syncBranch = Git.Ref.under "refs/heads/synced" . fromDirectBranch remoteBranch :: Remote -> Git.Ref -> Git.Ref -remoteBranch remote = Git.Ref.under $ "refs/remotes/" ++ Remote.name remote +remoteBranch remote = Git.Ref.underBase $ "refs/remotes/" ++ Remote.name remote syncRemotes :: [String] -> Annex [Remote] syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted ) @@ -138,7 +138,13 @@ mergeLocal (Just branch) = go =<< needmerge pushLocal :: Maybe Git.Ref -> CommandStart pushLocal Nothing = stop pushLocal (Just branch) = do + -- Update the sync branch to match the new state of the branch inRepo $ updateBranch $ syncBranch branch + -- In direct mode, we're operating on some special direct mode + -- branch, rather than the intended branch, so update the indended + -- branch. + whenM isDirect $ + inRepo $ updateBranch $ fromDirectBranch branch stop updateBranch :: Git.Ref -> Git.Repo -> IO () @@ -232,7 +238,7 @@ pushBranch remote branch g = tryIO (directpush g) `after` syncpush g , refspec branch ] directpush = Git.Command.runQuiet $ pushparams - [show $ Git.Ref.base branch] + [show $ Git.Ref.base $ fromDirectBranch branch] pushparams branches = [ Param "push" , Param $ Remote.name remote diff --git a/Git/Branch.hs b/Git/Branch.hs index 7b560246e..7b3297d74 100644 --- a/Git/Branch.hs +++ b/Git/Branch.hs @@ -13,7 +13,7 @@ import Common import Git import Git.Sha import Git.Command -import Git.Ref (headRef) +import qualified Git.Ref {- The currently checked out branch. - @@ -36,7 +36,7 @@ current r = do {- The current branch, which may not really exist yet. -} currentUnsafe :: Repo -> IO (Maybe Git.Ref) currentUnsafe r = parse . firstLine - <$> pipeReadStrict [Param "symbolic-ref", Param $ show headRef] r + <$> pipeReadStrict [Param "symbolic-ref", Param $ show Git.Ref.headRef] r where parse l | null l = Nothing @@ -113,3 +113,21 @@ update branch sha = run , Param $ show branch , Param $ show sha ] + +{- Checks out a branch, creating it if necessary. -} +checkout :: Branch -> Repo -> IO () +checkout branch = run + [ Param "checkout" + , Param "-q" + , Param "-B" + , Param $ show $ Git.Ref.base branch + ] + +{- Removes a branch. -} +delete :: Branch -> Repo -> IO () +delete branch = run + [ Param "branch" + , Param "-q" + , Param "-D" + , Param $ show $ Git.Ref.base branch + ] diff --git a/Git/Ref.hs b/Git/Ref.hs index 9706f8b6c..5057180d1 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -29,11 +29,17 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . show | prefix `isPrefixOf` s = drop (length prefix) s | otherwise = s +{- Given a directory and any ref, takes the basename of the ref and puts + - it under the directory. -} +under :: String -> Ref -> Ref +under dir r = Ref $ dir ++ "/" ++ + (reverse $ takeWhile (/= '/') $ reverse $ show r) + {- Given a directory such as "refs/remotes/origin", and a ref such as - refs/heads/master, yields a version of that ref under the directory, - such as refs/remotes/origin/master. -} -under :: String -> Ref -> Ref -under dir r = Ref $ dir show (base r) +underBase :: String -> Ref -> Ref +underBase dir r = Ref $ dir ++ "/" ++ show (base r) {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool diff --git a/Init.hs b/Init.hs index 991f7d31c..453ad5ae9 100644 --- a/Init.hs +++ b/Init.hs @@ -53,11 +53,19 @@ genDescription Nothing = do initialize :: Maybe String -> Annex () initialize mdescription = do prepUUID - setVersion defaultVersion - checkCrippledFileSystem checkFifoSupport - unlessBare $ + checkCrippledFileSystem + unlessM isBare $ hookWrite preCommitHook + ifM (crippledFileSystem <&&> not <$> isBare) + ( do + enableDirectMode + setDirect True + setVersion directModeVersion + , do + setVersion defaultVersion + setDirect False + ) createInodeSentinalFile u <- getUUID {- This will make the first commit to git, so ensure git is set up @@ -91,8 +99,8 @@ ensureInitialized = getVersion >>= maybe needsinit checkUpgrade isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion -unlessBare :: Annex () -> Annex () -unlessBare = unlessM $ fromRepo Git.repoIsLocalBare +isBare :: Annex Bool +isBare = fromRepo Git.repoIsLocalBare {- A crippled filesystem is one that does not allow making symlinks, - or removing write access from files. -} @@ -125,25 +133,15 @@ checkCrippledFileSystem = whenM probeCrippledFileSystem $ do warning "Detected a crippled filesystem." setCrippledFileSystem True - {- Normally git disables core.symlinks itself when the filesystem does - - not support them, but in Cygwin, git does support symlinks, while - - git-annex, not linking with Cygwin, does not. -} + {- Normally git disables core.symlinks itself when the + - filesystem does not support them, but in Cygwin, git + - does support symlinks, while git-annex, not linking + - with Cygwin, does not. -} whenM (coreSymlinks <$> Annex.getGitConfig) $ do warning "Disabling core.symlinks." setConfig (ConfigKey "core.symlinks") (Git.Config.boolConfig False) - unlessBare $ do - unlessM isDirect $ do - warning "Enabling direct mode." - top <- fromRepo Git.repoPath - (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] - forM_ l $ \f -> - maybe noop (`toDirect` f) =<< isAnnexLink f - void $ liftIO clean - setDirect True - setVersion directModeVersion - probeFifoSupport :: Annex Bool probeFifoSupport = do #ifdef mingw32_HOST_OS @@ -166,3 +164,12 @@ checkFifoSupport = unlessM probeFifoSupport $ do warning "Detected a filesystem without fifo support." warning "Disabling ssh connection caching." setConfig (annexConfig "sshcaching") (Git.Config.boolConfig False) + +enableDirectMode :: Annex () +enableDirectMode = unlessM isDirect $ do + warning "Enabling direct mode." + top <- fromRepo Git.repoPath + (l, clean) <- inRepo $ Git.LsFiles.inRepo [top] + forM_ l $ \f -> + maybe noop (`toDirect` f) =<< isAnnexLink f + void $ liftIO clean diff --git a/doc/todo/direct_mode_guard.mdwn b/doc/todo/direct_mode_guard.mdwn index 9fbb21cd3..bb7f90897 100644 --- a/doc/todo/direct_mode_guard.mdwn +++ b/doc/todo/direct_mode_guard.mdwn @@ -96,7 +96,10 @@ even when `receive.denyCurrentBranch` is set.) > branch. However, won't work on crippled filesystems! (No +x bit) > > Could make git annex sync detect this. It could reset the master -> branch to the last one committed, before committing. Will work, -> does have the minor oddity that eg `git log` will show commits -> pushed to master before `git annex sync` has been run and so before -> those commits are reflected in the tree. +> branch to the last one committed, before committing. Seems very racy +> and hard to get right! +> +> Could make direct mode operate on a different branch, like +> `annex/direct/master` rather than `master`. Avoid pushing to that +> branch (`git annex sync` can map back from it to `master` and push there +> instead). A bit clumsy, but works. -- cgit v1.2.3 From 0e976c0f1450cdf3b86e72188707cac3bc88e27d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 6 Nov 2013 13:03:23 -0400 Subject: fix merge --- debian/changelog | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/debian/changelog b/debian/changelog index a99b57424..740773fd8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -8,18 +8,6 @@ git-annex (5.20131102) UNRELEASED; urgency=low git annex upgrade * The -c option now not only modifies the git configuration seen by git-annex, but it is passed along to every git command git-annex runs. - * Improve local pairing behavior when two computers both try to start - the pairing process separately. - * sync: Work even when the local git repository is new and empty, - with no master branch. - * gcrypt, bup: Fix bug that prevented using these special remotes - with encryption=pubkey. - * Fix enabling of gcrypt repository accessed over ssh; - git-annex-shell gcryptsetup had a bug that caused it to fail - with permission denied. - * Fix zombie process that occurred when switching between repository - views in the webapp. - * map: Work when there are gcrypt remotes. -- Joey Hess Sat, 02 Nov 2013 14:54:36 -0400 -- cgit v1.2.3 From ff231a2a1b245bd8c460e9bae2dfc308f061096d Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 6 Nov 2013 13:08:15 -0400 Subject: update --- doc/install/Ubuntu.mdwn | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/doc/install/Ubuntu.mdwn b/doc/install/Ubuntu.mdwn index 107a1a8e7..61b1489ff 100644 --- a/doc/install/Ubuntu.mdwn +++ b/doc/install/Ubuntu.mdwn @@ -1,7 +1,17 @@ -## Saucy, Raring +## Saucy sudo apt-get install git-annex +Warning: The version of git-annex shipped in Ubuntu Saucy had +[a bug that can cause problems when creating repositories using the webapp](http://git-annex.branchable.com/bugs/Freshly_initialized_repo_has_staged_change___34__deleted:_uuid.log__34__/). + +## Raring + + sudo apt-get install git-annex + +Note: This version is too old to include the [[assistant]] or its WebApp, +but is otherwise usable. + ## Precise sudo apt-get install git-annex -- cgit v1.2.3 From 2119fb1775999da045d24f0a7d43babcf6bd61dc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 6 Nov 2013 16:10:33 -0400 Subject: adjust test suite to work with and test direct mode guard --- Test.hs | 76 ++++++++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 45 insertions(+), 31 deletions(-) diff --git a/Test.hs b/Test.hs index 93af17585..ae921c950 100644 --- a/Test.hs +++ b/Test.hs @@ -215,12 +215,21 @@ test_add env = "git-annex add" ~: TestList [basic, sha1dup, subdirs] git_annex env "add" [wormannexedfile, "--backend=WORM"] @? "add with WORM failed" annexed_present wormannexedfile checkbackend wormannexedfile backendWORM - boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed" - writeFile ingitfile $ content ingitfile - boolSystem "git" [Param "add", File ingitfile] @? "git add failed" - boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" - git_annex env "add" [ingitfile] @? "add ingitfile should be no-op" - unannexed ingitfile + ifM (annexeval Config.isDirect) + ( do + boolSystem "rm" [Params "-f", File wormannexedfile] @? "rm failed" + writeFile ingitfile $ content ingitfile + not <$> boolSystem "git" [Param "add", File ingitfile] @? "git add failed to fail in direct mode" + boolSystem "rm" [Params "-f", File ingitfile] @? "rm failed" + git_annex env "sync" [] @? "sync failed" + , do + boolSystem "git" [Params "rm --force -q", File wormannexedfile] @? "git rm failed" + writeFile ingitfile $ content ingitfile + boolSystem "git" [Param "add", File ingitfile] @? "git add failed" + boolSystem "git" [Params "commit -q -m commit"] @? "git commit failed" + git_annex env "add" [ingitfile] @? "add ingitfile should be no-op" + unannexed ingitfile + ) sha1dup = TestCase $ intmpclonerepo env $ do writeFile sha1annexedfiledup $ content sha1annexedfiledup git_annex env "add" [sha1annexedfiledup, "--backend=SHA1"] @? "add of second file with same SHA1 failed" @@ -265,8 +274,9 @@ test_unannex env = "git-annex unannex" ~: TestList [nocopy, withcopy] unannexed annexedfile git_annex env "unannex" [annexedfile] @? "unannex failed on non-annexed file" unannexed annexedfile - git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op" - unannexed ingitfile + unlessM (annexeval Config.isDirect) $ do + git_annex env "unannex" [ingitfile] @? "unannex ingitfile should be no-op" + unannexed ingitfile test_drop :: TestEnv -> Test test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedremote] @@ -280,8 +290,9 @@ test_drop env = "git-annex drop" ~: TestList [noremote, withremote, untrustedrem git_annex env "drop" ["--force", annexedfile] @? "drop --force failed" annexed_notpresent annexedfile git_annex env "drop" [annexedfile] @? "drop of dropped file failed" - git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op" - unannexed ingitfile + unlessM (annexeval Config.isDirect) $ do + git_annex env "drop" [ingitfile] @? "drop ingitfile should be no-op" + unannexed ingitfile withremote = "with remote" ~: TestCase $ intmpclonerepo env $ do git_annex env "get" [annexedfile] @? "get failed" annexed_present annexedfile @@ -306,11 +317,12 @@ test_get env = "git-annex get" ~: TestCase $ intmpclonerepo env $ do git_annex env "get" [annexedfile] @? "get of file already here failed" inmainrepo env $ annexed_present annexedfile annexed_present annexedfile - inmainrepo env $ unannexed ingitfile - unannexed ingitfile - git_annex env "get" [ingitfile] @? "get ingitfile should be no-op" - inmainrepo env $ unannexed ingitfile - unannexed ingitfile + unlessM (annexeval Config.isDirect) $ do + inmainrepo env $ unannexed ingitfile + unannexed ingitfile + git_annex env "get" [ingitfile] @? "get ingitfile should be no-op" + inmainrepo env $ unannexed ingitfile + unannexed ingitfile test_move :: TestEnv -> Test test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do @@ -328,14 +340,15 @@ test_move env = "git-annex move" ~: TestCase $ intmpclonerepo env $ do git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" inmainrepo env $ annexed_present annexedfile annexed_notpresent annexedfile - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" - unannexed ingitfile - inmainrepo env $ unannexed ingitfile + unlessM (annexeval Config.isDirect) $ do + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "move" ["--to", "origin", ingitfile] @? "move of ingitfile should be no-op" + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "move" ["--from", "origin", ingitfile] @? "move of ingitfile should be no-op" + unannexed ingitfile + inmainrepo env $ unannexed ingitfile test_copy :: TestEnv -> Test test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do @@ -353,14 +366,15 @@ test_copy env = "git-annex copy" ~: TestCase $ intmpclonerepo env $ do git_annex env "move" ["--to", "origin", annexedfile] @? "move --to of file already there failed" annexed_notpresent annexedfile inmainrepo env $ annexed_present annexedfile - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" - unannexed ingitfile - inmainrepo env $ unannexed ingitfile - git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" - checkregularfile ingitfile - checkcontent ingitfile + unlessM (annexeval Config.isDirect) $ do + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "copy" ["--to", "origin", ingitfile] @? "copy of ingitfile should be no-op" + unannexed ingitfile + inmainrepo env $ unannexed ingitfile + git_annex env "copy" ["--from", "origin", ingitfile] @? "copy of ingitfile should be no-op" + checkregularfile ingitfile + checkcontent ingitfile test_preferred_content :: TestEnv -> Test test_preferred_content env = "git-annex preferred-content" ~: TestCase $ intmpclonerepo env $ do -- cgit v1.2.3 From 8aec790a7aefba4dc2e8e0d219d333c12ad585e3 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 Nov 2013 12:45:59 -0400 Subject: rename status to info, and update docs --- Command/Info.hs | 384 +++++++++++++++++++++ Command/Status.hs | 384 --------------------- GitAnnex.hs | 4 +- debian/changelog | 3 + doc/bare_repositories.mdwn | 2 +- doc/git-annex.mdwn | 14 +- ...Decentralized_repository_behind_a_Firewall.mdwn | 2 +- ...rate_disconnected_directories_to_git_annex.mdwn | 2 +- ...ent_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment | 2 +- 9 files changed, 400 insertions(+), 397 deletions(-) create mode 100644 Command/Info.hs delete mode 100644 Command/Status.hs diff --git a/Command/Info.hs b/Command/Info.hs new file mode 100644 index 000000000..d465f2d84 --- /dev/null +++ b/Command/Info.hs @@ -0,0 +1,384 @@ +{- git-annex command + - + - Copyright 2011 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +{-# LANGUAGE BangPatterns #-} + +module Command.Info where + +import "mtl" Control.Monad.State.Strict +import qualified Data.Map as M +import Text.JSON +import Data.Tuple +import Data.Ord +import System.PosixCompat.Files + +import Common.Annex +import qualified Remote +import qualified Command.Unused +import qualified Git +import qualified Annex +import Command +import Utility.DataUnits +import Utility.DiskFree +import Annex.Content +import Types.Key +import Logs.UUID +import Logs.Trust +import Remote +import Config +import Utility.Percentage +import Logs.Transfer +import Types.TrustLevel +import Types.FileMatcher +import qualified Limit + +-- a named computation that produces a statistic +type Stat = StatState (Maybe (String, StatState String)) + +-- data about a set of keys +data KeyData = KeyData + { countKeys :: Integer + , sizeKeys :: Integer + , unknownSizeKeys :: Integer + , backendsKeys :: M.Map String Integer + } + +data NumCopiesStats = NumCopiesStats + { numCopiesVarianceMap :: M.Map Variance Integer + } + +newtype Variance = Variance Int + deriving (Eq, Ord) + +instance Show Variance where + show (Variance n) + | n >= 0 = "numcopies +" ++ show n + | otherwise = "numcopies " ++ show n + +-- cached info that multiple Stats use +data StatInfo = StatInfo + { presentData :: Maybe KeyData + , referencedData :: Maybe KeyData + , numCopiesStats :: Maybe NumCopiesStats + } + +-- a state monad for running Stats in +type StatState = StateT StatInfo Annex + +def :: [Command] +def = [noCommit $ command "info" paramPaths seek + SectionQuery "shows general information about the annex"] + +seek :: [CommandSeek] +seek = [withWords start] + +start :: [FilePath] -> CommandStart +start [] = do + globalInfo + stop +start ps = do + mapM_ localInfo =<< filterM isdir ps + stop + where + isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) + +globalInfo :: Annex () +globalInfo = do + stats <- selStats global_fast_stats global_slow_stats + showCustom "info" $ do + evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) + return True + +localInfo :: FilePath -> Annex () +localInfo dir = showCustom (unwords ["info", dir]) $ do + stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) + evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir + return True + where + tostats = map (\s -> s dir) + +selStats :: [Stat] -> [Stat] -> Annex [Stat] +selStats fast_stats slow_stats = do + fast <- Annex.getState Annex.fast + return $ if fast + then fast_stats + else fast_stats ++ slow_stats + +{- Order is significant. Less expensive operations, and operations + - that share data go together. + -} +global_fast_stats :: [Stat] +global_fast_stats = + [ repository_mode + , remote_list Trusted + , remote_list SemiTrusted + , remote_list UnTrusted + , transfer_list + , disk_size + ] +global_slow_stats :: [Stat] +global_slow_stats = + [ tmp_size + , bad_data_size + , local_annex_keys + , local_annex_size + , known_annex_files + , known_annex_size + , bloom_info + , backend_usage + ] +local_fast_stats :: [FilePath -> Stat] +local_fast_stats = + [ local_dir + , const local_annex_keys + , const local_annex_size + , const known_annex_files + , const known_annex_size + ] +local_slow_stats :: [FilePath -> Stat] +local_slow_stats = + [ const numcopies_stats + ] + +stat :: String -> (String -> StatState String) -> Stat +stat desc a = return $ Just (desc, a desc) + +nostat :: Stat +nostat = return Nothing + +json :: JSON j => (j -> String) -> StatState j -> String -> StatState String +json serialize a desc = do + j <- a + lift $ maybeShowJSON [(desc, j)] + return $ serialize j + +nojson :: StatState String -> String -> StatState String +nojson a _ = a + +showStat :: Stat -> StatState () +showStat s = maybe noop calc =<< s + where + calc (desc, a) = do + (lift . showHeader) desc + lift . showRaw =<< a + +repository_mode :: Stat +repository_mode = stat "repository mode" $ json id $ lift $ + ifM isDirect + ( return "direct", return "indirect" ) + +remote_list :: TrustLevel -> Stat +remote_list level = stat n $ nojson $ lift $ do + us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) + rs <- fst <$> trustPartition level us + s <- prettyPrintUUIDs n rs + return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s + where + n = showTrustLevel level ++ " repositories" + +local_dir :: FilePath -> Stat +local_dir dir = stat "directory" $ json id $ return dir + +local_annex_keys :: Stat +local_annex_keys = stat "local annex keys" $ json show $ + countKeys <$> cachedPresentData + +local_annex_size :: Stat +local_annex_size = stat "local annex size" $ json id $ + showSizeKeys <$> cachedPresentData + +known_annex_files :: Stat +known_annex_files = stat "annexed files in working tree" $ json show $ + countKeys <$> cachedReferencedData + +known_annex_size :: Stat +known_annex_size = stat "size of annexed files in working tree" $ json id $ + showSizeKeys <$> cachedReferencedData + +tmp_size :: Stat +tmp_size = staleSize "temporary directory size" gitAnnexTmpDir + +bad_data_size :: Stat +bad_data_size = staleSize "bad keys size" gitAnnexBadDir + +bloom_info :: Stat +bloom_info = stat "bloom filter size" $ json id $ do + localkeys <- countKeys <$> cachedPresentData + capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity + let note = aside $ + if localkeys >= capacity + then "appears too small for this repository; adjust annex.bloomcapacity" + else showPercentage 1 (percentage capacity localkeys) ++ " full" + + -- Two bloom filters are used at the same time, so double the size + -- of one. + size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> + lift Command.Unused.bloomBitsHashes + + return $ size ++ note + +transfer_list :: Stat +transfer_list = stat "transfers in progress" $ nojson $ lift $ do + uuidmap <- Remote.remoteMap id + ts <- getTransfers + return $ if null ts + then "none" + else multiLine $ + map (uncurry $ line uuidmap) $ sort ts + where + line uuidmap t i = unwords + [ showLcDirection (transferDirection t) ++ "ing" + , fromMaybe (key2file $ transferKey t) (associatedFile i) + , if transferDirection t == Upload then "to" else "from" + , maybe (fromUUID $ transferUUID t) Remote.name $ + M.lookup (transferUUID t) uuidmap + ] + +disk_size :: Stat +disk_size = stat "available local disk space" $ json id $ lift $ + calcfree + <$> (annexDiskReserve <$> Annex.getGitConfig) + <*> inRepo (getDiskFree . gitAnnexDir) + where + calcfree reserve (Just have) = unwords + [ roughSize storageUnits False $ nonneg $ have - reserve + , "(+" ++ roughSize storageUnits False reserve + , "reserved)" + ] + calcfree _ _ = "unknown" + + nonneg x + | x >= 0 = x + | otherwise = 0 + +backend_usage :: Stat +backend_usage = stat "backend usage" $ nojson $ + calc + <$> (backendsKeys <$> cachedReferencedData) + <*> (backendsKeys <$> cachedPresentData) + where + calc x y = multiLine $ + map (\(n, b) -> b ++ ": " ++ show n) $ + reverse $ sort $ map swap $ M.toList $ + M.unionWith (+) x y + +numcopies_stats :: Stat +numcopies_stats = stat "numcopies stats" $ nojson $ + calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats) + where + calc = multiLine + . map (\(variance, count) -> show variance ++ ": " ++ show count) + . reverse . sortBy (comparing snd) . M.toList + +cachedPresentData :: StatState KeyData +cachedPresentData = do + s <- get + case presentData s of + Just v -> return v + Nothing -> do + v <- foldKeys <$> lift getKeysPresent + put s { presentData = Just v } + return v + +cachedReferencedData :: StatState KeyData +cachedReferencedData = do + s <- get + case referencedData s of + Just v -> return v + Nothing -> do + !v <- lift $ Command.Unused.withKeysReferenced + emptyKeyData addKey + put s { referencedData = Just v } + return v + +-- currently only available for local info +cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) +cachedNumCopiesStats = numCopiesStats <$> get + +getLocalStatInfo :: FilePath -> Annex StatInfo +getLocalStatInfo dir = do + fast <- Annex.getState Annex.fast + matcher <- Limit.getMatcher + (presentdata, referenceddata, numcopiesstats) <- + Command.Unused.withKeysFilesReferencedIn dir initial + (update matcher fast) + return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) + where + initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) + update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = + ifM (matcher $ FileInfo file file) + ( do + !presentdata' <- ifM (inAnnex key) + ( return $ addKey key presentdata + , return presentdata + ) + let !referenceddata' = addKey key referenceddata + !numcopiesstats' <- if fast + then return numcopiesstats + else updateNumCopiesStats key file numcopiesstats + return $! (presentdata', referenceddata', numcopiesstats') + , return vs + ) + +emptyKeyData :: KeyData +emptyKeyData = KeyData 0 0 0 M.empty + +emptyNumCopiesStats :: NumCopiesStats +emptyNumCopiesStats = NumCopiesStats M.empty + +foldKeys :: [Key] -> KeyData +foldKeys = foldl' (flip addKey) emptyKeyData + +addKey :: Key -> KeyData -> KeyData +addKey key (KeyData count size unknownsize backends) = + KeyData count' size' unknownsize' backends' + where + {- All calculations strict to avoid thunks when repeatedly + - applied to many keys. -} + !count' = count + 1 + !backends' = M.insertWith' (+) (keyBackendName key) 1 backends + !size' = maybe size (+ size) ks + !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks + ks = keySize key + +updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats +updateNumCopiesStats key file (NumCopiesStats m) = do + !variance <- Variance <$> numCopiesCheck file key (-) + let !m' = M.insertWith' (+) variance 1 m + let !ret = NumCopiesStats m' + return ret + +showSizeKeys :: KeyData -> String +showSizeKeys d = total ++ missingnote + where + total = roughSize storageUnits False $ sizeKeys d + missingnote + | unknownSizeKeys d == 0 = "" + | otherwise = aside $ + "+ " ++ show (unknownSizeKeys d) ++ + " unknown size" + +staleSize :: String -> (Git.Repo -> FilePath) -> Stat +staleSize label dirspec = go =<< lift (dirKeys dirspec) + where + go [] = nostat + go keys = onsize =<< sum <$> keysizes keys + onsize 0 = nostat + onsize size = stat label $ + json (++ aside "clean up with git-annex unused") $ + return $ roughSize storageUnits False size + keysizes keys = do + dir <- lift $ fromRepo dirspec + liftIO $ forM keys $ \k -> catchDefaultIO 0 $ + fromIntegral . fileSize + <$> getFileStatus (dir keyFile k) + +aside :: String -> String +aside s = " (" ++ s ++ ")" + +multiLine :: [String] -> String +multiLine = concatMap (\l -> "\n\t" ++ l) diff --git a/Command/Status.hs b/Command/Status.hs deleted file mode 100644 index 44d868f6b..000000000 --- a/Command/Status.hs +++ /dev/null @@ -1,384 +0,0 @@ -{- git-annex command - - - - Copyright 2011 Joey Hess - - - - Licensed under the GNU GPL version 3 or higher. - -} - -{-# LANGUAGE BangPatterns #-} - -module Command.Status where - -import "mtl" Control.Monad.State.Strict -import qualified Data.Map as M -import Text.JSON -import Data.Tuple -import Data.Ord -import System.PosixCompat.Files - -import Common.Annex -import qualified Remote -import qualified Command.Unused -import qualified Git -import qualified Annex -import Command -import Utility.DataUnits -import Utility.DiskFree -import Annex.Content -import Types.Key -import Logs.UUID -import Logs.Trust -import Remote -import Config -import Utility.Percentage -import Logs.Transfer -import Types.TrustLevel -import Types.FileMatcher -import qualified Limit - --- a named computation that produces a statistic -type Stat = StatState (Maybe (String, StatState String)) - --- data about a set of keys -data KeyData = KeyData - { countKeys :: Integer - , sizeKeys :: Integer - , unknownSizeKeys :: Integer - , backendsKeys :: M.Map String Integer - } - -data NumCopiesStats = NumCopiesStats - { numCopiesVarianceMap :: M.Map Variance Integer - } - -newtype Variance = Variance Int - deriving (Eq, Ord) - -instance Show Variance where - show (Variance n) - | n >= 0 = "numcopies +" ++ show n - | otherwise = "numcopies " ++ show n - --- cached info that multiple Stats use -data StatInfo = StatInfo - { presentData :: Maybe KeyData - , referencedData :: Maybe KeyData - , numCopiesStats :: Maybe NumCopiesStats - } - --- a state monad for running Stats in -type StatState = StateT StatInfo Annex - -def :: [Command] -def = [noCommit $ command "status" paramPaths seek - SectionQuery "shows status information about the annex"] - -seek :: [CommandSeek] -seek = [withWords start] - -start :: [FilePath] -> CommandStart -start [] = do - globalStatus - stop -start ps = do - mapM_ localStatus =<< filterM isdir ps - stop - where - isdir = liftIO . catchBoolIO . (isDirectory <$$> getFileStatus) - -globalStatus :: Annex () -globalStatus = do - stats <- selStats global_fast_stats global_slow_stats - showCustom "status" $ do - evalStateT (mapM_ showStat stats) (StatInfo Nothing Nothing Nothing) - return True - -localStatus :: FilePath -> Annex () -localStatus dir = showCustom (unwords ["status", dir]) $ do - stats <- selStats (tostats local_fast_stats) (tostats local_slow_stats) - evalStateT (mapM_ showStat stats) =<< getLocalStatInfo dir - return True - where - tostats = map (\s -> s dir) - -selStats :: [Stat] -> [Stat] -> Annex [Stat] -selStats fast_stats slow_stats = do - fast <- Annex.getState Annex.fast - return $ if fast - then fast_stats - else fast_stats ++ slow_stats - -{- Order is significant. Less expensive operations, and operations - - that share data go together. - -} -global_fast_stats :: [Stat] -global_fast_stats = - [ repository_mode - , remote_list Trusted - , remote_list SemiTrusted - , remote_list UnTrusted - , transfer_list - , disk_size - ] -global_slow_stats :: [Stat] -global_slow_stats = - [ tmp_size - , bad_data_size - , local_annex_keys - , local_annex_size - , known_annex_files - , known_annex_size - , bloom_info - , backend_usage - ] -local_fast_stats :: [FilePath -> Stat] -local_fast_stats = - [ local_dir - , const local_annex_keys - , const local_annex_size - , const known_annex_files - , const known_annex_size - ] -local_slow_stats :: [FilePath -> Stat] -local_slow_stats = - [ const numcopies_stats - ] - -stat :: String -> (String -> StatState String) -> Stat -stat desc a = return $ Just (desc, a desc) - -nostat :: Stat -nostat = return Nothing - -json :: JSON j => (j -> String) -> StatState j -> String -> StatState String -json serialize a desc = do - j <- a - lift $ maybeShowJSON [(desc, j)] - return $ serialize j - -nojson :: StatState String -> String -> StatState String -nojson a _ = a - -showStat :: Stat -> StatState () -showStat s = maybe noop calc =<< s - where - calc (desc, a) = do - (lift . showHeader) desc - lift . showRaw =<< a - -repository_mode :: Stat -repository_mode = stat "repository mode" $ json id $ lift $ - ifM isDirect - ( return "direct", return "indirect" ) - -remote_list :: TrustLevel -> Stat -remote_list level = stat n $ nojson $ lift $ do - us <- M.keys <$> (M.union <$> uuidMap <*> remoteMap Remote.name) - rs <- fst <$> trustPartition level us - s <- prettyPrintUUIDs n rs - return $ if null s then "0" else show (length rs) ++ "\n" ++ beginning s - where - n = showTrustLevel level ++ " repositories" - -local_dir :: FilePath -> Stat -local_dir dir = stat "directory" $ json id $ return dir - -local_annex_keys :: Stat -local_annex_keys = stat "local annex keys" $ json show $ - countKeys <$> cachedPresentData - -local_annex_size :: Stat -local_annex_size = stat "local annex size" $ json id $ - showSizeKeys <$> cachedPresentData - -known_annex_files :: Stat -known_annex_files = stat "annexed files in working tree" $ json show $ - countKeys <$> cachedReferencedData - -known_annex_size :: Stat -known_annex_size = stat "size of annexed files in working tree" $ json id $ - showSizeKeys <$> cachedReferencedData - -tmp_size :: Stat -tmp_size = staleSize "temporary directory size" gitAnnexTmpDir - -bad_data_size :: Stat -bad_data_size = staleSize "bad keys size" gitAnnexBadDir - -bloom_info :: Stat -bloom_info = stat "bloom filter size" $ json id $ do - localkeys <- countKeys <$> cachedPresentData - capacity <- fromIntegral <$> lift Command.Unused.bloomCapacity - let note = aside $ - if localkeys >= capacity - then "appears too small for this repository; adjust annex.bloomcapacity" - else showPercentage 1 (percentage capacity localkeys) ++ " full" - - -- Two bloom filters are used at the same time, so double the size - -- of one. - size <- roughSize memoryUnits False . (* 2) . fromIntegral . fst <$> - lift Command.Unused.bloomBitsHashes - - return $ size ++ note - -transfer_list :: Stat -transfer_list = stat "transfers in progress" $ nojson $ lift $ do - uuidmap <- Remote.remoteMap id - ts <- getTransfers - return $ if null ts - then "none" - else multiLine $ - map (uncurry $ line uuidmap) $ sort ts - where - line uuidmap t i = unwords - [ showLcDirection (transferDirection t) ++ "ing" - , fromMaybe (key2file $ transferKey t) (associatedFile i) - , if transferDirection t == Upload then "to" else "from" - , maybe (fromUUID $ transferUUID t) Remote.name $ - M.lookup (transferUUID t) uuidmap - ] - -disk_size :: Stat -disk_size = stat "available local disk space" $ json id $ lift $ - calcfree - <$> (annexDiskReserve <$> Annex.getGitConfig) - <*> inRepo (getDiskFree . gitAnnexDir) - where - calcfree reserve (Just have) = unwords - [ roughSize storageUnits False $ nonneg $ have - reserve - , "(+" ++ roughSize storageUnits False reserve - , "reserved)" - ] - calcfree _ _ = "unknown" - - nonneg x - | x >= 0 = x - | otherwise = 0 - -backend_usage :: Stat -backend_usage = stat "backend usage" $ nojson $ - calc - <$> (backendsKeys <$> cachedReferencedData) - <*> (backendsKeys <$> cachedPresentData) - where - calc x y = multiLine $ - map (\(n, b) -> b ++ ": " ++ show n) $ - reverse $ sort $ map swap $ M.toList $ - M.unionWith (+) x y - -numcopies_stats :: Stat -numcopies_stats = stat "numcopies stats" $ nojson $ - calc <$> (maybe M.empty numCopiesVarianceMap <$> cachedNumCopiesStats) - where - calc = multiLine - . map (\(variance, count) -> show variance ++ ": " ++ show count) - . reverse . sortBy (comparing snd) . M.toList - -cachedPresentData :: StatState KeyData -cachedPresentData = do - s <- get - case presentData s of - Just v -> return v - Nothing -> do - v <- foldKeys <$> lift getKeysPresent - put s { presentData = Just v } - return v - -cachedReferencedData :: StatState KeyData -cachedReferencedData = do - s <- get - case referencedData s of - Just v -> return v - Nothing -> do - !v <- lift $ Command.Unused.withKeysReferenced - emptyKeyData addKey - put s { referencedData = Just v } - return v - --- currently only available for local status -cachedNumCopiesStats :: StatState (Maybe NumCopiesStats) -cachedNumCopiesStats = numCopiesStats <$> get - -getLocalStatInfo :: FilePath -> Annex StatInfo -getLocalStatInfo dir = do - fast <- Annex.getState Annex.fast - matcher <- Limit.getMatcher - (presentdata, referenceddata, numcopiesstats) <- - Command.Unused.withKeysFilesReferencedIn dir initial - (update matcher fast) - return $ StatInfo (Just presentdata) (Just referenceddata) (Just numcopiesstats) - where - initial = (emptyKeyData, emptyKeyData, emptyNumCopiesStats) - update matcher fast key file vs@(presentdata, referenceddata, numcopiesstats) = - ifM (matcher $ FileInfo file file) - ( do - !presentdata' <- ifM (inAnnex key) - ( return $ addKey key presentdata - , return presentdata - ) - let !referenceddata' = addKey key referenceddata - !numcopiesstats' <- if fast - then return numcopiesstats - else updateNumCopiesStats key file numcopiesstats - return $! (presentdata', referenceddata', numcopiesstats') - , return vs - ) - -emptyKeyData :: KeyData -emptyKeyData = KeyData 0 0 0 M.empty - -emptyNumCopiesStats :: NumCopiesStats -emptyNumCopiesStats = NumCopiesStats M.empty - -foldKeys :: [Key] -> KeyData -foldKeys = foldl' (flip addKey) emptyKeyData - -addKey :: Key -> KeyData -> KeyData -addKey key (KeyData count size unknownsize backends) = - KeyData count' size' unknownsize' backends' - where - {- All calculations strict to avoid thunks when repeatedly - - applied to many keys. -} - !count' = count + 1 - !backends' = M.insertWith' (+) (keyBackendName key) 1 backends - !size' = maybe size (+ size) ks - !unknownsize' = maybe (unknownsize + 1) (const unknownsize) ks - ks = keySize key - -updateNumCopiesStats :: Key -> FilePath -> NumCopiesStats -> Annex NumCopiesStats -updateNumCopiesStats key file (NumCopiesStats m) = do - !variance <- Variance <$> numCopiesCheck file key (-) - let !m' = M.insertWith' (+) variance 1 m - let !ret = NumCopiesStats m' - return ret - -showSizeKeys :: KeyData -> String -showSizeKeys d = total ++ missingnote - where - total = roughSize storageUnits False $ sizeKeys d - missingnote - | unknownSizeKeys d == 0 = "" - | otherwise = aside $ - "+ " ++ show (unknownSizeKeys d) ++ - " unknown size" - -staleSize :: String -> (Git.Repo -> FilePath) -> Stat -staleSize label dirspec = go =<< lift (dirKeys dirspec) - where - go [] = nostat - go keys = onsize =<< sum <$> keysizes keys - onsize 0 = nostat - onsize size = stat label $ - json (++ aside "clean up with git-annex unused") $ - return $ roughSize storageUnits False size - keysizes keys = do - dir <- lift $ fromRepo dirspec - liftIO $ forM keys $ \k -> catchDefaultIO 0 $ - fromIntegral . fileSize - <$> getFileStatus (dir keyFile k) - -aside :: String -> String -aside s = " (" ++ s ++ ")" - -multiLine :: [String] -> String -multiLine = concatMap (\l -> "\n\t" ++ l) diff --git a/GitAnnex.hs b/GitAnnex.hs index b73cd9416..0bd48e0df 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -46,7 +46,7 @@ import qualified Command.Whereis import qualified Command.List import qualified Command.Log import qualified Command.Merge -import qualified Command.Status +import qualified Command.Info import qualified Command.Migrate import qualified Command.Uninit import qualified Command.Trust @@ -140,7 +140,7 @@ cmds = concat , Command.List.def , Command.Log.def , Command.Merge.def - , Command.Status.def + , Command.Info.def , Command.Migrate.def , Command.Map.def , Command.Direct.def diff --git a/debian/changelog b/debian/changelog index 740773fd8..1429f327c 100644 --- a/debian/changelog +++ b/debian/changelog @@ -6,6 +6,9 @@ git-annex (5.20131102) UNRELEASED; urgency=low * annex.version is now set to 5 for direct mode repositories. This upgrade is handled fully automatically, no need to run git annex upgrade + * The "status" command has been renamed to "info", to allow + "git annex status" to be used in direct mode repositories, now that + "git status" won't work in them. * The -c option now not only modifies the git configuration seen by git-annex, but it is passed along to every git command git-annex runs. diff --git a/doc/bare_repositories.mdwn b/doc/bare_repositories.mdwn index 7fa035985..975a638b8 100644 --- a/doc/bare_repositories.mdwn +++ b/doc/bare_repositories.mdwn @@ -39,7 +39,7 @@ Now configure the remote and do the initial push: git remote add origin example.com:bare-annex.git git push origin master git-annex -Now `git annex status` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) +Now `git annex info` should show the configured bare remote. If it does not, you may have to pull from the remote first (older versions of `git-annex`) If you wish to configure git such that you can push/pull without arguments, set the upstream branch: diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index fd22fc672..4aeeb8ad5 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -607,23 +607,23 @@ subdirectories). To generate output suitable for the gource visualisation program, specify `--gource`. -* `status [directory ...]` +* `info [directory ...]` Displays some statistics and other information, including how much data is in the annex and a list of all known repositories. To only show the data that can be gathered quickly, use `--fast`. - When a directory is specified, shows a differently formatted status + When a directory is specified, shows a differently formatted info display for that directory. In this mode, all of the file matching options can be used to filter the files that will be included in - the status. + the information. For example, suppose you want to run "git annex get .", but would first like to see how much disk space that will use. Then run: - git annex status --fast . --not --in here + git annex info --fast . --not --in here * `map` @@ -797,7 +797,7 @@ subdirectories). Rather than the normal output, generate JSON. This is intended to be parsed by programs that use git-annex. Each line of output is a JSON object. Note that json output is only usable with some git-annex commands, - like status and find. + like info and find. * `--debug` @@ -1097,7 +1097,7 @@ Here are all the supported configuration settings. up to 500000 keys. If your repository is larger than that, you can adjust this to avoid `git annex unused` not noticing some unused data files. Increasing this will make `git-annex unused` consume more memory; - run `git annex status` for memory usage numbers. + run `git annex info` for memory usage numbers. * `annex.bloomaccuracy` @@ -1105,7 +1105,7 @@ Here are all the supported configuration settings. `git annex unused`. The default accuracy is 1000 -- 1 unused file out of 1000 will be missed by `git annex unused`. Increasing the accuracy will make `git annex unused` consume more memory; - run `git annex status` for memory usage numbers. + run `git annex info` for memory usage numbers. * `annex.sshcaching` diff --git a/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn b/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn index 6a9eb241b..9e347c73f 100644 --- a/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn +++ b/doc/tips/Decentralized_repository_behind_a_Firewall.mdwn @@ -25,7 +25,7 @@ Now you can run normal annex operations, as long as the port forwarding shell is git annex sync git annex get on-the-go some/big/file - git annex status + git annex info You can add more computers by repeating with a different port, e.g. 2202 or 2203 (or any other). diff --git a/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn b/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn index 7bddd64b9..1209d1217 100644 --- a/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn +++ b/doc/tips/migrating_two_seperate_disconnected_directories_to_git_annex.mdwn @@ -31,7 +31,7 @@ On `angela`, we want to synchronise the git annex metadata with `marcos`. We nee git init git remote add marcos marcos.example.com:/srv/mp3 git fetch marcos - git annex status # this should display the two repos + git annex info # this should display the two repos git annex add . This will, again, checksum all files and add them to git annex. Once that is done, you can verify that the files are really the same as marcos with `whereis`: diff --git a/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment b/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment index 3a88e855e..4c3e3c22b 100644 --- a/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment +++ b/doc/tips/yet_another_simple_disk_usage_like_utility/comment_1_41b212bde8bc88d2a5dea93bd0dc75f1._comment @@ -4,6 +4,6 @@ subject="comment 1" date="2013-07-12T19:36:28Z" content=""" -Ah, I just found that git annex status can do the same :) +Ah, I just found that git annex info can do the same :) Disregard this. """]] -- cgit v1.2.3 From ff03a89236956904b617e02468102e5d390306bd Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 7 Nov 2013 13:55:36 -0400 Subject: add new status command This works for both direct and indirect mode. It may need some performance tuning. Note that unlike git status, it only shows the status of the work tree, not the status of the index. So only one status letter, not two .. and since files that have been added and not yet committed do not differ between the work tree and the index, they are not shown. Might want to add display of the index vs the last commit eventually. This commit was sponsored by an unknown bitcoin contributor, whose contribution as been going up lately! ;) --- Annex/CatFile.hs | 8 ++--- Command/Status.hs | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ Git/LsFiles.hs | 7 +++++ Git/Ref.hs | 14 +++++++++ GitAnnex.hs | 2 ++ doc/git-annex.mdwn | 14 ++++++--- 6 files changed, 125 insertions(+), 9 deletions(-) create mode 100644 Command/Status.hs diff --git a/Annex/CatFile.hs b/Annex/CatFile.hs index 407b4ddae..812d032c6 100644 --- a/Annex/CatFile.hs +++ b/Annex/CatFile.hs @@ -27,6 +27,7 @@ import qualified Annex import Git.Types import Git.FilePath import Git.FileMode +import qualified Git.Ref catFile :: Git.Branch -> FilePath -> Annex L.ByteString catFile branch file = do @@ -108,9 +109,6 @@ catKeyChecked needhead ref@(Ref r) = map snd . filter (\p -> fst p == file) {- From a file in the repository back to the key. - - - - Prefixing the file with ./ makes this work even if in a subdirectory - - of a repo. - - Ideally, this should reflect the key that's staged in the index, - not the key that's committed to HEAD. Unfortunately, git cat-file @@ -134,8 +132,8 @@ catKeyChecked needhead ref@(Ref r) = catKeyFile :: FilePath -> Annex (Maybe Key) catKeyFile f = ifM (Annex.getState Annex.daemon) ( catKeyFileHEAD f - , catKeyChecked True (Ref $ ":./" ++ f) + , catKeyChecked True $ Git.Ref.fileRef f ) catKeyFileHEAD :: FilePath -> Annex (Maybe Key) -catKeyFileHEAD f = catKeyChecked False (Ref $ "HEAD:./" ++ f) +catKeyFileHEAD f = catKeyChecked False $ Git.Ref.fileFromRef Git.Ref.headRef f diff --git a/Command/Status.hs b/Command/Status.hs new file mode 100644 index 000000000..fa478f928 --- /dev/null +++ b/Command/Status.hs @@ -0,0 +1,89 @@ +{- git-annex command + - + - Copyright 2013 Joey Hess + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Command.Status where + +import Common.Annex +import Command +import Annex.CatFile +import Annex.Content.Direct +import Config +import qualified Git.LsFiles as LsFiles +import qualified Git.Ref +import qualified Git + +def :: [Command] +def = [noCommit $ noMessages $ + command "status" paramPaths seek SectionCommon + "show the working tree status"] + +seek :: [CommandSeek] +seek = + [ withWords start + ] + +start :: [FilePath] -> CommandStart +start [] = do + -- Like git status, when run without a directory, behave as if + -- given the path to the top of the repository. + cwd <- liftIO getCurrentDirectory + top <- fromRepo Git.repoPath + next $ perform [relPathDirToFile cwd top] +start locs = next $ perform locs + +perform :: [FilePath] -> CommandPerform +perform locs = do + (l, cleanup) <- inRepo $ LsFiles.modifiedOthers locs + getstatus <- ifM isDirect + ( return statusDirect + , return $ Just <$$> statusIndirect + ) + forM_ l $ \f -> maybe noop (showFileStatus f) =<< getstatus f + void $ liftIO cleanup + next $ return True + +data Status + = NewFile + | DeletedFile + | ModifiedFile + +showStatus :: Status -> String +showStatus NewFile = "?" +showStatus DeletedFile = "D" +showStatus ModifiedFile = "M" + +showFileStatus :: FilePath -> Status -> Annex () +showFileStatus f s = liftIO $ putStrLn $ showStatus s ++ " " ++ f + +statusDirect :: FilePath -> Annex (Maybe Status) +statusDirect f = checkstatus =<< liftIO (catchMaybeIO $ getFileStatus f) + where + checkstatus Nothing = return $ Just DeletedFile + checkstatus (Just s) + -- Git thinks that present direct mode files modifed, + -- so have to check. + | not (isSymbolicLink s) = checkkey s =<< catKeyFile f + | otherwise = Just <$> checkNew f + + checkkey s (Just k) = ifM (sameFileStatus k s) + ( return Nothing + , return $ Just ModifiedFile + ) + checkkey _ Nothing = Just <$> checkNew f + +statusIndirect :: FilePath -> Annex Status +statusIndirect f = ifM (liftIO $ isJust <$> catchMaybeIO (getFileStatus f)) + ( checkNew f + , return DeletedFile + ) + where + +checkNew :: FilePath -> Annex Status +checkNew f = ifM (isJust <$> catObjectDetails (Git.Ref.fileRef f)) + ( return ModifiedFile + , return NewFile + ) diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs index 98cbac58e..8aaa09067 100644 --- a/Git/LsFiles.hs +++ b/Git/LsFiles.hs @@ -11,6 +11,7 @@ module Git.LsFiles ( allFiles, deleted, modified, + modifiedOthers, staged, stagedNotDeleted, stagedOthersDetails, @@ -65,6 +66,12 @@ modified l repo = pipeNullSplit params repo where params = [Params "ls-files --modified -z --"] ++ map File l +{- Files that have been modified or are not checked into git. -} +modifiedOthers :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) +modifiedOthers l repo = pipeNullSplit params repo + where + params = [Params "ls-files --modified --others -z --"] ++ map File l + {- Returns a list of all files that are staged for commit. -} staged :: [FilePath] -> Repo -> IO ([FilePath], IO Bool) staged = staged' [] diff --git a/Git/Ref.hs b/Git/Ref.hs index 5057180d1..6ce1b8784 100644 --- a/Git/Ref.hs +++ b/Git/Ref.hs @@ -41,6 +41,20 @@ under dir r = Ref $ dir ++ "/" ++ underBase :: String -> Ref -> Ref underBase dir r = Ref $ dir ++ "/" ++ show (base r) +{- A Ref that can be used to refer to a file in the repository, as staged + - in the index. + - + - Prefixing the file with ./ makes this work even if in a subdirectory + - of a repo. + -} +fileRef :: FilePath -> Ref +fileRef f = Ref $ ":./" ++ f + +{- A Ref that can be used to refer to a file in the repository as it + - appears in a given Ref. -} +fileFromRef :: Ref -> FilePath -> Ref +fileFromRef (Ref r) f = let (Ref fr) = fileRef f in Ref (r ++ fr) + {- Checks if a ref exists. -} exists :: Ref -> Repo -> IO Bool exists ref = runBool diff --git a/GitAnnex.hs b/GitAnnex.hs index 0bd48e0df..9580c240e 100644 --- a/GitAnnex.hs +++ b/GitAnnex.hs @@ -47,6 +47,7 @@ import qualified Command.List import qualified Command.Log import qualified Command.Merge import qualified Command.Info +import qualified Command.Status import qualified Command.Migrate import qualified Command.Uninit import qualified Command.Trust @@ -141,6 +142,7 @@ cmds = concat , Command.Log.def , Command.Merge.def , Command.Info.def + , Command.Status.def , Command.Migrate.def , Command.Map.def , Command.Direct.def diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 4aeeb8ad5..25b69930e 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -103,6 +103,13 @@ subdirectories). To avoid contacting the remote to check if it has every file, specify `--fast` +* `status` [path ...]` + + Similar to `git status --short`, displays the status of the files in the + working tree. Shows files that are not checked into git, files that + have been deleted, and files that have been modified. + Particulary useful in direct mode. + * `unlock [path ...]` Normally, the content of annexed files is protected from being changed. @@ -563,10 +570,6 @@ subdirectories). # QUERY COMMANDS -* `version` - - Shows the version of git-annex, as well as repository version information. - * `find [path ...]` Outputs a list of annexed files in the specified path. With no path, @@ -624,6 +627,9 @@ subdirectories). Then run: git annex info --fast . --not --in here +* `version` + + Shows the version of git-annex, as well as repository version information. * `map` -- cgit v1.2.3