2012-04-17 22:37:40 +00:00
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
|
2012-01-10 17:11:16 +00:00
|
|
|
{- git-annex remote list
|
|
|
|
-
|
2012-07-22 17:48:50 +00:00
|
|
|
- Copyright 2011,2012 Joey Hess <joey@kitenet.net>
|
2012-01-10 17:11:16 +00:00
|
|
|
-
|
|
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Remote.List where
|
|
|
|
|
|
|
|
import qualified Data.Map as M
|
|
|
|
|
|
|
|
import Common.Annex
|
|
|
|
import qualified Annex
|
|
|
|
import Logs.Remote
|
|
|
|
import Types.Remote
|
2013-01-01 17:52:47 +00:00
|
|
|
import Types.GitConfig
|
2012-01-10 17:11:16 +00:00
|
|
|
import Annex.UUID
|
2012-03-04 20:00:24 +00:00
|
|
|
import Remote.Helper.Hooks
|
2014-01-02 17:12:32 +00:00
|
|
|
import Remote.Helper.ReadOnly
|
2012-07-22 17:48:50 +00:00
|
|
|
import qualified Git
|
2012-08-05 18:49:47 +00:00
|
|
|
import qualified Git.Config
|
2012-01-10 17:11:16 +00:00
|
|
|
|
|
|
|
import qualified Remote.Git
|
2013-09-07 22:38:00 +00:00
|
|
|
import qualified Remote.GCrypt
|
2012-04-14 18:22:33 +00:00
|
|
|
#ifdef WITH_S3
|
2012-02-14 07:10:01 +00:00
|
|
|
import qualified Remote.S3
|
2012-04-14 18:22:33 +00:00
|
|
|
#endif
|
2012-01-10 17:11:16 +00:00
|
|
|
import qualified Remote.Bup
|
|
|
|
import qualified Remote.Directory
|
|
|
|
import qualified Remote.Rsync
|
|
|
|
import qualified Remote.Web
|
2012-11-15 00:25:00 +00:00
|
|
|
#ifdef WITH_WEBDAV
|
|
|
|
import qualified Remote.WebDAV
|
|
|
|
#endif
|
2014-01-08 20:14:37 +00:00
|
|
|
#ifdef WITH_TAHOE
|
|
|
|
import qualified Remote.Tahoe
|
|
|
|
#endif
|
2012-11-20 20:43:58 +00:00
|
|
|
import qualified Remote.Glacier
|
2012-01-10 17:11:16 +00:00
|
|
|
import qualified Remote.Hook
|
external special remotes mostly implemented (untested)
This has not been tested at all. It compiles!
The only known missing things are support for encryption, and for get/set
of special remote configuration, and of key state. (The latter needs
separate work to add a new per-key log file to store that state.)
Only thing I don't much like is that initremote needs to be passed both
type=external and externaltype=foo. It would be better to have just
type=foo
Most of this is quite straightforward code, that largely wrote itself given
the types. The only tricky parts were:
* Need to lock the remote when using it to eg make a request, because
in theory git-annex could have multiple threads that each try to use
a remote at the same time. I don't think that git-annex ever does
that currently, but better safe than sorry.
* Rather than starting up every external special remote program when
git-annex starts, they are started only on demand, when first used.
This will avoid slowdown, especially when running fast git-annex query
commands. Once started, they keep running until git-annex stops, currently,
which may not be ideal, but it's hard to know a better time to stop them.
* Bit of a chicken and egg problem with caching the cost of the remote,
because setting annex-cost in the git config needs the remote to already
be set up. Managed to finesse that.
This commit was sponsored by Lukas Anzinger.
2013-12-26 22:23:13 +00:00
|
|
|
import qualified Remote.External
|
2012-01-10 17:11:16 +00:00
|
|
|
|
|
|
|
remoteTypes :: [RemoteType]
|
|
|
|
remoteTypes =
|
|
|
|
[ Remote.Git.remote
|
2013-09-07 22:38:00 +00:00
|
|
|
, Remote.GCrypt.remote
|
2012-04-14 18:22:33 +00:00
|
|
|
#ifdef WITH_S3
|
2012-02-14 07:10:01 +00:00
|
|
|
, Remote.S3.remote
|
2012-04-14 18:22:33 +00:00
|
|
|
#endif
|
2012-01-10 17:11:16 +00:00
|
|
|
, Remote.Bup.remote
|
|
|
|
, Remote.Directory.remote
|
|
|
|
, Remote.Rsync.remote
|
|
|
|
, Remote.Web.remote
|
2012-11-15 00:25:00 +00:00
|
|
|
#ifdef WITH_WEBDAV
|
|
|
|
, Remote.WebDAV.remote
|
2014-01-08 20:14:37 +00:00
|
|
|
#endif
|
|
|
|
#ifdef WITH_TAHOE
|
|
|
|
, Remote.Tahoe.remote
|
2012-11-15 00:25:00 +00:00
|
|
|
#endif
|
2012-11-20 20:43:58 +00:00
|
|
|
, Remote.Glacier.remote
|
2012-01-10 17:11:16 +00:00
|
|
|
, Remote.Hook.remote
|
external special remotes mostly implemented (untested)
This has not been tested at all. It compiles!
The only known missing things are support for encryption, and for get/set
of special remote configuration, and of key state. (The latter needs
separate work to add a new per-key log file to store that state.)
Only thing I don't much like is that initremote needs to be passed both
type=external and externaltype=foo. It would be better to have just
type=foo
Most of this is quite straightforward code, that largely wrote itself given
the types. The only tricky parts were:
* Need to lock the remote when using it to eg make a request, because
in theory git-annex could have multiple threads that each try to use
a remote at the same time. I don't think that git-annex ever does
that currently, but better safe than sorry.
* Rather than starting up every external special remote program when
git-annex starts, they are started only on demand, when first used.
This will avoid slowdown, especially when running fast git-annex query
commands. Once started, they keep running until git-annex stops, currently,
which may not be ideal, but it's hard to know a better time to stop them.
* Bit of a chicken and egg problem with caching the cost of the remote,
because setting annex-cost in the git config needs the remote to already
be set up. Managed to finesse that.
This commit was sponsored by Lukas Anzinger.
2013-12-26 22:23:13 +00:00
|
|
|
, Remote.External.remote
|
2012-01-10 17:11:16 +00:00
|
|
|
]
|
|
|
|
|
|
|
|
{- Builds a list of all available Remotes.
|
|
|
|
- Since doing so can be expensive, the list is cached. -}
|
|
|
|
remoteList :: Annex [Remote]
|
|
|
|
remoteList = do
|
|
|
|
rs <- Annex.getState Annex.remotes
|
|
|
|
if null rs
|
|
|
|
then do
|
|
|
|
m <- readRemoteLog
|
|
|
|
rs' <- concat <$> mapM (process m) remoteTypes
|
|
|
|
Annex.changeState $ \s -> s { Annex.remotes = rs' }
|
|
|
|
return rs'
|
|
|
|
else return rs
|
2012-11-11 04:51:07 +00:00
|
|
|
where
|
2013-09-12 19:54:35 +00:00
|
|
|
process m t = enumerate t >>= mapM (remoteGen m t) >>= return . catMaybes
|
2012-07-22 17:48:50 +00:00
|
|
|
|
2012-08-05 18:49:47 +00:00
|
|
|
{- Forces the remoteList to be re-generated, re-reading the git config. -}
|
|
|
|
remoteListRefresh :: Annex [Remote]
|
|
|
|
remoteListRefresh = do
|
|
|
|
newg <- inRepo Git.Config.reRead
|
|
|
|
Annex.changeState $ \s -> s
|
|
|
|
{ Annex.remotes = []
|
|
|
|
, Annex.repo = newg
|
|
|
|
}
|
|
|
|
remoteList
|
|
|
|
|
2012-07-22 17:48:50 +00:00
|
|
|
{- Generates a Remote. -}
|
2013-09-26 03:19:01 +00:00
|
|
|
remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
|
2012-07-22 17:48:50 +00:00
|
|
|
remoteGen m t r = do
|
|
|
|
u <- getRepoUUID r
|
2013-01-01 17:52:47 +00:00
|
|
|
g <- fromRepo id
|
|
|
|
let gc = extractRemoteGitConfig g (Git.repoDescribe r)
|
|
|
|
let c = fromMaybe M.empty $ M.lookup u m
|
2013-09-12 19:54:35 +00:00
|
|
|
mrmt <- generate t r u c gc
|
2014-01-02 17:12:32 +00:00
|
|
|
return $ adjustReadOnly . addHooks <$> mrmt
|
2012-01-10 17:11:16 +00:00
|
|
|
|
2012-08-05 18:49:47 +00:00
|
|
|
{- Updates a local git Remote, re-reading its git config. -}
|
2013-09-12 19:54:35 +00:00
|
|
|
updateRemote :: Remote -> Annex (Maybe Remote)
|
2012-08-05 18:49:47 +00:00
|
|
|
updateRemote remote = do
|
|
|
|
m <- readRemoteLog
|
|
|
|
remote' <- updaterepo $ repo remote
|
|
|
|
remoteGen m (remotetype remote) remote'
|
2012-11-11 04:51:07 +00:00
|
|
|
where
|
|
|
|
updaterepo r
|
|
|
|
| Git.repoIsLocal r || Git.repoIsLocalUnknown r =
|
|
|
|
Remote.Git.configRead r
|
|
|
|
| otherwise = return r
|
2012-08-05 18:49:47 +00:00
|
|
|
|
2013-09-09 13:58:17 +00:00
|
|
|
{- Checks if a remote is syncable using git. -}
|
|
|
|
syncableRemote :: Remote -> Bool
|
|
|
|
syncableRemote r = remotetype r `elem`
|
|
|
|
[ Remote.Git.remote, Remote.GCrypt.remote ]
|