git-annex/UUID.hs

43 lines
888 B
Haskell
Raw Normal View History

2010-10-12 17:10:07 +00:00
{- git-annex uuids
-
- Each git repository used by git-annex has an annex.uuid setting that
- uniquely identifies that repository.
-
-}
module UUID (
2010-10-12 22:06:34 +00:00
UUID,
2010-10-12 17:10:07 +00:00
getUUID,
prepUUID,
genUUID
) where
import System.Cmd.Utils
import System.IO
import GitRepo
2010-10-12 19:48:00 +00:00
type UUID = String
2010-10-12 17:10:07 +00:00
configkey="annex.uuid"
{- Generates a UUID. There is a library for this, but it's not packaged,
- so use the command line tool. -}
2010-10-12 19:48:00 +00:00
genUUID :: IO UUID
2010-10-12 17:10:07 +00:00
genUUID = do
pOpen ReadFromPipe "uuid" ["-m"] $ \h -> hGetLine h
2010-10-12 17:12:47 +00:00
{- Looks up a repo's UUID -}
2010-10-12 19:48:00 +00:00
getUUID :: GitRepo -> UUID
2010-10-12 17:10:07 +00:00
getUUID repo = gitConfig repo "annex.uuid" ""
{- Make sure that the repo has an annex.uuid setting. -}
2010-10-12 17:12:47 +00:00
prepUUID :: GitRepo -> IO GitRepo
2010-10-12 17:10:07 +00:00
prepUUID repo =
if ("" == getUUID repo)
then do
uuid <- genUUID
gitRun repo ["config", configkey, uuid]
2010-10-12 19:44:54 +00:00
-- return new repo with updated config
gitConfigRead repo
2010-10-12 17:12:47 +00:00
else return repo