aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Remote/Bup.hs33
-rw-r--r--Remote/Directory.hs1
-rw-r--r--Remote/Git.hs70
-rw-r--r--Remote/Hook.hs1
-rw-r--r--Remote/List.hs14
-rw-r--r--Remote/Rsync.hs33
-rw-r--r--Remote/S3.hs1
-rw-r--r--Remote/Web.hs1
-rw-r--r--Types/Remote.hs2
-rw-r--r--Utility/RsyncFile.hs6
10 files changed, 97 insertions, 65 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index 8a2c1afef..83739a3e1 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -46,21 +46,24 @@ gen r u c = do
return $ encryptableRemote c
(storeEncrypted r buprepo)
(retrieveEncrypted buprepo)
- Remote {
- uuid = u',
- cost = cst,
- name = Git.repoDescribe r,
- storeKey = store r buprepo,
- retrieveKeyFile = retrieve buprepo,
- retrieveKeyFileCheap = retrieveCheap buprepo,
- removeKey = remove,
- hasKey = checkPresent r bupr',
- hasKeyCheap = bupLocal buprepo,
- whereisKey = Nothing,
- config = c,
- repo = r,
- remotetype = remote
- }
+ Remote
+ { uuid = u'
+ , cost = cst
+ , name = Git.repoDescribe r
+ , storeKey = store r buprepo
+ , retrieveKeyFile = retrieve buprepo
+ , retrieveKeyFileCheap = retrieveCheap buprepo
+ , removeKey = remove
+ , hasKey = checkPresent r bupr'
+ , hasKeyCheap = bupLocal buprepo
+ , whereisKey = Nothing
+ , config = c
+ , repo = r
+ , path = if bupLocal buprepo && not (null buprepo)
+ then Just buprepo
+ else Nothing
+ , remotetype = remote
+ }
bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
bupSetup u c = do
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 6b158730e..1b75b937f 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -53,6 +53,7 @@ gen r u c = do
whereisKey = Nothing,
config = Nothing,
repo = r,
+ path = Just dir,
remotetype = remote
}
where
diff --git a/Remote/Git.hs b/Remote/Git.hs
index 3412de89b..f42a1d536 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -5,7 +5,11 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-module Remote.Git (remote, repoAvail) where
+module Remote.Git (
+ remote,
+ configRead,
+ repoAvail,
+) where
import qualified Data.Map as M
import Control.Exception.Extensible
@@ -45,7 +49,7 @@ list :: Annex [Git.Repo]
list = do
c <- fromRepo Git.config
rs <- mapM (tweakurl c) =<< fromRepo Git.remotes
- mapM configread rs
+ mapM configRead rs
where
annexurl n = "remote." ++ n ++ ".annexurl"
tweakurl c r = do
@@ -55,19 +59,21 @@ list = do
Just url -> inRepo $ \g ->
Git.Construct.remoteNamed n $
Git.Construct.fromRemoteLocation url g
- {- It's assumed to be cheap to read the config of non-URL
- - remotes, so this is done each time git-annex is run
- - in a way that uses remotes.
- - Conversely, the config of an URL remote is only read
- - when there is no cached UUID value. -}
- configread r = do
- notignored <- repoNotIgnored r
- u <- getRepoUUID r
- case (repoCheap r, notignored, u) of
- (_, False, _) -> return r
- (True, _, _) -> tryGitConfigRead r
- (False, _, NoUUID) -> tryGitConfigRead r
- _ -> return r
+
+{- It's assumed to be cheap to read the config of non-URL remotes, so this is
+ - done each time git-annex is run in a way that uses remotes.
+ -
+ - Conversely, the config of an URL remote is only read when there is no
+ - cached UUID value. -}
+configRead :: Git.Repo -> Annex Git.Repo
+configRead r = do
+ notignored <- repoNotIgnored r
+ u <- getRepoUUID r
+ case (repoCheap r, notignored, u) of
+ (_, False, _) -> return r
+ (True, _, _) -> tryGitConfigRead r
+ (False, _, NoUUID) -> tryGitConfigRead r
+ _ -> return r
repoCheap :: Git.Repo -> Bool
repoCheap = not . Git.repoIsUrl
@@ -76,21 +82,25 @@ gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
gen r u _ = new <$> remoteCost r defcst
where
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
- new cst = Remote {
- uuid = u,
- cost = cst,
- name = Git.repoDescribe r,
- storeKey = copyToRemote r,
- retrieveKeyFile = copyFromRemote r,
- retrieveKeyFileCheap = copyFromRemoteCheap r,
- removeKey = dropKey r,
- hasKey = inAnnex r,
- hasKeyCheap = repoCheap r,
- whereisKey = Nothing,
- config = Nothing,
- repo = r,
- remotetype = remote
- }
+ new cst = Remote
+ { uuid = u
+ , cost = cst
+ , name = Git.repoDescribe r
+ , storeKey = copyToRemote r
+ , retrieveKeyFile = copyFromRemote r
+ , retrieveKeyFileCheap = copyFromRemoteCheap r
+ , removeKey = dropKey r
+ , hasKey = inAnnex r
+ , hasKeyCheap = repoCheap r
+ , whereisKey = Nothing
+ , config = Nothing
+ , path = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
+ then Just $ Git.repoPath r
+ else Nothing
+ , repo = r
+ , remotetype = remote
+ }
+
{- Checks relatively inexpensively if a repository is available for use. -}
repoAvail :: Git.Repo -> Annex Bool
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index cad6e2fc9..9af851d14 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -47,6 +47,7 @@ gen r u c = do
hasKeyCheap = False,
whereisKey = Nothing,
config = Nothing,
+ path = Nothing,
repo = r,
remotetype = remote
}
diff --git a/Remote/List.hs b/Remote/List.hs
index 14a1771b4..4127cf24b 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -2,7 +2,7 @@
{- git-annex remote list
-
- - Copyright 2011 Joey Hess <joey@kitenet.net>
+ - Copyright 2011,2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -18,6 +18,7 @@ import Types.Remote
import Annex.UUID
import Config
import Remote.Helper.Hooks
+import qualified Git
import qualified Remote.Git
#ifdef WITH_S3
@@ -55,10 +56,13 @@ remoteList = do
return rs'
else return rs
where
- process m t = enumerate t >>= mapM (gen m t)
- gen m t r = do
- u <- getRepoUUID r
- addHooks =<< generate t r u (M.lookup u m)
+ process m t = enumerate t >>= mapM (remoteGen m t)
+
+{- Generates a Remote. -}
+remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
+remoteGen m t r = do
+ u <- getRepoUUID r
+ addHooks =<< generate t r u (M.lookup u m)
{- All remotes that are not ignored. -}
enabledRemoteList :: Annex [Remote]
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index ee516a8a5..1ed73e119 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -45,21 +45,24 @@ gen r u c = do
return $ encryptableRemote c
(storeEncrypted o)
(retrieveEncrypted o)
- Remote {
- uuid = u,
- cost = cst,
- name = Git.repoDescribe r,
- storeKey = store o,
- retrieveKeyFile = retrieve o,
- retrieveKeyFileCheap = retrieveCheap o,
- removeKey = remove o,
- hasKey = checkPresent r o,
- hasKeyCheap = False,
- whereisKey = Nothing,
- config = Nothing,
- repo = r,
- remotetype = remote
- }
+ Remote
+ { uuid = u
+ , cost = cst
+ , name = Git.repoDescribe r
+ , storeKey = store o
+ , retrieveKeyFile = retrieve o
+ , retrieveKeyFileCheap = retrieveCheap o
+ , removeKey = remove o
+ , hasKey = checkPresent r o
+ , hasKeyCheap = False
+ , whereisKey = Nothing
+ , config = Nothing
+ , repo = r
+ , path = if rsyncUrlIsPath $ rsyncUrl o
+ then Just $ rsyncUrl o
+ else Nothing
+ , remotetype = remote
+ }
genRsyncOpts :: Git.Repo -> Maybe RemoteConfig -> Annex RsyncOpts
genRsyncOpts r c = do
diff --git a/Remote/S3.hs b/Remote/S3.hs
index dca08fff8..6e249ec4d 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -60,6 +60,7 @@ gen' r u c cst =
whereisKey = Nothing,
config = c,
repo = r,
+ path = Nothing,
remotetype = remote
}
diff --git a/Remote/Web.hs b/Remote/Web.hs
index 2516240ab..02a2b5ab4 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -47,6 +47,7 @@ gen r _ _ =
hasKeyCheap = False,
whereisKey = Just getUrls,
config = Nothing,
+ path = Nothing,
repo = r,
remotetype = remote
}
diff --git a/Types/Remote.hs b/Types/Remote.hs
index c7628165c..814be9feb 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -64,6 +64,8 @@ data RemoteA a = Remote {
config :: Maybe RemoteConfig,
-- git configuration for the remote
repo :: Git.Repo,
+ -- a Remote can be assocated with a specific filesystem path
+ path :: Maybe FilePath,
-- the type of the remote
remotetype :: RemoteTypeA a
}
diff --git a/Utility/RsyncFile.hs b/Utility/RsyncFile.hs
index 075e91d23..5a9a256a9 100644
--- a/Utility/RsyncFile.hs
+++ b/Utility/RsyncFile.hs
@@ -61,3 +61,9 @@ rsyncUrlIsShell s
| c == '/' = False -- got to directory with no colon
| c == ':' = not $ ":" `isPrefixOf` cs
| otherwise = go cs
+
+{- Checks if a rsync url is really just a local path. -}
+rsyncUrlIsPath :: String -> Bool
+rsyncUrlIsPath s
+ | rsyncUrlIsShell s = False
+ | otherwise = ':' `notElem` s