blob: b4c4c0cc0b4ad10c8ea22b57c3ad981efee62c61 (
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
|
{- git-annex uuids
-
- Each git repository used by git-annex has an annex.uuid setting that
- uniquely identifies that repository.
-
-}
module UUID (
UUID,
getUUID,
prepUUID,
genUUID,
reposByUUID
) where
import Maybe
import List
import System.Cmd.Utils
import System.IO
import GitRepo
import Types
type UUID = String
configkey="annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
genUUID :: IO UUID
genUUID = do
pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
{- Looks up a repo's UUID. May return "" if none is known.
-
- UUIDs of remotes are cached in git config, using keys named
- remote.<name>.annex-uuid
-
- -}
getUUID :: State -> GitRepo -> UUID
getUUID s r =
if ("" /= getUUID' r)
then getUUID' r
else cached s r
where
cached s r = gitConfig (repo s) (configkey r) ""
configkey r = "remote." ++ (gitRepoRemoteName r) ++ ".annex-uuid"
getUUID' r = gitConfig r "annex.uuid" ""
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: GitRepo -> IO GitRepo
prepUUID repo =
if ("" == getUUID' repo)
then do
uuid <- genUUID
gitRun repo ["config", configkey, uuid]
-- return new repo with updated config
gitConfigRead repo
else return repo
{- Filters a list of repos to ones that have listed UUIDs. -}
reposByUUID :: State -> [GitRepo] -> [UUID] -> [GitRepo]
reposByUUID state repos uuids =
filter (\r -> isJust $ elemIndex (getUUID state r) uuids) repos
|
