diff options
Diffstat (limited to 'Annex')
-rw-r--r-- | Annex/Content.hs | 2 | ||||
-rw-r--r-- | Annex/UUID.hs | 69 |
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 |