From 772f686a33e17ce104d0a9e5cc28a70e28250eb2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 14 Sep 2015 14:49:48 -0400
Subject: Special remotes configured with autoenable=true will be automatically
 enabled when git-annex init is run.

---
 Annex/SpecialRemote.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)
 create mode 100644 Annex/SpecialRemote.hs

(limited to 'Annex')

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
-- 
cgit v1.2.3