summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Command/Describe.hs14
-rw-r--r--Command/Semitrust.hs13
-rw-r--r--Command/Trust.hs13
-rw-r--r--Command/Untrust.hs13
-rw-r--r--Remote.hs40
-rw-r--r--UUID.hs9
-rw-r--r--test.hs2
7 files changed, 58 insertions, 46 deletions
diff --git a/Command/Describe.hs b/Command/Describe.hs
index 32aef4f24..9e98a8143 100644
--- a/Command/Describe.hs
+++ b/Command/Describe.hs
@@ -7,10 +7,8 @@
module Command.Describe where
-
import Command
-import qualified GitRepo as Git
-import qualified Remotes
+import qualified Remote
import UUID
import Messages
import qualified Command.Init
@@ -30,12 +28,10 @@ start params = notBareRepo $ do
_ -> error "Specify a repository and a description."
showStart "describe" name
- Remotes.readConfigs
- r <- Remotes.byName name
- return $ Just $ perform r description
+ u <- Remote.nameToUUID name
+ return $ Just $ perform u description
-perform :: Git.Repo -> String -> CommandPerform
-perform repo description = do
- u <- getUUID repo
+perform :: UUID -> String -> CommandPerform
+perform u description = do
describeUUID u description
return $ Just $ Command.Init.cleanup
diff --git a/Command/Semitrust.hs b/Command/Semitrust.hs
index 351336b89..e64d418f8 100644
--- a/Command/Semitrust.hs
+++ b/Command/Semitrust.hs
@@ -8,8 +8,7 @@
module Command.Semitrust where
import Command
-import qualified GitRepo as Git
-import qualified Remotes
+import qualified Remote
import UUID
import Trust
import Messages
@@ -24,12 +23,10 @@ seek = [withString start]
start :: CommandStartString
start name = notBareRepo $ do
showStart "semitrust" name
- Remotes.readConfigs
- r <- Remotes.byName name
- return $ Just $ perform r
+ u <- Remote.nameToUUID name
+ return $ Just $ perform u
-perform :: Git.Repo -> CommandPerform
-perform repo = do
- uuid <- getUUID repo
+perform :: UUID -> CommandPerform
+perform uuid = do
trustSet uuid SemiTrusted
return $ Just $ return True
diff --git a/Command/Trust.hs b/Command/Trust.hs
index f7dba5648..05505cd04 100644
--- a/Command/Trust.hs
+++ b/Command/Trust.hs
@@ -8,8 +8,7 @@
module Command.Trust where
import Command
-import qualified GitRepo as Git
-import qualified Remotes
+import qualified Remote
import Trust
import UUID
import Messages
@@ -24,12 +23,10 @@ seek = [withString start]
start :: CommandStartString
start name = notBareRepo $ do
showStart "trust" name
- Remotes.readConfigs
- r <- Remotes.byName name
- return $ Just $ perform r
+ u <- Remote.nameToUUID name
+ return $ Just $ perform u
-perform :: Git.Repo -> CommandPerform
-perform repo = do
- uuid <- getUUID repo
+perform :: UUID -> CommandPerform
+perform uuid = do
trustSet uuid Trusted
return $ Just $ return True
diff --git a/Command/Untrust.hs b/Command/Untrust.hs
index 9c11efe46..311ec6eeb 100644
--- a/Command/Untrust.hs
+++ b/Command/Untrust.hs
@@ -8,8 +8,7 @@
module Command.Untrust where
import Command
-import qualified GitRepo as Git
-import qualified Remotes
+import qualified Remote
import UUID
import Trust
import Messages
@@ -24,12 +23,10 @@ seek = [withString start]
start :: CommandStartString
start name = notBareRepo $ do
showStart "untrust" name
- Remotes.readConfigs
- r <- Remotes.byName name
- return $ Just $ perform r
+ u <- Remote.nameToUUID name
+ return $ Just $ perform u
-perform :: Git.Repo -> CommandPerform
-perform repo = do
- uuid <- getUUID repo
+perform :: UUID -> CommandPerform
+perform uuid = do
trustSet uuid UnTrusted
return $ Just $ return True
diff --git a/Remote.hs b/Remote.hs
index f4b56846b..64ad85d62 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -6,12 +6,15 @@
-}
module Remote (
+ byName,
+ nameToUUID,
keyPossibilities,
remotesWithUUID,
remotesWithoutUUID
) where
import Control.Monad.State (liftIO)
+import Control.Monad (when, liftM)
import Data.List
import RemoteClass
@@ -21,6 +24,7 @@ import UUID
import qualified Annex
import Trust
import LocationLog
+import Messages
{- add generators for new Remotes here -}
generators :: [Annex [Remote Annex]]
@@ -30,7 +34,9 @@ generators = [Remote.GitRemote.generate]
- Since doing so can be expensive, the list is cached in the Annex. -}
genList :: Annex [Remote Annex]
genList = do
- liftIO $ putStrLn "Remote.genList"
+ g <- Annex.gitRepo
+ u <- getUUID g
+ showNote $ "Remote.genList " ++ u
rs <- Annex.getState Annex.remotes
if null rs
then do
@@ -40,13 +46,24 @@ genList = do
return rs'
else return rs
-{- Filters a list of remotes to ones that have the listed uuids. -}
-remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
-remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
+{- Looks up a remote by name. (Or by UUID.) -}
+byName :: String -> Annex (Remote Annex)
+byName "" = error "no remote specified"
+byName n = do
+ allremotes <- genList
+ let match = filter matching allremotes
+ when (null match) $ error $
+ "there is no git remote named \"" ++ n ++ "\""
+ return $ head match
+ where
+ matching r = n == name r || n == uuid r
-{- Filters a list of remotes to ones that do not have the listed uuids. -}
-remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
-remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
+{- Looks up a remote by name (or by UUID), and returns its UUID. -}
+nameToUUID :: String -> Annex UUID
+nameToUUID "." = do -- special case for current repo
+ g <- Annex.gitRepo
+ getUUID g
+nameToUUID n = liftM uuid (byName n)
{- Cost ordered lists of remotes that the LocationLog indicate may have a key.
-
@@ -71,3 +88,12 @@ keyPossibilities key = do
let validremotes = remotesWithUUID allremotes validuuids
return (sort validremotes, validtrusteduuids)
+
+{- Filters a list of remotes to ones that have the listed uuids. -}
+remotesWithUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
+remotesWithUUID rs us = filter (\r -> uuid r `elem` us) rs
+
+{- Filters a list of remotes to ones that do not have the listed uuids. -}
+remotesWithoutUUID :: [Remote Annex] -> [UUID] -> [Remote Annex]
+remotesWithoutUUID rs us = filter (\r -> uuid r `notElem` us) rs
+
diff --git a/UUID.hs b/UUID.hs
index 3f2843485..5caf11045 100644
--- a/UUID.hs
+++ b/UUID.hs
@@ -3,6 +3,9 @@
- 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 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
@@ -51,11 +54,7 @@ genUUID = liftIO $ pOpen ReadFromPipe command params $ \h -> hGetLine h
else []
{- Looks up a repo's UUID. May return "" if none is known.
- -
- - UUIDs of remotes are cached in git config, using keys named
- - remote.<name>.annex-uuid
- -
- - -}
+ -}
getUUID :: Git.Repo -> Annex UUID
getUUID r = do
g <- Annex.gitRepo
diff --git a/test.hs b/test.hs
index 49f7f2ab9..57eb5e664 100644
--- a/test.hs
+++ b/test.hs
@@ -334,6 +334,7 @@ test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do
git_annex "semitrust" ["-q", repo] @? "semitrust of semitrusted failed"
trustcheck Trust.SemiTrusted "semitrusted 2"
where
+ repo = "origin"
trustcheck expected msg = do
present <- annexeval $ do
Remotes.readConfigs
@@ -342,7 +343,6 @@ test_trust = "git-annex trust/untrust/semitrust" ~: intmpclonerepo $ do
u <- UUID.getUUID r
return $ u `elem` l
assertBool msg present
- repo = "origin"
test_fsck :: Test
test_fsck = "git-annex fsck" ~: TestList [basicfsck, withlocaluntrusted, withremoteuntrusted]