git-annex/Remote/List.hs
Joey Hess 9828f45d85
add RemoteStateHandle
This solves the problem of sameas remotes trampling over per-remote
state. Used for:

* per-remote state, of course
* per-remote metadata, also of course
* per-remote content identifiers, because two remote implementations
  could in theory generate the same content identifier for two different
  peices of content

While chunk logs are per-remote data, they don't use this, because the
number and size of chunks stored is a common property across sameas
remotes.

External special remote had a complication, where it was theoretically
possible for a remote to send SETSTATE or GETSTATE during INITREMOTE or
EXPORTSUPPORTED. Since the uuid of the remote is typically generate in
Remote.setup, it would only be possible to pass a Maybe
RemoteStateHandle into it, and it would otherwise have to construct its
own. Rather than go that route, I decided to send an ERROR in this case.
It seems unlikely that any existing external special remote will be
affected. They would have to make up a git-annex key, and set state for
some reason during INITREMOTE. I can imagine such a hack, but it doesn't
seem worth complicating the code in such an ugly way to support it.

Unfortunately, both TestRemote and Annex.Import needed the Remote
to have a new field added that holds its RemoteStateHandle.
2019-10-14 13:51:42 -04:00

131 lines
3.3 KiB
Haskell

{- git-annex remote list
-
- Copyright 2011-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Remote.List where
import qualified Data.Map as M
import Annex.Common
import qualified Annex
import Logs.Remote
import Types.Remote
import Types.RemoteState
import Annex.UUID
import Remote.Helper.Hooks
import Remote.Helper.ReadOnly
import Remote.Helper.ExportImport
import qualified Git
import qualified Git.Config
import qualified Remote.Git
import qualified Remote.GCrypt
import qualified Remote.P2P
#ifdef WITH_S3
import qualified Remote.S3
#endif
import qualified Remote.Bup
import qualified Remote.Directory
import qualified Remote.Rsync
import qualified Remote.Web
import qualified Remote.BitTorrent
#ifdef WITH_WEBDAV
import qualified Remote.WebDAV
#endif
import qualified Remote.Adb
import qualified Remote.Tahoe
import qualified Remote.Glacier
import qualified Remote.Ddar
import qualified Remote.GitLFS
import qualified Remote.Hook
import qualified Remote.External
remoteTypes :: [RemoteType]
remoteTypes = map adjustExportImportRemoteType
[ Remote.Git.remote
, Remote.GCrypt.remote
, Remote.P2P.remote
#ifdef WITH_S3
, Remote.S3.remote
#endif
, Remote.Bup.remote
, Remote.Directory.remote
, Remote.Rsync.remote
, Remote.Web.remote
, Remote.BitTorrent.remote
#ifdef WITH_WEBDAV
, Remote.WebDAV.remote
#endif
, Remote.Adb.remote
, Remote.Tahoe.remote
, Remote.Glacier.remote
, Remote.Ddar.remote
, Remote.GitLFS.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 remoteList' False
else return rs
remoteList' :: Bool -> Annex [Remote]
remoteList' autoinit = do
m <- readRemoteLog
rs <- concat <$> mapM (process m) remoteTypes
Annex.changeState $ \s -> s { Annex.remotes = rs }
return rs
where
process m t = enumerate t autoinit
>>= 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.gitremotes = Nothing
, Annex.repo = newg
}
remoteList
{- Generates a Remote. -}
remoteGen :: M.Map UUID RemoteConfig -> RemoteType -> Git.Repo -> Annex (Maybe Remote)
remoteGen m t g = do
u <- getRepoUUID g
gc <- Annex.getRemoteGitConfig g
let cu = fromMaybe u $ remoteAnnexConfigUUID gc
let rs = RemoteStateHandle cu
let c = fromMaybe M.empty $ M.lookup cu m
generate t g u c gc rs >>= \case
Nothing -> return Nothing
Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r)) rs
{- Updates a local git Remote, re-reading its git config. -}
updateRemote :: Remote -> Annex (Maybe Remote)
updateRemote remote = do
m <- readRemoteLog
remote' <- updaterepo =<< getRepo remote
remoteGen m (remotetype remote) remote'
where
updaterepo r
| Git.repoIsLocal r || Git.repoIsLocalUnknown r =
Remote.Git.configRead False r
| otherwise = return r
{- Checks if a remote is syncable using git. -}
gitSyncableRemote :: Remote -> Bool
gitSyncableRemote r = remotetype r `elem`
[ Remote.Git.remote, Remote.GCrypt.remote, Remote.P2P.remote ]