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.
This commit is contained in:
Joey Hess 2011-08-17 14:14:43 -04:00
parent 3b5f722130
commit 56f6923ccb
7 changed files with 127 additions and 66 deletions

View file

@ -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

View file

@ -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

View file

@ -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"

View file

@ -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."

69
Init.hs Normal file
View file

@ -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"

View file

@ -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. " ++

9
debian/changelog vendored
View file

@ -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.