diff options
| -rw-r--r-- | Branch.hs | 32 | ||||
| -rw-r--r-- | CmdLine.hs | 22 | ||||
| -rw-r--r-- | Command/Init.hs | 38 | ||||
| -rw-r--r-- | Command/Uninit.hs | 17 | ||||
| -rw-r--r-- | Init.hs | 69 | ||||
| -rw-r--r-- | Version.hs | 6 | ||||
| -rw-r--r-- | debian/changelog | 9 |
7 files changed, 127 insertions, 66 deletions
@@ -14,6 +14,7 @@ module Branch ( files, refExists, hasOrigin, + hasSomeBranch, name ) where @@ -124,7 +125,7 @@ getCache file = getState >>= handle {- Creates the branch, if it does not already exist. -} create :: Annex () -create = unlessM (refExists fullname) $ do +create = unlessM hasBranch $ do g <- Annex.gitRepo e <- hasOrigin if e @@ -154,19 +155,14 @@ update = do -} staged <- stageJournalFiles - g <- Annex.gitRepo - r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name] - let refs = map (last . words) (lines r) + refs <- siblingBranches updated <- catMaybes `liftM` mapM updateRef refs + g <- Annex.gitRepo unless (null updated && not staged) $ liftIO $ Git.commit g "update" fullname (fullname:updated) Annex.changeState $ \s -> s { Annex.branchstate = state { branchUpdated = True } } invalidateCache -{- Does origin/git-annex exist? -} -hasOrigin :: Annex Bool -hasOrigin = refExists originname - {- Checks if a git ref exists. -} refExists :: GitRef -> Annex Bool refExists ref = do @@ -174,6 +170,26 @@ refExists ref = do liftIO $ Git.runBool g "show-ref" [Param "--verify", Param "-q", Param ref] +{- Does the main git-annex branch exist? -} +hasBranch :: Annex Bool +hasBranch = refExists fullname + +{- Does origin/git-annex exist? -} +hasOrigin :: Annex Bool +hasOrigin = refExists originname + +{- Does the git-annex branch or a foo/git-annex branch exist? -} +hasSomeBranch :: Annex Bool +hasSomeBranch = liftM (not . null) siblingBranches + +{- List of all git-annex branches, including the main one and any + - from remotes. -} +siblingBranches :: Annex [String] +siblingBranches = do + g <- Annex.gitRepo + r <- liftIO $ Git.pipeRead g [Param "show-ref", Param name] + return $ map (last . words) (lines r) + {- Ensures that a given ref has been merged into the index. -} updateRef :: GitRef -> Annex (Maybe String) updateRef ref diff --git a/CmdLine.hs b/CmdLine.hs index c33c49785..ff1758f0d 100644 --- a/CmdLine.hs +++ b/CmdLine.hs @@ -19,13 +19,14 @@ import Control.Monad (when) import qualified Annex import qualified AnnexQueue import qualified Git +import qualified Branch import Content import Types import Command import Version import Options import Messages -import UUID +import Init {- Runs the passed command line. -} dispatch :: [String] -> [Command] -> [Option] -> String -> Git.Repo -> IO () @@ -45,7 +46,7 @@ parseCmd argv header cmds options = do [] -> error $ "unknown command" ++ usagemsg [command] -> do _ <- sequence flags - when (cmdusesrepo command) checkVersion + checkCmdEnviron command prepCommand command (drop 1 params) _ -> error "internal error: multiple matching commands" where @@ -57,6 +58,19 @@ parseCmd argv header cmds options = do lookupCmd cmd = filter (\c -> cmd == cmdname c) cmds usagemsg = "\n\n" ++ usage header cmds options +{- Checks that the command can be run in the current environment. -} +checkCmdEnviron :: Command -> Annex () +checkCmdEnviron command = do + when (cmdusesrepo command) $ checkVersion $ do + {- 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. -} + annexed <- Branch.hasSomeBranch + if annexed + then initialize + else error "First run: git-annex init" + {- Usage message with lists of commands and options. -} usage :: String -> [Command] -> [Option] -> String usage header cmds options = @@ -95,9 +109,7 @@ tryRun' errnum _ [] = when (errnum > 0) $ error $ show errnum ++ " failed" {- Actions to perform each time ran. -} startup :: Annex Bool -startup = do - prepUUID - return True +startup = return True {- Cleanup actions. -} shutdown :: Annex Bool diff --git a/Command/Init.hs b/Command/Init.hs index 71e87050d..019106051 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -7,19 +7,13 @@ module Command.Init where -import Control.Monad.State (liftIO) -import Control.Monad (when, unless) -import System.Directory +import Control.Monad (when) import Command import qualified Annex -import qualified Git -import qualified Branch import UUID -import Version import Messages -import Types -import Utility +import Init command :: [Command] command = [standaloneCommand "init" paramDesc seek @@ -39,34 +33,8 @@ start ws = do perform :: String -> CommandPerform perform description = do - Branch.create + initialize g <- Annex.gitRepo u <- getUUID g - setVersion describeUUID u description - unless (Git.repoIsLocalBare g) $ - gitPreCommitHookWrite g next $ return True - -{- set up a git pre-commit hook, if one is not already present -} -gitPreCommitHookWrite :: Git.Repo -> Annex () -gitPreCommitHookWrite repo = do - exists <- liftIO $ doesFileExist hook - if exists - then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring" - else liftIO $ do - viaTmp writeFile hook preCommitScript - p <- getPermissions hook - setPermissions hook $ p {executable = True} - where - hook = preCommitHook repo - -preCommitHook :: Git.Repo -> FilePath -preCommitHook repo = - Git.workTree repo ++ "/" ++ Git.gitDir repo ++ "/hooks/pre-commit" - -preCommitScript :: String -preCommitScript = - "#!/bin/sh\n" ++ - "# automatically configured by git-annex\n" ++ - "git annex pre-commit .\n" diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 8b8d7e364..195246aa8 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -12,13 +12,11 @@ import System.Directory import System.Exit import Command -import Messages -import Types import Utility import qualified Git import qualified Annex import qualified Command.Unannex -import qualified Command.Init +import Init import qualified Branch import Content import Locations @@ -47,7 +45,7 @@ perform = next cleanup cleanup :: CommandCleanup cleanup = do g <- Annex.gitRepo - gitPreCommitHookUnWrite g + uninitialize mapM_ removeAnnex =<< getKeysPresent liftIO $ removeDirectoryRecursive (gitAnnexDir g) -- avoid normal shutdown @@ -55,14 +53,3 @@ cleanup = do liftIO $ do Git.run g "branch" [Param "-D", Param Branch.name] exitSuccess - -gitPreCommitHookUnWrite :: Git.Repo -> Annex () -gitPreCommitHookUnWrite repo = do - let hook = Command.Init.preCommitHook repo - whenM (liftIO $ doesFileExist hook) $ do - c <- liftIO $ readFile hook - if c == Command.Init.preCommitScript - then liftIO $ removeFile hook - else warning $ "pre-commit hook (" ++ hook ++ - ") contents modified; not deleting." ++ - " Edit it to remove call to git annex." diff --git a/Init.hs b/Init.hs new file mode 100644 index 000000000..41256a953 --- /dev/null +++ b/Init.hs @@ -0,0 +1,69 @@ +{- git-annex repository initialization + - + - Copyright 2010 Joey Hess <joey@kitenet.net> + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Init (initialize, uninitialize) where + +import Control.Monad.State (liftIO) +import Control.Monad (unless) +import System.Directory + +import qualified Annex +import qualified Git +import qualified Branch +import Version +import Messages +import Types +import Utility +import UUID + +initialize :: Annex () +initialize = do + prepUUID + Branch.create + setVersion + g <- Annex.gitRepo + unless (Git.repoIsLocalBare g) $ + gitPreCommitHookWrite g + +uninitialize :: Annex () +uninitialize = do + g <- Annex.gitRepo + gitPreCommitHookUnWrite g + +{- set up a git pre-commit hook, if one is not already present -} +gitPreCommitHookWrite :: Git.Repo -> Annex () +gitPreCommitHookWrite repo = do + exists <- liftIO $ doesFileExist hook + if exists + then warning $ "pre-commit hook (" ++ hook ++ ") already exists, not configuring" + else liftIO $ do + viaTmp writeFile hook preCommitScript + p <- getPermissions hook + setPermissions hook $ p {executable = True} + where + hook = preCommitHook repo + +gitPreCommitHookUnWrite :: Git.Repo -> Annex () +gitPreCommitHookUnWrite repo = do + let hook = preCommitHook repo + whenM (liftIO $ doesFileExist hook) $ do + c <- liftIO $ readFile hook + if c == preCommitScript + then liftIO $ removeFile hook + else warning $ "pre-commit hook (" ++ hook ++ + ") contents modified; not deleting." ++ + " Edit it to remove call to git annex." + +preCommitHook :: Git.Repo -> FilePath +preCommitHook repo = + Git.workTree repo ++ "/" ++ Git.gitDir repo ++ "/hooks/pre-commit" + +preCommitScript :: String +preCommitScript = + "#!/bin/sh\n" ++ + "# automatically configured by git-annex\n" ++ + "git annex pre-commit .\n" diff --git a/Version.hs b/Version.hs index 7e6910fbe..44fd2e9de 100644 --- a/Version.hs +++ b/Version.hs @@ -39,10 +39,10 @@ getVersion = do setVersion :: Annex () setVersion = setConfig versionField defaultVersion -checkVersion :: Annex () -checkVersion = getVersion >>= handle +checkVersion :: Annex () -> Annex () +checkVersion initaction = getVersion >>= handle where - handle Nothing = error "First run: git-annex init" + handle Nothing = initaction handle (Just v) = unless (v `elem` supportedVersions) $ error $ "Repository version " ++ v ++ " is not supported. " ++ diff --git a/debian/changelog b/debian/changelog index 3eab43578..9230c0021 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,12 @@ +git-annex (3.20110818) UNRELEASED; urgency=low + + * Now "git annex init" only has to be run once, when a git repository + is first being created. Clones will automatically notice that git-annex + is in use and automatically perform a basic initalization. It's + still recommended to run "git annex init" in any clones, to describe them. + + -- Joey Hess <joeyh@debian.org> Wed, 17 Aug 2011 13:44:44 -0400 + git-annex (3.20110817) unstable; urgency=low * Fix shell escaping in rsync special remote. |