summaryrefslogtreecommitdiff
path: root/Annex
diff options
context:
space:
mode:
Diffstat (limited to 'Annex')
-rw-r--r--Annex/Content.hs2
-rw-r--r--Annex/UUID.hs69
2 files changed, 70 insertions, 1 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 9cf7ea8f2..aafdf6f2e 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -23,7 +23,7 @@ module Annex.Content (
import Common.Annex
import Logs.Location
-import Logs.UUID
+import Annex.UUID
import qualified Git
import qualified Annex
import qualified Annex.Queue
diff --git a/Annex/UUID.hs b/Annex/UUID.hs
new file mode 100644
index 000000000..39e296e5b
--- /dev/null
+++ b/Annex/UUID.hs
@@ -0,0 +1,69 @@
+{- git-annex uuids
+ -
+ - Each git repository used by git-annex has an annex.uuid setting that
+ - uniquely identifies that repository.
+ -
+ - UUIDs of remotes are cached in git config, using keys named
+ - remote.<name>.annex-uuid
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.UUID (
+ getUUID,
+ getRepoUUID,
+ getUncachedUUID,
+ prepUUID,
+ genUUID
+) where
+
+import Common.Annex
+import qualified Git
+import qualified Build.SysConfig as SysConfig
+import Config
+
+configkey :: 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 = pOpen ReadFromPipe command params hGetLine
+ where
+ command = SysConfig.uuid
+ params = if command == "uuid"
+ -- request a random uuid be generated
+ then ["-m"]
+ -- uuidgen generates random uuid by default
+ else []
+
+getUUID :: Annex UUID
+getUUID = getRepoUUID =<< gitRepo
+
+{- Looks up a repo's UUID. May return "" if none is known. -}
+getRepoUUID :: Git.Repo -> Annex UUID
+getRepoUUID r = do
+ g <- gitRepo
+
+ let c = cached g
+ let u = getUncachedUUID r
+
+ if c /= u && u /= ""
+ then do
+ updatecache g u
+ return u
+ else return c
+ where
+ cached g = Git.configGet g cachekey ""
+ updatecache g u = when (g /= r) $ setConfig cachekey u
+ cachekey = "remote." ++ fromMaybe "" (Git.repoRemoteName r) ++ ".annex-uuid"
+
+getUncachedUUID :: Git.Repo -> UUID
+getUncachedUUID r = Git.configGet r configkey ""
+
+{- Make sure that the repo has an annex.uuid setting. -}
+prepUUID :: Annex ()
+prepUUID = whenM (null <$> getUUID) $
+ setConfig configkey =<< liftIO genUUID