break out non-log stuff to separate module
This commit is contained in:
parent
ec169f84b1
commit
ee9af605bc
28 changed files with 86 additions and 78 deletions
|
@ -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
|
||||
|
|
69
Annex/UUID.hs
Normal file
69
Annex/UUID.hs
Normal file
|
@ -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
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -9,6 +9,7 @@ module Command.Init where
|
|||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Annex.UUID
|
||||
import Logs.UUID
|
||||
import Init
|
||||
|
||||
|
|
|
@ -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"
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -10,7 +10,6 @@ module Command.Semitrust where
|
|||
import Common.Annex
|
||||
import Command
|
||||
import qualified Remote
|
||||
import Logs.UUID
|
||||
import Logs.Trust
|
||||
|
||||
command :: [Command]
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -10,7 +10,6 @@ module Command.Untrust where
|
|||
import Common.Annex
|
||||
import Command
|
||||
import qualified Remote
|
||||
import Logs.UUID
|
||||
import Logs.Trust
|
||||
|
||||
command :: [Command]
|
||||
|
|
2
Init.hs
2
Init.hs
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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. -}
|
||||
|
|
54
Logs/UUID.hs
54
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
4
Types.hs
4
Types.hs
|
@ -8,9 +8,11 @@
|
|||
module Types (
|
||||
Annex,
|
||||
Backend,
|
||||
Key
|
||||
Key,
|
||||
UUID
|
||||
) where
|
||||
|
||||
import Annex
|
||||
import Types.Backend
|
||||
import Types.Key
|
||||
import Types.UUID
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
3
test.hs
3
test.hs
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue