2010-11-02 23:04:24 +00:00
|
|
|
{- git-annex command
|
|
|
|
-
|
2020-05-27 15:54:39 +00:00
|
|
|
- Copyright 2010-2020 Joey Hess <id@joeyh.name>
|
2010-11-02 23:04:24 +00:00
|
|
|
-
|
2019-03-13 19:48:14 +00:00
|
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
2010-11-02 23:04:24 +00:00
|
|
|
-}
|
|
|
|
|
2023-04-08 19:48:32 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2010-11-02 23:04:24 +00:00
|
|
|
module Command.Init where
|
|
|
|
|
|
|
|
import Command
|
2014-01-26 20:36:31 +00:00
|
|
|
import Annex.Init
|
2015-12-15 21:17:13 +00:00
|
|
|
import Annex.Version
|
remove dead nodes when loading the cluster log
This is to avoid inserting a cluster uuid into the location log when
only dead nodes in the cluster contain the content of a key.
One reason why this is necessary is Remote.keyLocations, which excludes
dead repositories from the list. But there are probably many more.
Implementing this was challenging, because Logs.Location importing
Logs.Cluster which imports Logs.Trust which imports Remote.List resulted
in an import cycle through several other modules.
Resorted to making Logs.Location not import Logs.Cluster, and instead
it assumes that Annex.clusters gets populated when necessary before it's
called.
That's done in Annex.Startup, which is run by the git-annex command
(but not other commands) at early startup in initialized repos. Or,
is run after initialization.
Note that is Remote.Git, it is unable to import Annex.Startup, because
Remote.Git importing Logs.Cluster leads the the same import cycle.
So ensureInitialized is not passed annexStartup in there.
Other commands, like git-annex-shell currently don't run annexStartup
either.
So there are cases where Logs.Location will not see clusters. So it won't add
any cluster UUIDs when loading the log. That's ok, the only reason to do
that is to make display of where objects are located include clusters,
and to make commands like git-annex get --from treat keys as being located
in a cluster. git-annex-shell certainly does not do anything like that,
and I'm pretty sure Remote.Git (and callers to Remote.Git.onLocalRepo)
don't either.
2024-06-16 18:35:07 +00:00
|
|
|
import Annex.Startup
|
2018-10-25 21:23:53 +00:00
|
|
|
import Types.RepoVersion
|
2015-09-14 18:49:48 +00:00
|
|
|
import qualified Annex.SpecialRemote
|
2018-10-26 15:44:05 +00:00
|
|
|
|
2020-02-28 16:57:55 +00:00
|
|
|
import Control.Monad.Fail as Fail (MonadFail(..))
|
2018-10-26 15:44:05 +00:00
|
|
|
import qualified Data.Map as M
|
2010-12-30 19:06:26 +00:00
|
|
|
|
2015-07-08 16:33:27 +00:00
|
|
|
cmd :: Command
|
2023-05-08 18:58:08 +00:00
|
|
|
cmd = dontCheck repoExists $ withAnnexOptions [jsonOptions] $
|
2015-07-08 19:08:02 +00:00
|
|
|
command "init" SectionSetup "initialize git-annex"
|
2015-12-15 21:17:13 +00:00
|
|
|
paramDesc (seek <$$> optParser)
|
2010-11-02 23:04:24 +00:00
|
|
|
|
2015-12-15 21:17:13 +00:00
|
|
|
data InitOptions = InitOptions
|
|
|
|
{ initDesc :: String
|
2018-10-25 21:23:53 +00:00
|
|
|
, initVersion :: Maybe RepoVersion
|
2020-05-27 15:54:39 +00:00
|
|
|
, autoEnableOnly :: Bool
|
2022-06-01 17:27:49 +00:00
|
|
|
, noAutoEnable :: Bool
|
2015-12-15 21:17:13 +00:00
|
|
|
}
|
2010-11-11 22:54:52 +00:00
|
|
|
|
2015-12-15 21:17:13 +00:00
|
|
|
optParser :: CmdParamsDesc -> Parser InitOptions
|
|
|
|
optParser desc = InitOptions
|
|
|
|
<$> (unwords <$> cmdParams desc)
|
2018-10-25 21:23:53 +00:00
|
|
|
<*> optional (option (str >>= parseRepoVersion)
|
2015-12-15 21:17:13 +00:00
|
|
|
( long "version" <> metavar paramValue
|
|
|
|
<> help "Override default annex.version"
|
|
|
|
))
|
2020-05-27 15:54:39 +00:00
|
|
|
<*> switch
|
|
|
|
( long "autoenable"
|
|
|
|
<> help "only enable special remotes configured with autoenable=true"
|
|
|
|
)
|
2022-06-01 17:27:49 +00:00
|
|
|
<*> switch
|
|
|
|
( long "no-autoenable"
|
|
|
|
<> help "do not enable special remotes configured with autoenable=true"
|
|
|
|
)
|
2010-11-02 23:04:24 +00:00
|
|
|
|
2020-02-28 10:56:48 +00:00
|
|
|
parseRepoVersion :: MonadFail m => String -> m RepoVersion
|
2018-10-25 21:23:53 +00:00
|
|
|
parseRepoVersion s = case RepoVersion <$> readish s of
|
2020-02-28 10:56:48 +00:00
|
|
|
Nothing -> Fail.fail $ "version parse error"
|
2018-10-25 21:23:53 +00:00
|
|
|
Just v
|
|
|
|
| v `elem` supportedVersions -> return v
|
2018-10-26 15:44:05 +00:00
|
|
|
| otherwise -> case M.lookup v autoUpgradeableVersions of
|
|
|
|
Just v' -> return v'
|
2020-02-28 10:56:48 +00:00
|
|
|
Nothing -> Fail.fail $ s ++ " is not a currently supported repository version"
|
2015-12-15 21:17:13 +00:00
|
|
|
|
|
|
|
seek :: InitOptions -> CommandSeek
|
|
|
|
seek = commandAction . start
|
|
|
|
|
|
|
|
start :: InitOptions -> CommandStart
|
2020-05-27 15:54:39 +00:00
|
|
|
start os
|
2020-09-14 20:49:33 +00:00
|
|
|
| autoEnableOnly os =
|
|
|
|
starting "init" (ActionItemOther (Just "autoenable")) si $
|
|
|
|
performAutoEnableOnly
|
|
|
|
| otherwise =
|
2023-04-08 19:48:32 +00:00
|
|
|
starting "init" (ActionItemOther (Just $ UnquotedString $ initDesc os)) si $
|
2020-09-14 20:49:33 +00:00
|
|
|
perform os
|
|
|
|
where
|
|
|
|
si = SeekInput []
|
2015-12-15 21:17:13 +00:00
|
|
|
|
|
|
|
perform :: InitOptions -> CommandPerform
|
|
|
|
perform os = do
|
2019-08-08 18:12:46 +00:00
|
|
|
case initVersion os of
|
|
|
|
Nothing -> noop
|
|
|
|
Just wantversion -> getVersion >>= \case
|
|
|
|
Just v | v /= wantversion ->
|
|
|
|
giveup $ "This repository is already a initialized with version " ++ show (fromRepoVersion v) ++ ", not changing to requested version."
|
|
|
|
_ -> noop
|
remove dead nodes when loading the cluster log
This is to avoid inserting a cluster uuid into the location log when
only dead nodes in the cluster contain the content of a key.
One reason why this is necessary is Remote.keyLocations, which excludes
dead repositories from the list. But there are probably many more.
Implementing this was challenging, because Logs.Location importing
Logs.Cluster which imports Logs.Trust which imports Remote.List resulted
in an import cycle through several other modules.
Resorted to making Logs.Location not import Logs.Cluster, and instead
it assumes that Annex.clusters gets populated when necessary before it's
called.
That's done in Annex.Startup, which is run by the git-annex command
(but not other commands) at early startup in initialized repos. Or,
is run after initialization.
Note that is Remote.Git, it is unable to import Annex.Startup, because
Remote.Git importing Logs.Cluster leads the the same import cycle.
So ensureInitialized is not passed annexStartup in there.
Other commands, like git-annex-shell currently don't run annexStartup
either.
So there are cases where Logs.Location will not see clusters. So it won't add
any cluster UUIDs when loading the log. That's ok, the only reason to do
that is to make display of where objects are located include clusters,
and to make commands like git-annex get --from treat keys as being located
in a cluster. git-annex-shell certainly does not do anything like that,
and I'm pretty sure Remote.Git (and callers to Remote.Git.onLocalRepo)
don't either.
2024-06-16 18:35:07 +00:00
|
|
|
initialize startupAnnex
|
2015-12-15 21:17:13 +00:00
|
|
|
(if null (initDesc os) then Nothing else Just (initDesc os))
|
|
|
|
(initVersion os)
|
2022-06-01 17:27:49 +00:00
|
|
|
unless (noAutoEnable os)
|
|
|
|
Annex.SpecialRemote.autoEnable
|
2011-06-22 20:03:26 +00:00
|
|
|
next $ return True
|
2020-05-27 15:54:39 +00:00
|
|
|
|
|
|
|
performAutoEnableOnly :: CommandPerform
|
|
|
|
performAutoEnableOnly = do
|
|
|
|
Annex.SpecialRemote.autoEnable
|
|
|
|
next $ return True
|