From 46ee651c9438a5dfc430b231089d3ac1e0d09e3c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 7 Jul 2025 15:10:15 -0400 Subject: [PATCH] non-tor AuthTokens As groundwork for making git-annex p2p support other P2P networks than tor hidden services, when an AuthToken is not a TorAnnex value, but something else (that will be added later), store the P2PAddress that it will be used with along with the AuthToken. And in loadP2PAuthTokens, only return AuthTokens for the specified P2PAddress. See commit 2de27751d6c81f1842aa762fbd7e01d84968896e for some design work that led to this. Also, git-annex p2p --gen-addresses is changed to generate a separate AuthToken for every P2P address. Rather than generating a single AuthToke and using it for every one. When we have more than just tor, this will be important for security, to avoid a compromise of one P2P network exposing the AuthToken used for another network. --- Command/P2P.hs | 26 +++++++++++-------- P2P/Auth.hs | 47 +++++++++++++++++++++++++++-------- RemoteDaemon/Transport/Tor.hs | 2 +- 3 files changed, 52 insertions(+), 23 deletions(-) diff --git a/Command/P2P.hs b/Command/P2P.hs index c26b30374d..0ee588f42a 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -90,12 +90,16 @@ unusedPeerRemoteName = go (1 :: Integer) =<< usednames genAddresses :: [P2PAddress] -> Annex () genAddresses [] = giveup "No P2P networks are currently available." genAddresses addrs = do - authtoken <- liftIO $ genAuthToken 128 - storeP2PAuthToken authtoken + addrauths <- forM addrs go earlyWarning "These addresses allow access to this git-annex repository. Only share them with people you trust with that access, using trusted communication channels!" liftIO $ putStr $ safeOutput $ unlines $ - map formatP2PAddress $ - map (`P2PAddressAuth` authtoken) addrs + map formatP2PAddress addrauths + + where + go addr = do + authtoken <- liftIO $ genAuthToken 128 + storeP2PAuthToken addr authtoken + return $ P2PAddressAuth addr authtoken -- Address is read from stdin, to avoid leaking it in shell history. linkRemote :: RemoteName -> CommandStart @@ -268,20 +272,20 @@ finishPairing retries remotename (HalfAuthToken ourhalf) (PairData (HalfAuthToke case (toAuthToken (ourhalf <> theirhalf), toAuthToken (theirhalf <> ourhalf)) of (Just ourauthtoken, Just theirauthtoken) -> do liftIO $ putStrLn $ "Successfully exchanged pairing data. Connecting to " ++ remotename ++ "..." - storeP2PAuthToken ourauthtoken - go retries theiraddrs theirauthtoken + go retries theiraddrs theirauthtoken ourauthtoken _ -> return ReceiveFailed where - go 0 [] _ = return $ LinkFailed $ "Unable to connect to " ++ remotename ++ "." - go n [] theirauthtoken = do + go 0 [] _ _ = return $ LinkFailed $ "Unable to connect to " ++ remotename ++ "." + go n [] theirauthtoken ourauthtoken = do liftIO $ threadDelaySeconds (Seconds 2) liftIO $ putStrLn $ "Unable to connect to " ++ remotename ++ ". Retrying..." - go (n-1) theiraddrs theirauthtoken - go n (addr:rest) theirauthtoken = do + go (n-1) theiraddrs theirauthtoken ourauthtoken + go n (addr:rest) theirauthtoken ourauthtoken = do + storeP2PAuthToken addr ourauthtoken r <- setupLink remotename (P2PAddressAuth addr theirauthtoken) case r of LinkSuccess -> return PairSuccess - _ -> go n rest theirauthtoken + _ -> go n rest theirauthtoken ourauthtoken data LinkResult = LinkSuccess diff --git a/P2P/Auth.hs b/P2P/Auth.hs index 20a8ce460d..8de3eda39c 100644 --- a/P2P/Auth.hs +++ b/P2P/Auth.hs @@ -1,6 +1,6 @@ {- P2P authtokens - - - Copyright 2016 Joey Hess + - Copyright 2016-2025 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -18,24 +18,49 @@ import Utility.Env import qualified Data.Text as T --- | Load authtokens that are accepted by this repository. -loadP2PAuthTokens :: Annex AllowedAuthTokens -loadP2PAuthTokens = allowedAuthTokens <$> loadP2PAuthTokens' +-- | Load authtokens that are accepted by this repository for tor. +loadP2PAuthTokensTor :: Annex AllowedAuthTokens +loadP2PAuthTokensTor = allowedAuthTokens + . map fst . filter istor + <$> loadP2PAuthTokens' + where + istor (_, Nothing) = True + istor _ = False -loadP2PAuthTokens' :: Annex [AuthToken] -loadP2PAuthTokens' = mapMaybe toAuthToken - . map T.pack +-- | Load authtokens that are accepted for a given P2PAddress. +loadP2PAuthTokens :: P2PAddress -> Annex AllowedAuthTokens +loadP2PAuthTokens addr = allowedAuthTokens + . map fst . filter ((== Just addr) . snd) + <$> loadP2PAuthTokens' + +loadP2PAuthTokens' :: Annex [(AuthToken, Maybe P2PAddress)] +loadP2PAuthTokens' = mapMaybe parse . lines . fromMaybe [] <$> readCreds p2pAuthCredsFile + where + parse l = + let (tok, addr) = separate (== ' ') l + in do + tok' <- toAuthToken (T.pack tok) + return (tok', unformatP2PAddress addr) -- | Stores an AuthToken, making it be accepted by this repository. -storeP2PAuthToken :: AuthToken -> Annex () -storeP2PAuthToken t = do +storeP2PAuthToken :: P2PAddress -> AuthToken -> Annex () +storeP2PAuthToken addr t = do ts <- loadP2PAuthTokens' - unless (t `elem` ts) $ do - let d = unlines $ map (T.unpack . fromAuthToken) (t:ts) + unless (v `elem` ts) $ do + let d = unlines $ map fmt (v:ts) writeCreds d p2pAuthCredsFile + where + v = case addr of + TorAnnex _ _ -> (t, Nothing) + -- _ -> (t, Just addr) + + fmt (tok, Nothing) = T.unpack (fromAuthToken tok) + fmt (tok, Just addr') = T.unpack (fromAuthToken tok) + ++ " " ++ formatP2PAddress addr' + p2pAuthCredsFile :: OsPath p2pAuthCredsFile = literalOsPath "p2pauth" diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index 550a9404dd..3970acbd2e 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -109,7 +109,7 @@ serveClient th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start ((), (st', _rd)) <- Annex.run (st, rd) $ do -- Load auth tokens for every connection, to notice -- when the allowed set is changed. - allowed <- loadP2PAuthTokens + allowed <- loadP2PAuthTokensTor let conn = P2PConnection { connRepo = Just r , connCheckAuth = (`isAllowedAuthToken` allowed)