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.)
91 lines
2.7 KiB
Haskell
91 lines
2.7 KiB
Haskell
{- git-annex special remote configuration
|
|
-
|
|
- Copyright 2011-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.SpecialRemote where
|
|
|
|
import Annex.Common
|
|
import Remote (remoteTypes, remoteMap)
|
|
import Types.Remote (RemoteConfig, RemoteConfigKey, SetupStage(..), typename, setup)
|
|
import Types.GitConfig
|
|
import Logs.Remote
|
|
import Logs.Trust
|
|
import qualified Git.Config
|
|
import Git.Types (RemoteName)
|
|
|
|
import qualified Data.Map as M
|
|
import Data.Ord
|
|
|
|
{- See if there's an existing special remote with this name.
|
|
-
|
|
- Prefer remotes that are not dead when a name appears multiple times. -}
|
|
findExisting :: RemoteName -> Annex (Maybe (UUID, RemoteConfig))
|
|
findExisting name = do
|
|
t <- trustMap
|
|
headMaybe
|
|
. sortBy (comparing $ \(u, _c) -> Down $ M.lookup u t)
|
|
. findByName name
|
|
<$> Logs.Remote.readRemoteLog
|
|
|
|
newConfig :: RemoteName -> RemoteConfig
|
|
newConfig = M.singleton nameKey
|
|
|
|
findByName :: RemoteName -> M.Map UUID RemoteConfig -> [(UUID, RemoteConfig)]
|
|
findByName n = filter (matching . snd) . M.toList
|
|
where
|
|
matching c = case M.lookup nameKey c of
|
|
Nothing -> False
|
|
Just n'
|
|
| n' == n -> True
|
|
| otherwise -> False
|
|
|
|
specialRemoteMap :: Annex (M.Map UUID RemoteName)
|
|
specialRemoteMap = do
|
|
m <- Logs.Remote.readRemoteLog
|
|
return $ M.fromList $ mapMaybe go (M.toList m)
|
|
where
|
|
go (u, c) = case M.lookup nameKey c of
|
|
Nothing -> Nothing
|
|
Just n -> Just (u, n)
|
|
|
|
{- find the specified remote type -}
|
|
findType :: RemoteConfig -> Either String RemoteType
|
|
findType config = maybe unspecified specified $ M.lookup typeKey config
|
|
where
|
|
unspecified = Left "Specify the type of remote with type="
|
|
specified s = case filter (findtype s) remoteTypes of
|
|
[] -> Left $ "Unknown remote type " ++ s
|
|
(t:_) -> Right t
|
|
findtype s i = typename i == s
|
|
|
|
{- The name of a configured remote is stored in its config using this key. -}
|
|
nameKey :: RemoteConfigKey
|
|
nameKey = "name"
|
|
|
|
{- The type of a remote is stored in its config using this key. -}
|
|
typeKey :: RemoteConfigKey
|
|
typeKey = "type"
|
|
|
|
autoEnableKey :: RemoteConfigKey
|
|
autoEnableKey = "autoenable"
|
|
|
|
autoEnable :: Annex ()
|
|
autoEnable = do
|
|
remotemap <- M.filter configured <$> readRemoteLog
|
|
enabled <- remoteMap id
|
|
forM_ (M.toList remotemap) $ \(u, c) -> unless (u `M.member` enabled) $ do
|
|
case (M.lookup nameKey c, findType c) of
|
|
(Just name, Right t) -> whenM (canenable u) $ do
|
|
showSideAction $ "Auto enabling special remote " ++ name
|
|
dummycfg <- liftIO dummyRemoteGitConfig
|
|
tryNonAsync (setup t (Enable c) (Just u) Nothing c dummycfg) >>= \case
|
|
Left e -> warning (show e)
|
|
Right _ -> return ()
|
|
_ -> return ()
|
|
where
|
|
configured rc = fromMaybe False $
|
|
Git.Config.isTrue =<< M.lookup autoEnableKey rc
|
|
canenable u = (/= DeadTrusted) <$> lookupTrust u
|