1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
{- git-annex command
-
- Copyright 2011-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Command.InitRemote where
import qualified Data.Map as M
import Command
import Annex.SpecialRemote
import qualified Remote
import qualified Types.Remote as R
import Types.RemoteConfig
import Annex.UUID
import Logs.UUID
import Logs.Remote
import Types.GitConfig
import Types.ProposedAccepted
import Config
import Git.Config
cmd :: Command
cmd = command "initremote" SectionSetup
"creates a special (non-git) remote"
(paramPair paramName $ paramOptional $ paramRepeating paramParamValue)
(seek <$$> optParser)
data InitRemoteOptions = InitRemoteOptions
{ cmdparams :: CmdParams
, sameas :: Maybe (DeferredParse UUID)
, whatElse :: Bool
}
optParser :: CmdParamsDesc -> Parser InitRemoteOptions
optParser desc = InitRemoteOptions
<$> cmdParams desc
<*> optional parseSameasOption
<*> switch
( long "whatelse"
<> short 'w'
<> help "describe other configuration parameters for a special remote"
)
parseSameasOption :: Parser (DeferredParse UUID)
parseSameasOption = parseUUIDOption <$> strOption
( long "sameas"
<> metavar (paramRemote `paramOr` paramDesc `paramOr` paramUUID)
<> help "new remote that accesses the same data"
<> completeRemotes
)
seek :: InitRemoteOptions -> CommandSeek
seek o = withWords (commandAction . (start o)) (cmdparams o)
start :: InitRemoteOptions -> [String] -> CommandStart
start _ [] = giveup "Specify a name for the remote."
start o (name:ws) = ifM (isJust <$> findExisting name)
( giveup $ "There is already a special remote named \"" ++ name ++
"\". (Use enableremote to enable an existing special remote.)"
, ifM (isJust <$> Remote.byNameOnly name)
( giveup $ "There is already a remote named \"" ++ name ++ "\""
, do
sameasuuid <- maybe
(pure Nothing)
(Just . Sameas <$$> getParsed)
(sameas o)
c <- newConfig name sameasuuid
(Logs.Remote.keyValToConfig Proposed ws)
<$> remoteConfigMap
t <- either giveup return (findType c)
if whatElse o
then startingCustomOutput (ActionItemOther Nothing) $
describeOtherParamsFor c t
else starting "initremote" (ActionItemOther (Just name)) si $
perform t name c o
)
)
where
si = SeekInput [name]
perform :: RemoteType -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandPerform
perform t name c o = do
dummycfg <- liftIO dummyRemoteGitConfig
let c' = M.delete uuidField c
(c'', u) <- R.setup t R.Init (sameasu <|> uuidfromuser) Nothing c' dummycfg
next $ cleanup t u name c'' o
where
uuidfromuser = case fromProposedAccepted <$> M.lookup uuidField c of
Just s
| isUUID s -> Just (toUUID s)
| otherwise -> giveup "invalid uuid"
Nothing -> Nothing
sameasu = toUUID . fromProposedAccepted <$> M.lookup sameasUUIDField c
uuidField :: R.RemoteConfigField
uuidField = Accepted "uuid"
cleanup :: RemoteType -> UUID -> String -> R.RemoteConfig -> InitRemoteOptions -> CommandCleanup
cleanup t u name c o = do
case sameas o of
Nothing -> do
describeUUID u (toUUIDDesc name)
Logs.Remote.configSet u c
Just _ -> do
cu <- liftIO genUUID
setConfig (remoteAnnexConfig c "config-uuid") (fromUUID cu)
Logs.Remote.configSet cu c
unless (Remote.gitSyncableRemoteType t) $
setConfig (remoteConfig c "skipFetchAll") (boolConfig True)
return True
describeOtherParamsFor :: RemoteConfig -> RemoteType -> CommandPerform
describeOtherParamsFor c t = do
cp <- R.configParser t c
let l = map mk (filter notinconfig $ remoteConfigFieldParsers cp)
++ map mk' (maybe [] snd (remoteConfigRestPassthrough cp))
liftIO $ forM_ l $ \(p, fd, vd) -> case fd of
HiddenField -> return ()
FieldDesc d -> do
putStrLn p
putStrLn ("\t" ++ d)
case vd of
Nothing -> return ()
Just (ValueDesc d') ->
putStrLn $ "\t(" ++ d' ++ ")"
next $ return True
where
notinconfig fp = not (M.member (parserForField fp) c)
mk fp = ( fromProposedAccepted (parserForField fp)
, fieldDesc fp
, valueDesc fp
)
mk' (k, v) = (k, v, Nothing)
|
