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 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
|
{- git-annex command
-
- Copyright 2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Command.UpdateProxy where
import Command
import qualified Annex
import Logs.Proxy
import Logs.Cluster
import Annex.UUID
import qualified Remote as R
import qualified Types.Remote as R
import Annex.SpecialRemote.Config
import Utility.SafeOutput
import qualified Data.Map as M
import qualified Data.Set as S
cmd :: Command
cmd = noMessages $ command "updateproxy" SectionSetup
"update records with proxy configuration"
paramNothing (withParams seek)
seek :: CmdParams -> CommandSeek
seek = withNothing (commandAction start)
start :: CommandStart
start = startingCustomOutput (ActionItemOther Nothing) $ do
rs <- R.remoteList
remoteproxies <- S.fromList . map mkproxy
<$> filterM isproxy rs
clusterproxies <- getClusterProxies remoteproxies
let proxies = S.union remoteproxies clusterproxies
u <- getUUID
oldproxies <- fromMaybe mempty . M.lookup u <$> getProxies
if oldproxies == proxies
then liftIO $ putStrLn "No proxy changes to record."
else do
describechanges oldproxies proxies
recordProxies proxies
next $ return True
where
describechanges oldproxies proxies =
forM_ (S.toList $ S.union oldproxies proxies) $ \p ->
case (S.member p oldproxies, S.member p proxies) of
(False, True) -> liftIO $
putStrLn $ safeOutput $
"Started proxying for " ++ proxyRemoteName p
(True, False) -> liftIO $
putStrLn $ safeOutput $
"Stopped proxying for " ++ proxyRemoteName p
_ -> noop
mkproxy r = Proxy (R.uuid r) (R.name r)
isproxy r
| remoteAnnexProxy (R.gitconfig r) || not (null (remoteAnnexClusterNode (R.gitconfig r))) =
checkCanProxy r "Cannot proxy to this remote."
| otherwise = pure False
checkCanProxy :: Remote -> String -> Annex Bool
checkCanProxy r cannotmessage
| R.uuid r == NoUUID = do
warning $ UnquotedString $ unwords
[ R.name r
, "is a git remote without a known annex-uuid."
, cannotmessage
]
pure False
| otherwise =
ifM (R.isExportSupported r)
( if annexObjects (R.config r)
then pure True
else do
warnannexobjects
pure False
, pure True
)
where
warnannexobjects = warning $ UnquotedString $ unwords
[ R.name r
, "is a special remote configured with exporttree=yes,"
, "but without annexobjects=yes."
, cannotmessage
, "Suggest you run: git-annex enableremote"
, R.name r
, "annexobjects=yes"
]
-- Automatically proxy nodes of any cluster this repository is configured
-- to serve as a gateway for. Also proxy other cluster nodes that are
-- themselves proxied via other remotes.
getClusterProxies :: S.Set Proxy -> Annex (S.Set Proxy)
getClusterProxies remoteproxies = do
myclusters <- (map mkclusterproxy . M.toList . annexClusters)
<$> Annex.getGitConfig
remoteproxiednodes <- findRemoteProxiedClusterNodes
let myproxieduuids = S.map proxyRemoteUUID remoteproxies
<> S.fromList (map proxyRemoteUUID myclusters)
-- filter out nodes we proxy for from the remote proxied nodes
-- to avoid cycles
let remoteproxiednodes' = filter
(\n -> proxyRemoteUUID n `S.notMember` myproxieduuids)
remoteproxiednodes
return (S.fromList (myclusters ++ remoteproxiednodes'))
where
mkclusterproxy (remotename, cu) =
Proxy (fromClusterUUID cu) remotename
findRemoteProxiedClusterNodes :: Annex [Proxy]
findRemoteProxiedClusterNodes = do
myclusters <- (S.fromList . M.elems . annexClusters)
<$> Annex.getGitConfig
clusternodes <- clusterNodeUUIDs <$> getClusters
let isproxiedclusternode r
| isJust (remoteAnnexProxiedBy (R.gitconfig r)) =
case M.lookup (ClusterNodeUUID (R.uuid r)) clusternodes of
Nothing -> False
Just s -> not $ S.null $
S.intersection s myclusters
| otherwise = False
(map asproxy . filter isproxiedclusternode)
<$> R.remoteList
where
asproxy r = Proxy (R.uuid r) (R.name r)
|