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 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
17
Init.hs
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue