Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 241 lines (216 sloc) 7.333 kb
b40f253d »
2011-03-27 start of generalizing remotes
1 {- git-annex remotes
2 -
3 - Copyright 2011 Joey Hess <joey@kitenet.net>
4 -
5 - Licensed under the GNU GPL version 3 or higher.
6 -}
7
8 module Remote (
48418cb9 »
2011-03-27 reexport RemoteClass from Remote for cleanliness
9 Remote,
10 uuid,
11 name,
12 storeKey,
13 retrieveKeyFile,
14 removeKey,
15 hasKey,
16 hasKeyCheap,
9f1577f7 »
2011-07-05 remove unused backend machinery
17
0a4c610b »
2011-03-29 initremote works
18 remoteTypes,
c50a5fbe »
2011-11-18 status: Include all special remotes in the list of repositories.
19 remoteMap,
30f42770 »
2011-03-27 converted several commands to use Remote
20 byName,
b5733069 »
2011-07-06 tweak
21 prettyPrintUUIDs,
b40f253d »
2011-03-27 start of generalizing remotes
22 remotesWithUUID,
b1db4368 »
2011-03-28 started on initremote
23 remotesWithoutUUID,
b5733069 »
2011-07-06 tweak
24 keyPossibilities,
25 keyPossibilitiesTrusted,
26 nameToUUID,
9f1577f7 »
2011-07-05 remove unused backend machinery
27 showTriedRemotes,
28 showLocations,
6c31e3a8 »
2011-10-28 drop --from is now supported to remove file content from a remote.
29 forceTrust,
d3e1a361 »
2011-11-09 safer inannex checking
30 logStatus
b40f253d »
2011-03-27 start of generalizing remotes
31 ) where
32
b1db4368 »
2011-03-28 started on initremote
33 import qualified Data.Map as M
5bc32c7f »
2011-09-01 add json formatted list of remotes
34 import Text.JSON
35 import Text.JSON.Generic
b40f253d »
2011-03-27 start of generalizing remotes
36
6a6ea06c »
2011-10-05 rename
37 import Common.Annex
703c437b »
2011-06-01 rename modules for data types into Types/ directory
38 import Types.Remote
b40f253d »
2011-03-27 start of generalizing remotes
39 import qualified Annex
8f995136 »
2011-03-29 refactor
40 import Config
ee9af605 »
2011-10-15 break out non-log stuff to separate module
41 import Annex.UUID
1a29b5b5 »
2011-10-15 reorganize log modules
42 import Logs.UUID
43 import Logs.Trust
44 import Logs.Location
45 import Logs.Remote
0a4c610b »
2011-03-29 initremote works
46
47 import qualified Remote.Git
48 import qualified Remote.S3
44c65f40 »
2011-04-08 bup is now supported as a special type of remote.
49 import qualified Remote.Bup
a47ed922 »
2011-03-30 add Remote.Directory
50 import qualified Remote.Directory
e68f128a »
2011-04-27 rsync special remote
51 import qualified Remote.Rsync
cdbcd6f4 »
2011-07-01 add web special remote
52 import qualified Remote.Web
3ab3f41a »
2011-04-28 hook special remote implemented, and tested
53 import qualified Remote.Hook
b40f253d »
2011-03-27 start of generalizing remotes
54
a3b65869 »
2011-03-28 update
55 remoteTypes :: [RemoteType Annex]
56 remoteTypes =
57 [ Remote.Git.remote
58 , Remote.S3.remote
44c65f40 »
2011-04-08 bup is now supported as a special type of remote.
59 , Remote.Bup.remote
a47ed922 »
2011-03-30 add Remote.Directory
60 , Remote.Directory.remote
e68f128a »
2011-04-27 rsync special remote
61 , Remote.Rsync.remote
cdbcd6f4 »
2011-07-01 add web special remote
62 , Remote.Web.remote
3ab3f41a »
2011-04-28 hook special remote implemented, and tested
63 , Remote.Hook.remote
65b72604 »
2011-03-27 skeleton of S3 remote
64 ]
b40f253d »
2011-03-27 start of generalizing remotes
65
3470260a »
2011-03-27 clean up remote list generation to only run once
66 {- Builds a list of all available Remotes.
72f94cc4 »
2011-03-29 progress
67 - Since doing so can be expensive, the list is cached. -}
3470260a »
2011-03-27 clean up remote list generation to only run once
68 genList :: Annex [Remote Annex]
69 genList = do
70 rs <- Annex.getState Annex.remotes
71 if null rs
72 then do
0782d700 »
2011-03-29 copy --to S3 works
73 m <- readRemoteLog
74 l <- mapM (process m) remoteTypes
75 let rs' = concat l
475f7073 »
2011-03-29 initremote now creates buckets
76 Annex.changeState $ \s -> s { Annex.remotes = rs' }
3470260a »
2011-03-27 clean up remote list generation to only run once
77 return rs'
78 else return rs
0782d700 »
2011-03-29 copy --to S3 works
79 where
6aab88fa »
2011-05-15 more monadic operator use
80 process m t =
81 enumerate t >>=
82 mapM (gen m t)
0782d700 »
2011-03-29 copy --to S3 works
83 gen m t r = do
b505ba83 »
2011-10-11 minor syntax changes
84 u <- getRepoUUID r
0c73c08c »
2011-03-30 cost bugfixes
85 generate t r u (M.lookup u m)
b40f253d »
2011-03-27 start of generalizing remotes
86
c50a5fbe »
2011-11-18 status: Include all special remotes in the list of repositories.
87 {- Map of UUIDs of Remotes and their names. -}
88 remoteMap :: Annex (M.Map UUID String)
89 remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> genList
90
a7e7dda5 »
2011-09-30 Fix referring to remotes by uuid.
91 {- Looks up a remote by name. (Or by UUID.) Only finds currently configured
92 - git remotes. -}
30f42770 »
2011-03-27 converted several commands to use Remote
93 byName :: String -> Annex (Remote Annex)
94 byName n = do
f547277b »
2011-06-13 Allow --trust etc to specify a repository by name, for temporarily tr…
95 res <- byName' n
96 case res of
97 Left e -> error e
98 Right r -> return r
99 byName' :: String -> Annex (Either String (Remote Annex))
100 byName' "" = return $ Left "no remote specified"
101 byName' n = do
30f42770 »
2011-03-27 converted several commands to use Remote
102 allremotes <- genList
103 let match = filter matching allremotes
e7847573 »
2011-07-15 hlint tweaks
104 if null match
f547277b »
2011-06-13 Allow --trust etc to specify a repository by name, for temporarily tr…
105 then return $ Left $ "there is no git remote named \"" ++ n ++ "\""
95d2391f »
2011-12-15 more partial function removal
106 else return $ Right $ Prelude.head match
30f42770 »
2011-03-27 converted several commands to use Remote
107 where
b11a63a8 »
2011-11-07 clean up read/show abuse
108 matching r = n == name r || toUUID n == uuid r
b40f253d »
2011-03-27 start of generalizing remotes
109
f547277b »
2011-06-13 Allow --trust etc to specify a repository by name, for temporarily tr…
110 {- Looks up a remote by name (or by UUID, or even by description),
a7e7dda5 »
2011-09-30 Fix referring to remotes by uuid.
111 - and returns its UUID. Finds even remotes that are not configured in
112 - .git/config. -}
30f42770 »
2011-03-27 converted several commands to use Remote
113 nameToUUID :: String -> Annex UUID
b505ba83 »
2011-10-11 minor syntax changes
114 nameToUUID "." = getUUID -- special case for current repo
3c263cc9 »
2011-11-07 fix
115 nameToUUID n = byName' n >>= go
f547277b »
2011-06-13 Allow --trust etc to specify a repository by name, for temporarily tr…
116 where
3c263cc9 »
2011-11-07 fix
117 go (Right r) = return $ uuid r
118 go (Left e) = fromMaybe (error e) <$> bydescription
119 bydescription = do
a7e7dda5 »
2011-09-30 Fix referring to remotes by uuid.
120 m <- uuidMap
3c263cc9 »
2011-11-07 fix
121 case M.lookup n $ transform swap m of
a7e7dda5 »
2011-09-30 Fix referring to remotes by uuid.
122 Just u -> return $ Just u
3c263cc9 »
2011-11-07 fix
123 Nothing -> return $ byuuid m
b11a63a8 »
2011-11-07 clean up read/show abuse
124 byuuid m = M.lookup (toUUID n) $ transform double m
03e54680 »
2011-09-30 really fix referring to remotes by uuid
125 transform a = M.fromList . map a . M.toList
f547277b »
2011-06-13 Allow --trust etc to specify a repository by name, for temporarily tr…
126 swap (a, b) = (b, a)
3c263cc9 »
2011-11-07 fix
127 double (a, _) = (a, a)
b40f253d »
2011-03-27 start of generalizing remotes
128
5bc32c7f »
2011-09-01 add json formatted list of remotes
129 {- Pretty-prints a list of UUIDs of remotes, for human display.
130 -
131 - Shows descriptions from the uuid log, falling back to remote names,
132 - as some remotes may not be in the uuid log.
133 -
134 - When JSON is enabled, also generates a machine-readable description
135 - of the UUIDs. -}
136 prettyPrintUUIDs :: String -> [UUID] -> Annex String
137 prettyPrintUUIDs desc uuids = do
bf460a0a »
2011-11-08 reorder repo parameters last
138 hereu <- getUUID
29032cb7 »
2011-09-30 When displaying a list of repositories, show git remote names in addi…
139 m <- M.unionWith addname <$> uuidMap <*> remoteMap
bf460a0a »
2011-11-08 reorder repo parameters last
140 maybeShowJSON [(desc, map (jsonify m hereu) uuids)]
141 return $ unwords $ map (\u -> "\t" ++ prettify m hereu u ++ "\n") uuids
cdbcd6f4 »
2011-07-01 add web special remote
142 where
29032cb7 »
2011-09-30 When displaying a list of repositories, show git remote names in addi…
143 addname d n
144 | d == n = d
b3e66050 »
2011-10-27 avoid showing parens for empty descriptions
145 | null d = n
29032cb7 »
2011-09-30 When displaying a list of repositories, show git remote names in addi…
146 | otherwise = n ++ " (" ++ d ++ ")"
5bc32c7f »
2011-09-01 add json formatted list of remotes
147 findlog m u = M.findWithDefault "" u m
bf460a0a »
2011-11-08 reorder repo parameters last
148 prettify m hereu u
b11a63a8 »
2011-11-07 clean up read/show abuse
149 | not (null d) = fromUUID u ++ " -- " ++ d
150 | otherwise = fromUUID u
cdbcd6f4 »
2011-07-01 add web special remote
151 where
bf460a0a »
2011-11-08 reorder repo parameters last
152 ishere = hereu == u
29032cb7 »
2011-09-30 When displaying a list of repositories, show git remote names in addi…
153 n = findlog m u
154 d
155 | null n && ishere = "here"
156 | ishere = addname n "here"
157 | otherwise = n
bf460a0a »
2011-11-08 reorder repo parameters last
158 jsonify m hereu u = toJSObject
b11a63a8 »
2011-11-07 clean up read/show abuse
159 [ ("uuid", toJSON $ fromUUID u)
5bc32c7f »
2011-09-01 add json formatted list of remotes
160 , ("description", toJSON $ findlog m u)
bf460a0a »
2011-11-08 reorder repo parameters last
161 , ("here", toJSON $ hereu == u)
5bc32c7f »
2011-09-01 add json formatted list of remotes
162 ]
cdbcd6f4 »
2011-07-01 add web special remote
163
30f42770 »
2011-03-27 converted several commands to use Remote
164 {- Filters a list of remotes to ones that have the listed uuids. -}
165 remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
166 remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
167
168 {- Filters a list of remotes to ones that do not have the listed uuids. -}
169 remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
170 remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
171
1a29b5b5 »
2011-10-15 reorganize log modules
172 {- Cost ordered lists of remotes that the Logs.Location indicate may have a key.
7ee636f6 »
2011-06-23 avoid unnecessary read of trust.log
173 -}
174 keyPossibilities :: Key -> Annex [Remote Annex]
678726c1 »
2011-08-25 code simplification thanks to applicative functors
175 keyPossibilities key = fst <$> keyPossibilities' False key
7ee636f6 »
2011-06-23 avoid unnecessary read of trust.log
176
1a29b5b5 »
2011-10-15 reorganize log modules
177 {- Cost ordered lists of remotes that the Logs.Location indicate may have a key.
971ab27e »
2011-06-01 better types allowed breaking module dep loop
178 -
179 - Also returns a list of UUIDs that are trusted to have the key
180 - (some may not have configured remotes).
181 -}
7ee636f6 »
2011-06-23 avoid unnecessary read of trust.log
182 keyPossibilitiesTrusted :: Key -> Annex ([Remote Annex], [UUID])
c5531046 »
2011-06-23 refactor
183 keyPossibilitiesTrusted = keyPossibilities' True
184
185 keyPossibilities' :: Bool -> Key -> Annex ([Remote Annex], [UUID])
186 keyPossibilities' withtrusted key = do
b505ba83 »
2011-10-11 minor syntax changes
187 u <- getUUID
c5531046 »
2011-06-23 refactor
188 trusted <- if withtrusted then trustGet Trusted else return []
971ab27e »
2011-06-01 better types allowed breaking module dep loop
189
190 -- get uuids of all remotes that are recorded to have the key
18701866 »
2011-06-22 fixed logFile
191 uuids <- keyLocations key
971ab27e »
2011-06-01 better types allowed breaking module dep loop
192 let validuuids = filter (/= u) uuids
193
194 -- note that validuuids is assumed to not have dups
3623d831 »
2011-09-06 refactor
195 let validtrusteduuids = validuuids `intersect` trusted
971ab27e »
2011-06-01 better types allowed breaking module dep loop
196
197 -- remotes that match uuids that have the key
dd463a31 »
2011-09-18 rework annex-ignore handling
198 allremotes <- filterM (repoNotIgnored . repo) =<< genList
971ab27e »
2011-06-01 better types allowed breaking module dep loop
199 let validremotes = remotesWithUUID allremotes validuuids
200
201 return (sort validremotes, validtrusteduuids)
202
9f1577f7 »
2011-07-05 remove unused backend machinery
203 {- Displays known locations of a key. -}
204 showLocations :: Key -> [UUID] -> Annex ()
205 showLocations key exclude = do
b505ba83 »
2011-10-11 minor syntax changes
206 u <- getUUID
9f1577f7 »
2011-07-05 remove unused backend machinery
207 uuids <- keyLocations key
208 untrusteduuids <- trustGet UnTrusted
209 let uuidswanted = filteruuids uuids (u:exclude++untrusteduuids)
210 let uuidsskipped = filteruuids uuids (u:exclude++uuidswanted)
5bc32c7f »
2011-09-01 add json formatted list of remotes
211 ppuuidswanted <- Remote.prettyPrintUUIDs "wanted" uuidswanted
212 ppuuidsskipped <- Remote.prettyPrintUUIDs "skipped" uuidsskipped
9f1577f7 »
2011-07-05 remove unused backend machinery
213 showLongNote $ message ppuuidswanted ppuuidsskipped
214 where
215 filteruuids l x = filter (`notElem` x) l
216 message [] [] = "No other repository is known to contain the file."
217 message rs [] = "Try making some of these repositories available:\n" ++ rs
218 message [] us = "Also these untrusted repositories may contain the file:\n" ++ us
219 message rs us = message rs [] ++ message [] us
220
221 showTriedRemotes :: [Remote Annex] -> Annex ()
222 showTriedRemotes [] = return ()
223 showTriedRemotes remotes =
224 showLongNote $ "Unable to access these remotes: " ++
225 (join ", " $ map name remotes)
226
f2cc8786 »
2011-06-02 refactor
227 forceTrust :: TrustLevel -> String -> Annex ()
228 forceTrust level remotename = do
9f1577f7 »
2011-07-05 remove unused backend machinery
229 r <- nameToUUID remotename
f2cc8786 »
2011-06-02 refactor
230 Annex.changeState $ \s ->
231 s { Annex.forcetrust = (r, level):Annex.forcetrust s }
6c31e3a8 »
2011-10-28 drop --from is now supported to remove file content from a remote.
232
233 {- Used to log a change in a remote's having a key. The change is logged
234 - in the local repo, not on the remote. The process of transferring the
235 - key to the remote, or removing the key from it *may* log the change
236 - on the remote, but this cannot always be relied on. -}
d3e1a361 »
2011-11-09 safer inannex checking
237 logStatus :: Remote Annex -> Key -> Bool -> Annex ()
238 logStatus remote key present = logChange key (uuid remote) status
6c31e3a8 »
2011-10-28 drop --from is now supported to remove file content from a remote.
239 where
240 status = if present then InfoPresent else InfoMissing
Something went wrong with that request. Please try again.