summaryrefslogtreecommitdiff
path: root/Annex/SpecialRemote.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-09-14 14:49:48 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-09-14 14:49:48 -0400
commit772f686a33e17ce104d0a9e5cc28a70e28250eb2 (patch)
tree067ebe52d8b461ca27e56d5944ae1d391972006b /Annex/SpecialRemote.hs
parentd8bc62fed9ae2e85235fde7a6cba5f522daf6014 (diff)
Special remotes configured with autoenable=true will be automatically enabled when git-annex init is run.
Diffstat (limited to 'Annex/SpecialRemote.hs')
-rw-r--r--Annex/SpecialRemote.hs85
1 files changed, 85 insertions, 0 deletions
diff --git a/Annex/SpecialRemote.hs b/Annex/SpecialRemote.hs
new file mode 100644
index 000000000..bcff1d930
--- /dev/null
+++ b/Annex/SpecialRemote.hs
@@ -0,0 +1,85 @@
+{- git-annex special remote configuration
+ -
+ - Copyright 2011-2015 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.SpecialRemote where
+
+import Common.Annex
+import Remote (remoteTypes)
+import Types.Remote (RemoteConfig, RemoteConfigKey, typename, setup)
+import Logs.Remote
+import Logs.Trust
+import qualified Git.Config
+
+import qualified Data.Map as M
+import Data.Ord
+
+type RemoteName = String
+
+{- 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
+ matches <- sortBy (comparing $ \(u, _c) -> M.lookup u t)
+ . findByName name
+ <$> Logs.Remote.readRemoteLog
+ return $ headMaybe matches
+
+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
+
+remoteNames :: Annex [RemoteName]
+remoteNames = do
+ m <- Logs.Remote.readRemoteLog
+ return $ mapMaybe (M.lookup nameKey . snd) $ M.toList m
+
+{- 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 wanted <$> readRemoteLog
+ forM_ (M.toList remotemap) $ \(u, c) ->
+ case (M.lookup nameKey c, findType c) of
+ (Just name, Right t) -> do
+ showSideAction $ "Auto enabling special remote " ++ name
+ res <- tryNonAsync $ setup t (Just u) Nothing c
+ case res of
+ Left e -> warning (show e)
+ Right _ -> return ()
+ _ -> return ()
+ where
+ wanted rc = fromMaybe False $
+ Git.Config.isTrue =<< M.lookup autoEnableKey rc