6c565ec905
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.
109 lines
2.6 KiB
Haskell
109 lines
2.6 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
{- git-annex remote list
|
|
-
|
|
- Copyright 2011,2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- 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
|
|
import Types.GitConfig
|
|
import Annex.UUID
|
|
import Remote.Helper.Hooks
|
|
import qualified Git
|
|
import qualified Git.Config
|
|
|
|
import qualified Remote.Git
|
|
import qualified Remote.GCrypt
|
|
#ifdef WITH_S3
|
|
import qualified Remote.S3
|
|
#endif
|
|
import qualified Remote.Bup
|
|
import qualified Remote.Directory
|
|
import qualified Remote.Rsync
|
|
import qualified Remote.Web
|
|
#ifdef WITH_WEBDAV
|
|
import qualified Remote.WebDAV
|
|
#endif
|
|
import qualified Remote.Glacier
|
|
import qualified Remote.Hook
|
|
import qualified Remote.External
|
|
|
|
remoteTypes :: [RemoteType]
|
|
remoteTypes =
|
|
[ Remote.Git.remote
|
|
, Remote.GCrypt.remote
|
|
#ifdef WITH_S3
|
|
, Remote.S3.remote
|
|
#endif
|
|
, Remote.Bup.remote
|
|
, Remote.Directory.remote
|
|
, Remote.Rsync.remote
|
|
, Remote.Web.remote
|
|
#ifdef WITH_WEBDAV
|
|
, Remote.WebDAV.remote
|
|
#endif
|
|
, Remote.Glacier.remote
|
|
, Remote.Hook.remote
|
|
, Remote.External.remote
|
|
]
|
|
|
|
{- 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
|
|
where
|
|
process m t = enumerate t >>= mapM (remoteGen m t) >>= return . catMaybes
|
|
|
|
{- 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
|
|
|
|
{- Generates a Remote. -}
|
|
remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
|
|
remoteGen m t r = do
|
|
u <- getRepoUUID r
|
|
g <- fromRepo id
|
|
let gc = extractRemoteGitConfig g (Git.repoDescribe r)
|
|
let c = fromMaybe M.empty $ M.lookup u m
|
|
mrmt <- generate t r u c gc
|
|
return $ addHooks <$> mrmt
|
|
|
|
{- Updates a local git Remote, re-reading its git config. -}
|
|
updateRemote :: Remote -> Annex (Maybe Remote)
|
|
updateRemote remote = do
|
|
m <- readRemoteLog
|
|
remote' <- updaterepo $ repo remote
|
|
remoteGen m (remotetype remote) remote'
|
|
where
|
|
updaterepo r
|
|
| Git.repoIsLocal r || Git.repoIsLocalUnknown r =
|
|
Remote.Git.configRead r
|
|
| otherwise = return r
|
|
|
|
{- Checks if a remote is syncable using git. -}
|
|
syncableRemote :: Remote -> Bool
|
|
syncableRemote r = remotetype r `elem`
|
|
[ Remote.Git.remote, Remote.GCrypt.remote ]
|