{- git-annex proxy log - - Copyright 2024 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE OverloadedStrings #-} module Logs.Proxy ( Proxy(..), getProxies, recordProxies, ) where import qualified Data.Map as M import qualified Annex import Annex.Common import qualified Annex.Branch import qualified Git.Remote import Git.Types import Logs import Logs.UUIDBased import Logs.MapLog import Annex.UUID import qualified Data.Set as S import Data.ByteString.Builder import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Char8 as A8 import qualified Data.ByteString.Lazy as L data Proxy = Proxy { proxyRemoteUUID :: UUID , proxyRemoteName :: RemoteName } deriving (Show, Eq, Ord) -- TODO caching getProxies :: Annex (M.Map UUID (S.Set Proxy)) getProxies = M.map (validateProxies . value) . fromMapLog . parseProxyLog <$> Annex.Branch.get proxyLog recordProxies :: S.Set Proxy -> Annex () recordProxies proxies = do -- If a private UUID has been configured as a proxy, avoid leaking -- it into the git-annex log. privateuuids <- annexPrivateRepos <$> Annex.getGitConfig let proxies' = S.filter (\p -> S.notMember (proxyRemoteUUID p) privateuuids) proxies c <- currentVectorClock u <- getUUID Annex.Branch.change (Annex.Branch.RegardingUUID [u]) proxyLog $ (buildLogNew buildProxyList) . changeLog c u proxies' . parseProxyLog buildProxyList :: S.Set Proxy -> Builder buildProxyList = mconcat . map fmt . S.toList where fmt p = buildUUID (proxyRemoteUUID p) <> colon <> byteString (encodeBS (proxyRemoteName p)) colon = charUtf8 ':' parseProxyLog :: L.ByteString -> Log (S.Set Proxy) parseProxyLog = parseLogNew parseProxyList parseProxyList :: A.Parser (S.Set Proxy) parseProxyList = S.fromList <$> many parseword where parseword = parseproxy <* ((const () <$> A8.char ' ') <|> A.endOfInput) parseproxy = Proxy <$> (toUUID <$> A8.takeWhile1 (/= colon)) <* (const () <$> A8.char colon) <*> (decodeBS <$> A8.takeWhile1 (/= ' ')) colon = ':' -- Filter out any proxies that have a name that is not allowed as a git -- remote name. This avoids any security problems with eg escape -- characters in names, and ensures the name can be used anywhere a usual -- git remote name can be used without causing issues. validateProxies :: S.Set Proxy -> S.Set Proxy validateProxies = S.filter $ \p -> Git.Remote.makeLegalName (proxyRemoteName p) == proxyRemoteName p