when reading configs of local repos, first initializeSafe

This auto-generates a uuid if the local repo does not already have one.
This commit is contained in:
Joey Hess 2011-08-17 14:36:20 -04:00
parent cf33eff684
commit 32f27cc3e8
3 changed files with 34 additions and 25 deletions

View file

@ -19,7 +19,6 @@ import Control.Monad (when)
import qualified Annex import qualified Annex
import qualified AnnexQueue import qualified AnnexQueue
import qualified Git import qualified Git
import qualified Branch
import Content import Content
import Types import Types
import Command import Command
@ -60,16 +59,7 @@ parseCmd argv header cmds options = do
{- Checks that the command can be run in the current environment. -} {- Checks that the command can be run in the current environment. -}
checkCmdEnviron :: Command -> Annex () checkCmdEnviron :: Command -> Annex ()
checkCmdEnviron command = do checkCmdEnviron command = when (cmdusesrepo command) $ checkVersion $ initializeSafe
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 message with lists of commands and options. -}
usage :: String -> [Command] -> [Option] -> String usage :: String -> [Command] -> [Option] -> String

17
Init.hs
View file

@ -5,7 +5,11 @@
- Licensed under the GNU GPL version 3 or higher. - Licensed under the GNU GPL version 3 or higher.
-} -}
module Init (initialize, uninitialize) where module Init (
initialize,
initializeSafe,
uninitialize
) where
import Control.Monad.State (liftIO) import Control.Monad.State (liftIO)
import Control.Monad (unless) import Control.Monad (unless)
@ -34,6 +38,17 @@ uninitialize = do
g <- Annex.gitRepo g <- Annex.gitRepo
gitPreCommitHookUnWrite g gitPreCommitHookUnWrite g
{- Call to 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. -}
initializeSafe :: Annex ()
initializeSafe = do
annexed <- Branch.hasSomeBranch
if annexed
then initialize
else error "First run: git-annex init"
{- set up a git pre-commit hook, if one is not already present -} {- set up a git pre-commit hook, if one is not already present -}
gitPreCommitHookWrite :: Git.Repo -> Annex () gitPreCommitHookWrite :: Git.Repo -> Annex ()
gitPreCommitHookWrite repo = do gitPreCommitHookWrite repo = do

View file

@ -28,6 +28,7 @@ import Utility.RsyncFile
import Remote.Helper.Ssh import Remote.Helper.Ssh
import qualified Remote.Helper.Url as Url import qualified Remote.Helper.Url as Url
import Config import Config
import Init
remote :: RemoteType Annex remote :: RemoteType Annex
remote = RemoteType { remote = RemoteType {
@ -79,7 +80,9 @@ tryGitConfigRead r
| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
| Git.repoIsHttp r = store $ safely $ geturlconfig | Git.repoIsHttp r = store $ safely $ geturlconfig
| Git.repoIsUrl r = return r | Git.repoIsUrl r = return r
| otherwise = store $ safely $ Git.configRead r | otherwise = store $ safely $ do
onLocal r initializeSafe
Git.configRead r
where where
-- Reading config can fail due to IO error or -- Reading config can fail due to IO error or
-- for other reasons; catch all possible exceptions. -- for other reasons; catch all possible exceptions.
@ -124,11 +127,7 @@ inAnnex r key
| Git.repoIsUrl r = checkremote | Git.repoIsUrl r = checkremote
| otherwise = safely checklocal | otherwise = safely checklocal
where where
checklocal = do checklocal = onLocal r (Content.inAnnex key)
-- run a local check inexpensively,
-- by making an Annex monad using the remote
a <- Annex.new r
Annex.eval a (Content.inAnnex key)
checkremote = do checkremote = do
showAction $ "checking " ++ Git.repoDescribe r showAction $ "checking " ++ Git.repoDescribe r
inannex <- onRemote r (boolSystem, False) "inannex" inannex <- onRemote r (boolSystem, False) "inannex"
@ -137,6 +136,13 @@ inAnnex r key
checkhttp = Url.exists $ keyUrl r key checkhttp = Url.exists $ keyUrl r key
safely a = liftIO (try a ::IO (Either IOException Bool)) safely a = liftIO (try a ::IO (Either IOException Bool))
{- Runs an action on a local repository inexpensively, by making an annex
- monad using that repository. -}
onLocal :: Git.Repo -> Annex a -> IO a
onLocal r a = do
annex <- Annex.new r
Annex.eval annex a
keyUrl :: Git.Repo -> Key -> String keyUrl :: Git.Repo -> Key -> String
keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key keyUrl r key = Git.repoLocation r ++ "/" ++ annexLocation key
@ -163,9 +169,7 @@ copyToRemote r key
g <- Annex.gitRepo g <- Annex.gitRepo
let keysrc = gitAnnexLocation g key let keysrc = gitAnnexLocation g key
-- run copy from perspective of remote -- run copy from perspective of remote
liftIO $ do liftIO $ onLocal r $ do
a <- Annex.new r
Annex.eval a $ do
ok <- Content.getViaTmp key $ ok <- Content.getViaTmp key $
rsyncOrCopyFile r keysrc rsyncOrCopyFile r keysrc
Content.saveState Content.saveState