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.

diff --git a/Command/P2P.hs b/Command/P2P.hs
index c26b30374d1653f1ca7569e0497286c816c946a0..0ee588f42ab4d69c94790eb87c18ce0f86d29db8 100644 (file)
--- 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 20a8ce460d105732dbc0fc5b5bc53057113b7dde..8de3eda39c299bff274eb0043de840fffcf22e33 100644 (file)
--- a/P2P/Auth.hs
+++ b/P2P/Auth.hs
@@ -1,6 +1,6 @@
 {- P2P authtokens
  -
- - Copyright 2016 Joey Hess <id@joeyh.name>
+ - Copyright 2016-2025 Joey Hess <id@joeyh.name>
  -
  - 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
+
+-- | 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]
-loadP2PAuthTokens' = mapMaybe toAuthToken
-        . map T.pack
+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 550a9404ddea3b8f0be7731b409408c051e552f5..3970acbd2e09a07e65c90689017cd68fe743d48f 100644 (file)
--- 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)