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:
parent
cf33eff684
commit
32f27cc3e8
3 changed files with 34 additions and 25 deletions
12
CmdLine.hs
12
CmdLine.hs
|
@ -19,7 +19,6 @@ import Control.Monad (when)
|
|||
import qualified Annex
|
||||
import qualified AnnexQueue
|
||||
import qualified Git
|
||||
import qualified Branch
|
||||
import Content
|
||||
import Types
|
||||
import Command
|
||||
|
@ -60,16 +59,7 @@ parseCmd argv header cmds options = do
|
|||
|
||||
{- 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"
|
||||
checkCmdEnviron command = when (cmdusesrepo command) $ checkVersion $ initializeSafe
|
||||
|
||||
{- Usage message with lists of commands and options. -}
|
||||
usage :: String -> [Command] -> [Option] -> String
|
||||
|
|
17
Init.hs
17
Init.hs
|
@ -5,7 +5,11 @@
|
|||
- 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 (unless)
|
||||
|
@ -34,6 +38,17 @@ uninitialize = do
|
|||
g <- Annex.gitRepo
|
||||
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 -}
|
||||
gitPreCommitHookWrite :: Git.Repo -> Annex ()
|
||||
gitPreCommitHookWrite repo = do
|
||||
|
|
|
@ -28,6 +28,7 @@ import Utility.RsyncFile
|
|||
import Remote.Helper.Ssh
|
||||
import qualified Remote.Helper.Url as Url
|
||||
import Config
|
||||
import Init
|
||||
|
||||
remote :: RemoteType Annex
|
||||
remote = RemoteType {
|
||||
|
@ -79,7 +80,9 @@ tryGitConfigRead r
|
|||
| Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" []
|
||||
| Git.repoIsHttp r = store $ safely $ geturlconfig
|
||||
| Git.repoIsUrl r = return r
|
||||
| otherwise = store $ safely $ Git.configRead r
|
||||
| otherwise = store $ safely $ do
|
||||
onLocal r initializeSafe
|
||||
Git.configRead r
|
||||
where
|
||||
-- Reading config can fail due to IO error or
|
||||
-- for other reasons; catch all possible exceptions.
|
||||
|
@ -124,11 +127,7 @@ inAnnex r key
|
|||
| Git.repoIsUrl r = checkremote
|
||||
| otherwise = safely checklocal
|
||||
where
|
||||
checklocal = do
|
||||
-- run a local check inexpensively,
|
||||
-- by making an Annex monad using the remote
|
||||
a <- Annex.new r
|
||||
Annex.eval a (Content.inAnnex key)
|
||||
checklocal = onLocal r (Content.inAnnex key)
|
||||
checkremote = do
|
||||
showAction $ "checking " ++ Git.repoDescribe r
|
||||
inannex <- onRemote r (boolSystem, False) "inannex"
|
||||
|
@ -137,6 +136,13 @@ inAnnex r key
|
|||
checkhttp = Url.exists $ keyUrl r key
|
||||
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 r key = Git.repoLocation r ++ "/" ++ annexLocation key
|
||||
|
||||
|
@ -163,13 +169,11 @@ copyToRemote r key
|
|||
g <- Annex.gitRepo
|
||||
let keysrc = gitAnnexLocation g key
|
||||
-- run copy from perspective of remote
|
||||
liftIO $ do
|
||||
a <- Annex.new r
|
||||
Annex.eval a $ do
|
||||
ok <- Content.getViaTmp key $
|
||||
rsyncOrCopyFile r keysrc
|
||||
Content.saveState
|
||||
return ok
|
||||
liftIO $ onLocal r $ do
|
||||
ok <- Content.getViaTmp key $
|
||||
rsyncOrCopyFile r keysrc
|
||||
Content.saveState
|
||||
return ok
|
||||
| Git.repoIsSsh r = do
|
||||
g <- Annex.gitRepo
|
||||
let keysrc = gitAnnexLocation g key
|
||||
|
|
Loading…
Reference in a new issue