blob: 460f14de2c425841264242ed427c841dab5eebe2 (
plain)
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
|
{- git-annex command
-
- Copyright 2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.InitRemote where
import qualified Data.Map as M
import Control.Monad (when)
import Control.Monad.State (liftIO)
import Data.Maybe
import Data.String.Utils
import Command
import qualified Annex
import qualified Remote
import qualified RemoteClass
import qualified GitRepo as Git
import Utility
import Types
import UUID
import Messages
command :: [Command]
command = [repoCommand "initremote"
(paramPair paramName $
paramOptional $ paramRepeating $ paramKeyValue) seek
"sets up a special (non-git) remote"]
seek :: [CommandSeek]
seek = [withWords start]
start :: CommandStartWords
start ws = notBareRepo $ do
when (null ws) $ needname
(u, c) <- findByName name
let fullconfig = M.union config c
t <- findType fullconfig
showStart "initremote" name
next $ perform t u $ M.union config c
where
name = head ws
config = Remote.keyValToConfig $ tail ws
needname = do
let err s = error $ "Specify a name for the remote. " ++ s
names <- remoteNames
if null names
then err ""
else err $ "Either a new name, or one of these existing special remotes: " ++ join " " names
perform :: RemoteClass.RemoteType Annex -> UUID -> RemoteClass.RemoteConfig -> CommandPerform
perform t u c = do
c' <- RemoteClass.setup t u c
next $ cleanup u c'
cleanup :: UUID -> RemoteClass.RemoteConfig -> CommandCleanup
cleanup u c = do
Remote.configSet u c
g <- Annex.gitRepo
logfile <- Remote.remoteLog
liftIO $ Git.run g "add" [File logfile]
liftIO $ Git.run g "commit"
[ Params "-q --allow-empty -m"
, Param "git annex initremote"
, File logfile
]
return True
{- Look up existing remote's UUID and config by name, or generate a new one -}
findByName :: String -> Annex (UUID, RemoteClass.RemoteConfig)
findByName name = do
m <- Remote.readRemoteLog
maybe generate return $ findByName' name m
where
generate = do
uuid <- liftIO $ genUUID
return (uuid, M.insert nameKey name M.empty)
findByName' :: String -> M.Map UUID RemoteClass.RemoteConfig -> Maybe (UUID, RemoteClass.RemoteConfig)
findByName' n m = if null matches then Nothing else Just $ head matches
where
matches = filter (matching . snd) $ M.toList m
matching c = case M.lookup nameKey c of
Nothing -> False
Just n'
| n' == n -> True
| otherwise -> False
remoteNames :: Annex [String]
remoteNames = do
m <- Remote.readRemoteLog
return $ catMaybes $ map ((M.lookup nameKey) . snd) $ M.toList m
{- find the specified remote type -}
findType :: RemoteClass.RemoteConfig -> Annex (RemoteClass.RemoteType Annex)
findType config = maybe unspecified specified $ M.lookup typeKey config
where
unspecified = error "Specify the type of remote with type="
specified s = case filter (findtype s) Remote.remoteTypes of
[] -> error $ "Unknown remote type " ++ s
(t:_) -> return t
findtype s i = RemoteClass.typename i == s
{- The name of a configured remote is stored in its config using this key. -}
nameKey :: String
nameKey = "name"
{- The type of a remote is stored in its config using this key. -}
typeKey :: String
typeKey = "type"
|
