blob: 9348c7b437b08a46830de99f349ea4521456c21c (
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
|
{- 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,
prettyPrintUUIDs
) where
import Control.Monad.State
import Maybe
import List
import System.Cmd.Utils
import System.IO
import qualified GitRepo as Git
import Types
import qualified Annex
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 :: Annex UUID
genUUID = liftIO $ 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 :: Git.Repo -> Annex UUID
getUUID r = do
g <- Annex.gitRepo
let c = cached r g
let u = uncached r
if (c /= u && u /= "")
then do
updatecache g r u
return u
else return c
where
uncached r = Git.configGet r "annex.uuid" ""
cached r g = Git.configGet g (cachekey r) ""
updatecache g r u = do
if (g /= r)
then setConfig (cachekey r) u
else return ()
cachekey r = "remote." ++ (Git.repoRemoteName r) ++ ".annex-uuid"
{- Make sure that the repo has an annex.uuid setting. -}
prepUUID :: Annex ()
prepUUID = do
g <- Annex.gitRepo
u <- getUUID g
if ("" == u)
then do
uuid <- genUUID
setConfig configkey uuid
else return ()
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: String -> String -> Annex ()
setConfig key value = do
g <- Annex.gitRepo
liftIO $ Git.run g ["config", key, value]
-- re-read git config and update the repo's state
g' <- liftIO $ Git.configRead g
Annex.gitRepoChange g'
return ()
{- Filters a list of repos to ones that have listed UUIDs. -}
reposByUUID :: [Git.Repo] -> [UUID] -> Annex [Git.Repo]
reposByUUID repos uuids = do
filterM match repos
where
match r = do
u <- getUUID r
return $ isJust $ elemIndex u uuids
{- Pretty-prints a list of UUIDs
- TODO: use lookup file to really show pretty names. -}
prettyPrintUUIDs :: [UUID] -> String
prettyPrintUUIDs uuids =
unwords $ map (\u -> "\tUUID "++u++"\n") uuids
|
