summaryrefslogtreecommitdiff
path: root/Logs/UUID.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Logs/UUID.hs')
-rw-r--r--Logs/UUID.hs95
1 files changed, 95 insertions, 0 deletions
diff --git a/Logs/UUID.hs b/Logs/UUID.hs
new file mode 100644
index 000000000..baf665001
--- /dev/null
+++ b/Logs/UUID.hs
@@ -0,0 +1,95 @@
+{- 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
+ -
+ - uuid.log stores a list of known uuids, and their descriptions.
+ -
+ - Copyright 2010-2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Logs.UUID (
+ UUID,
+ getUUID,
+ getRepoUUID,
+ getUncachedUUID,
+ prepUUID,
+ genUUID,
+ describeUUID,
+ uuidMap
+) where
+
+import qualified Data.Map as M
+import Data.Time.Clock.POSIX
+
+import Common.Annex
+import qualified Git
+import qualified Annex.Branch
+import Types.UUID
+import qualified Build.SysConfig as SysConfig
+import Config
+import Logs.UUIDBased
+
+configkey :: String
+configkey = "annex.uuid"
+
+{- Filename of uuid.log. -}
+logfile :: FilePath
+logfile = "uuid.log"
+
+{- 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
+
+{- Records a description for a uuid in the log. -}
+describeUUID :: UUID -> String -> Annex ()
+describeUUID uuid desc = do
+ ts <- liftIO $ getPOSIXTime
+ Annex.Branch.change logfile $
+ showLog id . changeLog ts uuid desc . parseLog Just
+
+{- Read the uuidLog into a simple Map -}
+uuidMap :: Annex (M.Map UUID String)
+uuidMap = (simpleMap . parseLog Just) <$> Annex.Branch.get logfile