1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{- 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 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
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
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
|
