diff options
-rw-r--r-- | Annex/Content.hs | 2 | ||||
-rw-r--r-- | Annex/UUID.hs | 69 | ||||
-rw-r--r-- | Command/ConfigList.hs | 2 | ||||
-rw-r--r-- | Command/Fsck.hs | 2 | ||||
-rw-r--r-- | Command/Init.hs | 1 | ||||
-rw-r--r-- | Command/InitRemote.hs | 2 | ||||
-rw-r--r-- | Command/Map.hs | 1 | ||||
-rw-r--r-- | Command/Move.hs | 2 | ||||
-rw-r--r-- | Command/Semitrust.hs | 1 | ||||
-rw-r--r-- | Command/Trust.hs | 1 | ||||
-rw-r--r-- | Command/Untrust.hs | 1 | ||||
-rw-r--r-- | Init.hs | 2 | ||||
-rw-r--r-- | Logs/Location.hs | 1 | ||||
-rw-r--r-- | Logs/Remote.hs | 1 | ||||
-rw-r--r-- | Logs/Trust.hs | 2 | ||||
-rw-r--r-- | Logs/UUID.hs | 54 | ||||
-rw-r--r-- | Logs/Web.hs | 1 | ||||
-rw-r--r-- | Remote.hs | 1 | ||||
-rw-r--r-- | Remote/Bup.hs | 1 | ||||
-rw-r--r-- | Remote/Directory.hs | 1 | ||||
-rw-r--r-- | Remote/Git.hs | 2 | ||||
-rw-r--r-- | Remote/Helper/Special.hs | 1 | ||||
-rw-r--r-- | Remote/Hook.hs | 1 | ||||
-rw-r--r-- | Remote/Web.hs | 1 | ||||
-rw-r--r-- | Types.hs | 4 | ||||
-rw-r--r-- | Utility/Ssh.hs | 2 | ||||
-rw-r--r-- | git-annex-shell.hs | 2 | ||||
-rw-r--r-- | test.hs | 3 |
28 files changed, 86 insertions, 78 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 diff --git a/Command/ConfigList.hs b/Command/ConfigList.hs index b50c759ee..43315f67c 100644 --- a/Command/ConfigList.hs +++ b/Command/ConfigList.hs @@ -9,7 +9,7 @@ module Command.ConfigList where import Common.Annex import Command -import Logs.UUID +import Annex.UUID command :: [Command] command = [repoCommand "configlist" paramNothing seek diff --git a/Command/Fsck.hs b/Command/Fsck.hs index 632570b11..1c1687a00 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -15,7 +15,7 @@ import qualified Types.Key import Annex.Content import Logs.Location import Logs.Trust -import Logs.UUID +import Annex.UUID import Utility.DataUnits import Utility.FileMode import Config diff --git a/Command/Init.hs b/Command/Init.hs index dcc6bfe6b..3dd449329 100644 --- a/Command/Init.hs +++ b/Command/Init.hs @@ -9,6 +9,7 @@ module Command.Init where import Common.Annex import Command +import Annex.UUID import Logs.UUID import Init diff --git a/Command/InitRemote.hs b/Command/InitRemote.hs index 240528b87..073ba72f9 100644 --- a/Command/InitRemote.hs +++ b/Command/InitRemote.hs @@ -14,7 +14,7 @@ import Command import qualified Remote import qualified Logs.Remote import qualified Types.Remote as R -import Logs.UUID +import Annex.UUID command :: [Command] command = [repoCommand "initremote" diff --git a/Command/Map.hs b/Command/Map.hs index 5cbf51b27..18cb915e3 100644 --- a/Command/Map.hs +++ b/Command/Map.hs @@ -13,6 +13,7 @@ import qualified Data.Map as M import Common.Annex import Command import qualified Git +import Annex.UUID import Logs.UUID import Logs.Trust import Utility.Ssh diff --git a/Command/Move.hs b/Command/Move.hs index 62f38224c..a816aacde 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -14,7 +14,7 @@ import qualified Annex import Logs.Location import Annex.Content import qualified Remote -import Logs.UUID +import Annex.UUID command :: [Command] command = [repoCommand "move" paramPaths seek diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs index e13785a38..5d60977eb 100644 --- a/Command/Semitrust.hs +++ b/Command/Semitrust.hs @@ -10,7 +10,6 @@ module Command.Semitrust where import Common.Annex import Command import qualified Remote -import Logs.UUID import Logs.Trust command :: [Command] diff --git a/Command/Trust.hs b/Command/Trust.hs index fb7f47ec0..eeeadc9af 100644 --- a/Command/Trust.hs +++ b/Command/Trust.hs @@ -11,7 +11,6 @@ import Common.Annex import Command import qualified Remote import Logs.Trust -import Logs.UUID command :: [Command] command = [repoCommand "trust" (paramRepeating paramRemote) seek diff --git a/Command/Untrust.hs b/Command/Untrust.hs index 6f2b60203..f8bf498f2 100644 --- a/Command/Untrust.hs +++ b/Command/Untrust.hs @@ -10,7 +10,6 @@ module Command.Untrust where import Common.Annex import Command import qualified Remote -import Logs.UUID import Logs.Trust command :: [Command] @@ -15,7 +15,7 @@ import Common.Annex import qualified Git import qualified Annex.Branch import Annex.Version -import Logs.UUID +import Annex.UUID initialize :: Annex () initialize = do diff --git a/Logs/Location.hs b/Logs/Location.hs index 4e8b2b535..8868912db 100644 --- a/Logs/Location.hs +++ b/Logs/Location.hs @@ -24,7 +24,6 @@ module Logs.Location ( import Common.Annex import qualified Git import qualified Annex.Branch -import Logs.UUID import Logs.Presence {- Log a change in the presence of a key's value in a repository. -} diff --git a/Logs/Remote.hs b/Logs/Remote.hs index 47c2d7472..e2b04bf47 100644 --- a/Logs/Remote.hs +++ b/Logs/Remote.hs @@ -21,7 +21,6 @@ import Data.Char import Common.Annex import qualified Annex.Branch import Types.Remote -import Logs.UUID import Logs.UUIDBased {- Filename of remote.log. -} diff --git a/Logs/Trust.hs b/Logs/Trust.hs index 6966ffdd6..372d8b360 100644 --- a/Logs/Trust.hs +++ b/Logs/Trust.hs @@ -19,8 +19,6 @@ import Common.Annex import Types.TrustLevel import qualified Annex.Branch import qualified Annex - -import Logs.UUID import Logs.UUIDBased {- Filename of trust.log. -} diff --git a/Logs/UUID.hs b/Logs/UUID.hs index baf665001..8a93b43fe 100644 --- a/Logs/UUID.hs +++ b/Logs/UUID.hs @@ -14,12 +14,6 @@ -} module Logs.UUID ( - UUID, - getUUID, - getRepoUUID, - getUncachedUUID, - prepUUID, - genUUID, describeUUID, uuidMap ) where @@ -28,61 +22,13 @@ 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 diff --git a/Logs/Web.hs b/Logs/Web.hs index 4c8ef7fc0..605797079 100644 --- a/Logs/Web.hs +++ b/Logs/Web.hs @@ -16,7 +16,6 @@ module Logs.Web ( import Common.Annex import Logs.Presence import Logs.Location -import Logs.UUID type URLString = String @@ -36,6 +36,7 @@ import Common.Annex import Types.Remote import qualified Annex import Config +import Annex.UUID import Logs.UUID import Logs.Trust import Logs.Location diff --git a/Remote/Bup.hs b/Remote/Bup.hs index dfc911688..8d36245a9 100644 --- a/Remote/Bup.hs +++ b/Remote/Bup.hs @@ -15,7 +15,6 @@ import System.Process import Common.Annex import Types.Remote import qualified Git -import Logs.UUID import Config import Utility.Ssh import Remote.Helper.Special diff --git a/Remote/Directory.hs b/Remote/Directory.hs index 270c78f83..e8cf05a0e 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -15,7 +15,6 @@ import Common.Annex import Utility.CopyFile import Types.Remote import qualified Git -import Logs.UUID import Config import Utility.FileMode import Remote.Helper.Special diff --git a/Remote/Git.hs b/Remote/Git.hs index 42d1b5858..10183522f 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -17,7 +17,7 @@ import Utility.Ssh import Types.Remote import qualified Git import qualified Annex -import Logs.UUID +import Annex.UUID import qualified Annex.Content import qualified Utility.Url as Url import Config diff --git a/Remote/Helper/Special.hs b/Remote/Helper/Special.hs index 5603d13aa..52f2dbf95 100644 --- a/Remote/Helper/Special.hs +++ b/Remote/Helper/Special.hs @@ -12,7 +12,6 @@ import qualified Data.Map as M import Common.Annex import Types.Remote import qualified Git -import Logs.UUID {- Special remotes don't have a configured url, so Git.Repo does not - automatically generate remotes for them. This looks for a different diff --git a/Remote/Hook.hs b/Remote/Hook.hs index 2c6b50c7d..8b6a6cecf 100644 --- a/Remote/Hook.hs +++ b/Remote/Hook.hs @@ -15,7 +15,6 @@ import System.Exit import Common.Annex import Types.Remote import qualified Git -import Logs.UUID import Config import Annex.Content import Remote.Helper.Special diff --git a/Remote/Web.hs b/Remote/Web.hs index 21b981846..63963c530 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -11,7 +11,6 @@ import Common.Annex import Types.Remote import qualified Git import Config -import Logs.UUID import Logs.Web import qualified Utility.Url as Url @@ -8,9 +8,11 @@ module Types ( Annex, Backend, - Key + Key, + UUID ) where import Annex import Types.Backend import Types.Key +import Types.UUID diff --git a/Utility/Ssh.hs b/Utility/Ssh.hs index 1847ff244..34e4390f6 100644 --- a/Utility/Ssh.hs +++ b/Utility/Ssh.hs @@ -13,7 +13,7 @@ import qualified Git import Utility.SafeCommand import Types import Config -import Logs.UUID +import Annex.UUID {- Generates parameters to ssh to a repository's host and run a command. - Caller is responsible for doing any neccessary shellEscaping of the diff --git a/git-annex-shell.hs b/git-annex-shell.hs index f19abe6c3..72e130ff0 100644 --- a/git-annex-shell.hs +++ b/git-annex-shell.hs @@ -13,7 +13,7 @@ import qualified Git import CmdLine import Command import Options -import Logs.UUID +import Annex.UUID import qualified Command.ConfigList import qualified Command.InAnnex @@ -23,6 +23,7 @@ import Common import qualified Utility.SafeCommand import qualified Annex +import qualified Annex.UUID import qualified Backend import qualified Git import qualified Locations @@ -609,7 +610,7 @@ checkdangling f = do checklocationlog :: FilePath -> Bool -> Assertion checklocationlog f expected = do - thisuuid <- annexeval Logs.UUID.getUUID + thisuuid <- annexeval Annex.UUID.getUUID r <- annexeval $ Backend.lookupFile f case r of Just (k, _) -> do |