40ecf58d4b
This does not change the overall license of the git-annex program, which was already AGPL due to a number of sources files being AGPL already. Legally speaking, I'm adding a new license under which these files are now available; I already released their current contents under the GPL license. Now they're dual licensed GPL and AGPL. However, I intend for all my future changes to these files to only be released under the AGPL license, and I won't be tracking the dual licensing status, so I'm simply changing the license statement to say it's AGPL. (In some cases, others wrote parts of the code of a file and released it under the GPL; but in all cases I have contributed a significant portion of the code in each file and it's that code that is getting the AGPL license; the GPL license of other contributors allows combining with AGPL code.)
126 lines
3.1 KiB
Haskell
126 lines
3.1 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
|
|
{- git-annex remote list
|
|
-
|
|
- Copyright 2011,2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Remote.List where
|
|
|
|
import qualified Data.Map as M
|
|
|
|
import Annex.Common
|
|
import qualified Annex
|
|
import Logs.Remote
|
|
import Types.Remote
|
|
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.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.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 c = fromMaybe M.empty $ M.lookup u m
|
|
generate t g u c gc >>= \case
|
|
Nothing -> return Nothing
|
|
Just r -> Just <$> adjustExportImport (adjustReadOnly (addHooks r))
|
|
|
|
{- 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 ]
|