From f1781d01d8e0a8152fbe511738b76dca4460bf42 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 31 Jul 2025 14:37:24 -0400 Subject: [PATCH] remotedaemon support for generic P2P transports RemoteDaemon.Transport.Tor was refactored into this, and most of the code is reused between them. getSocketFile does not yet deal with repositories on crippled filesystems that don't support sockets. Annex.Ssh detects that and allows the user to set an environment variable, and something similar could be done here. And it does not deal with a situation where there is no path to the socket file that is not too long. In that situation it would crash out I suppose. Probably though, remotedaemon is ran from the top of the repo, and in that case the path is just ".git/annex/p2p/" so nice and short. This seems to mostly work. But I don't yet have a working git-annex-p2p- command to test it with. And with my not quite working git-annex-p2p-foo test script, running remotedaemon results in an ever-growing number of zombie processes that it's not waiting on. --- Annex/Locations.hs | 6 + P2P/Address.hs | 6 +- P2P/Generic.hs | 20 +-- P2P/IO.hs | 17 +- RemoteDaemon/Transport.hs | 11 +- RemoteDaemon/Transport/P2PGeneric.hs | 237 +++++++++++++++++++++++++++ RemoteDaemon/Transport/Tor.hs | 162 ++---------------- Utility/Tor.hs | 2 +- git-annex.cabal | 1 + 9 files changed, 296 insertions(+), 166 deletions(-) create mode 100644 RemoteDaemon/Transport/P2PGeneric.hs diff --git a/Annex/Locations.hs b/Annex/Locations.hs index b2929a2883..6d1d8804cc 100644 --- a/Annex/Locations.hs +++ b/Annex/Locations.hs @@ -110,6 +110,7 @@ module Annex.Locations ( gitAnnexUrlFile, gitAnnexTmpCfgFile, gitAnnexSshDir, + gitAnnexP2PDir, gitAnnexRemotesDir, gitAnnexAssistantDefaultDir, gitAnnexSimDir, @@ -716,6 +717,11 @@ gitAnnexSshDir :: Git.Repo -> OsPath gitAnnexSshDir r = addTrailingPathSeparator $ gitAnnexDir r literalOsPath "ssh" +{- .git/annex/p2p/ is used for p2p network sockets -} +gitAnnexP2PDir :: Git.Repo -> OsPath +gitAnnexP2PDir r = addTrailingPathSeparator $ + gitAnnexDir r literalOsPath "p2p" + {- .git/annex/remotes/ is used for remote-specific state. -} gitAnnexRemotesDir :: Git.Repo -> OsPath gitAnnexRemotesDir r = addTrailingPathSeparator $ diff --git a/P2P/Address.hs b/P2P/Address.hs index 052f0af6ce..44dfdadc3d 100644 --- a/P2P/Address.hs +++ b/P2P/Address.hs @@ -28,13 +28,13 @@ import System.PosixCompat.Files (fileOwner, fileGroup) data P2PAddress = TorAnnex OnionAddress OnionPort | P2PAnnex P2PNetName UnderlyingP2PAddress - deriving (Eq, Show) + deriving (Eq, Show, Ord) newtype P2PNetName = P2PNetName String - deriving (Eq, Show) + deriving (Eq, Show, Ord) newtype UnderlyingP2PAddress = UnderlyingP2PAddress String - deriving (Eq, Show) + deriving (Eq, Show, Ord) -- | A P2P address, with an AuthToken. -- diff --git a/P2P/Generic.hs b/P2P/Generic.hs index 5399fb6429..c7df150e21 100644 --- a/P2P/Generic.hs +++ b/P2P/Generic.hs @@ -31,16 +31,13 @@ connectGenericP2P netname (UnderlyingP2PAddress address) = Left (ProgramNotInstalled msg) -> giveup msg Left (ProgramFailure msg) -> giveup msg -getSocketGenericP2P :: P2PNetName -> UnderlyingP2PAddress -> IO (Maybe (OsPath, ProcessHandle)) -getSocketGenericP2P netname (UnderlyingP2PAddress address) = do - startExternalAddonProcess - (\p -> p { std_out = CreatePipe }) - (genericP2PCommand netname) [Param "socket", Param address] +socketGenericP2P :: P2PNetName -> UnderlyingP2PAddress -> OsPath -> IO ProcessHandle +socketGenericP2P netname (UnderlyingP2PAddress address) socketfile = do + startExternalAddonProcess id + (genericP2PCommand netname) [Param address, File (fromOsPath socketfile)] >>= \case - Right (_, (Nothing, Just hin, Nothing, pid)) -> - hGetLineUntilExitOrEOF pid hin >>= \case - Just l | not (null l) -> return $ Just (toOsPath l, pid) - _ -> return Nothing + Right (_, (Nothing, Nothing, Nothing, pid)) -> + return pid Right _ -> giveup "internal" Left (ProgramNotInstalled msg) -> giveup msg Left (ProgramFailure msg) -> giveup msg @@ -63,4 +60,7 @@ getAddressGenericP2P netname = let addr = P2PAnnex netname (UnderlyingP2PAddress l) in go (addr:addrs) hin pid | otherwise -> go addrs hin pid - Nothing -> return addrs + Nothing -> do + waitForProcess pid >>= \case + ExitSuccess -> return addrs + ExitFailure _ -> giveup $ genericP2PCommand netname ++ " failed" diff --git a/P2P/IO.hs b/P2P/IO.hs index 95e5cb43b3..ec1cb54375 100644 --- a/P2P/IO.hs +++ b/P2P/IO.hs @@ -20,6 +20,8 @@ module P2P.IO , connectPeer , closeConnection , serveUnixSocket + , serveUnixSocket' + , listenUnixSocket , ProtoFailure(..) , describeProtoFailure , runNetProto @@ -180,6 +182,17 @@ closeConnection conn = do -- the callback. serveUnixSocket :: OsPath -> (Handle -> IO ()) -> IO () serveUnixSocket unixsocket serveconn = do + sock <- listenUnixSocket unixsocket + serveUnixSocket' sock serveconn + +serveUnixSocket' :: S.Socket -> (Handle -> IO ()) -> IO () +serveUnixSocket' soc serveconn = + forever $ do + (conn, _) <- S.accept soc + setupHandleFromSocket conn >>= serveconn + +listenUnixSocket :: OsPath -> IO S.Socket +listenUnixSocket unixsocket = do removeWhenExistsWith removeFile unixsocket soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol S.bind soc (S.SockAddrUnix (fromOsPath unixsocket)) @@ -193,9 +206,7 @@ serveUnixSocket unixsocket serveconn = do modifyFileMode unixsocket $ addModes [groupReadMode, groupWriteMode, otherReadMode, otherWriteMode] S.listen soc 2 - forever $ do - (conn, _) <- S.accept soc - setupHandleFromSocket conn >>= serveconn + return soc setupHandleFromSocket :: Socket -> IO Handle setupHandleFromSocket s = do diff --git a/RemoteDaemon/Transport.hs b/RemoteDaemon/Transport.hs index 35261155d5..8b60826d36 100644 --- a/RemoteDaemon/Transport.hs +++ b/RemoteDaemon/Transport.hs @@ -1,6 +1,6 @@ {- git-remote-daemon transports - - - Copyright 2014 Joey Hess + - Copyright 2014-2025 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -11,8 +11,9 @@ import RemoteDaemon.Types import qualified RemoteDaemon.Transport.Ssh import qualified RemoteDaemon.Transport.GCrypt import qualified RemoteDaemon.Transport.Tor +import qualified RemoteDaemon.Transport.P2PGeneric import qualified Git.GCrypt -import P2P.Address (torAnnexScheme) +import P2P.Address (torAnnexScheme, p2pAnnexScheme) import qualified Data.Map as M @@ -24,7 +25,11 @@ remoteTransports = M.fromList [ ("ssh:", RemoteDaemon.Transport.Ssh.transport) , (Git.GCrypt.urlScheme, RemoteDaemon.Transport.GCrypt.transport) , (torAnnexScheme, RemoteDaemon.Transport.Tor.transport) + , (p2pAnnexScheme, RemoteDaemon.Transport.P2PGeneric.transport) ] remoteServers :: [Server] -remoteServers = [RemoteDaemon.Transport.Tor.server] +remoteServers = + [ RemoteDaemon.Transport.Tor.server + , RemoteDaemon.Transport.P2PGeneric.server + ] diff --git a/RemoteDaemon/Transport/P2PGeneric.hs b/RemoteDaemon/Transport/P2PGeneric.hs new file mode 100644 index 0000000000..67c682c832 --- /dev/null +++ b/RemoteDaemon/Transport/P2PGeneric.hs @@ -0,0 +1,237 @@ +{- git-remote-daemon, generic P2P protocol transports + - + - Copyright 2016-2025 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# LANGUAGE OverloadedStrings #-} + +module RemoteDaemon.Transport.P2PGeneric ( + server, + transport, + serveConnections +) where + +import qualified Annex +import Annex.Common +import Annex.Concurrent +import Annex.ChangedRefs +import Annex.Perms +import RemoteDaemon.Types +import RemoteDaemon.Common +import Utility.AuthToken +import Utility.Hash +import P2P.Protocol as P2P +import P2P.IO +import P2P.Annex +import P2P.Auth +import P2P.Address +import P2P.Generic +import Annex.UUID +import Git +import Git.Command +import qualified Utility.OsString as OS + +import Control.Concurrent +import Control.Concurrent.STM +import Control.Concurrent.STM.TBMQueue +import Control.Concurrent.Async +import Network.Socket (Socket) +import qualified Data.Set as S + +server :: Server +server ichan th@(TransportHandle (LocalRepo r) _ _) = go S.empty + where + go alreadystarted = do + u <- liftAnnex th getUUID + newaddrs <- filter (`S.notMember` alreadystarted) + <$> liftAnnex th loadP2PAddresses + started <- filterM (start u) newaddrs + handlecontrol (S.fromList started <> alreadystarted) + + start _ (TorAnnex _ _) = pure False + start u addr@(P2PAnnex netname@(P2PNetName netname') address) = do + socketfile <- liftAnnex th $ getSocketFile netname address + sock <- listenUnixSocket socketfile + tryNonAsync (socketGenericP2P netname address socketfile) >>= \case + Right _pid -> do + debug' $ "listener started for P2P network " ++ netname' + void $ async $ serveConnections + (loadP2PAuthTokens addr) + netname th u r sock + return True + Left err -> do + liftAnnex th $ warning $ + "unable to start listener for P2P network " + <> UnquotedString netname' + <> ": " <> UnquotedString (show err) + return False + + handlecontrol started = do + msg <- atomically $ readTChan ichan + case msg of + -- On reload, the configuration may have changed to + -- enable a P2P network. Start any new ones. + RELOAD -> go started + _ -> handlecontrol started + +getSocketFile :: P2PNetName -> UnderlyingP2PAddress -> Annex OsPath +getSocketFile (P2PNetName netname) (UnderlyingP2PAddress address) = do + d <- fromRepo gitAnnexP2PDir + createAnnexDirectory d + -- Since unix socket path length is limited, use a md5sum of + -- the netname and address. + let f = d toOsPath (show (md5 (encodeBL (netname ++ ":" ++ address)))) + -- Use whichever is shorter of the absolute or relative path. + relf <- liftIO $ relPathCwdToFile f + absf <- liftIO $ absPath f + if OS.length absf > OS.length relf + then return relf + else return absf + +serveConnections + :: Annex AllowedAuthTokens + -> P2PNetName + -> TransportHandle + -> UUID + -> Repo + -> Socket + -> IO () +serveConnections loadauthtokens (P2PNetName netname) th u r sock = do + q <- newTBMQueueIO maxConnections + replicateM_ maxConnections $ + forkIO $ forever $ + serveClient loadauthtokens (P2PNetName netname) th u r q + serveUnixSocket' sock $ \conn -> do + ok <- atomically $ ifM (isFullTBMQueue q) + ( return False + , do + writeTBMQueue q conn + return True + ) + unless ok $ do + hClose conn + liftAnnex th $ warning $ + "dropped P2P network " + <> UnquotedString netname + <> " connection, too busy" + +-- How many clients to serve at a time, maximum per P2P network. +-- This is to avoid DOS attacks. +maxConnections :: Int +maxConnections = 100 + +serveClient + :: Annex AllowedAuthTokens + -> P2PNetName + -> TransportHandle + -> UUID + -> Repo + -> TBMQueue Handle + -> IO () +serveClient loadauthtokens (P2PNetName netname) th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start + where + setup = do + h <- atomically $ readTBMQueue q + debug' $ "serving a " ++ netname ++ " connection" + return h + + cleanup Nothing = return () + cleanup (Just h) = do + debug' $ "done with " ++ netname ++ " connection" + hClose h + + start Nothing = return () + start (Just h) = do + -- Avoid doing any work in the liftAnnex, since only one + -- can run at a time. + st <- liftAnnex th dupState + ((), (st', _rd)) <- Annex.run (st, rd) $ do + -- Load auth tokens for every connection, to notice + -- when the allowed set is changed. + allowed <- loadauthtokens + let conn = P2PConnection + { connRepo = Just r + , connCheckAuth = (`isAllowedAuthToken` allowed) + , connIhdl = P2PHandle h + , connOhdl = P2PHandle h + , connProcess = Nothing + , connIdent = ConnIdent $ Just $ + netname ++ " remotedaemon" + } + -- not really Client, but we don't know their uuid yet + runstauth <- liftIO $ mkRunState Client + v <- liftIO $ runNetProto runstauth conn $ P2P.serveAuth u + case v of + Right (Just theiruuid) -> authed conn theiruuid + Right Nothing -> liftIO $ debug' $ + netname ++ " connection failed to authenticate" + Left e -> liftIO $ debug' $ + netname ++ " connection error before authentication: " ++ describeProtoFailure e + -- Merge the duplicated state back in. + liftAnnex th $ mergeState st' + + authed conn theiruuid = + bracket watchChangedRefs (liftIO . maybe noop stopWatchingChangedRefs) $ \crh -> do + runst <- liftIO $ mkRunState (Serving theiruuid crh) + v' <- runFullProto runst conn $ + P2P.serveAuthed P2P.ServeReadWrite u + case v' of + Right () -> return () + Left e -> liftIO $ debug' $ + netname ++ " connection error: " ++ describeProtoFailure e + +transport :: Transport +transport (RemoteRepo r gc) url@(RemoteURI uri) th ichan ochan = + case unformatP2PAddress (show uri) of + Nothing -> return () + Just addr -> robustConnection 1 $ do + g <- liftAnnex th Annex.gitRepo + bracket (connectPeer (Just g) addr) closeConnection (go addr) + where + go addr conn = do + myuuid <- liftAnnex th getUUID + authtoken <- fromMaybe nullAuthToken + <$> liftAnnex th (loadP2PRemoteAuthToken addr) + runst <- mkRunState Client + res <- runNetProto runst conn $ P2P.auth myuuid authtoken noop + case res of + Right (Just theiruuid) -> do + expecteduuid <- liftAnnex th $ getRepoUUID r + if expecteduuid == theiruuid + then do + send (CONNECTED url) + status <- handlecontrol + `race` handlepeer runst conn + send (DISCONNECTED url) + return $ either id id status + else return ConnectionStopping + _ -> return ConnectionClosed + + send msg = atomically $ writeTChan ochan msg + + handlecontrol = do + msg <- atomically $ readTChan ichan + case msg of + STOP -> return ConnectionStopping + LOSTNET -> return ConnectionStopping + _ -> handlecontrol + + handlepeer runst conn = do + v <- runNetProto runst conn P2P.notifyChange + case v of + Right (Just (ChangedRefs shas)) -> do + whenM (checkShouldFetch gc th shas) $ + fetch + handlepeer runst conn + _ -> return ConnectionClosed + + fetch = do + send (SYNCING url) + ok <- inLocalRepo th $ + runBool [Param "fetch", Param $ Git.repoDescribe r] + send (DONESYNCING url ok) + +debug' :: String -> IO () +debug' = debug "RemoteDaemon.Transport.P2PGeneric" diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index d927387fb1..640b4353ee 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -1,38 +1,25 @@ {- git-remote-daemon, tor hidden service server and transport - - - Copyright 2016 Joey Hess + - Copyright 2016-2025 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} module RemoteDaemon.Transport.Tor (server, transport, torSocketFile) where -import Common -import qualified Annex -import Annex.Concurrent -import Annex.ChangedRefs +import Annex.Common import RemoteDaemon.Types import RemoteDaemon.Common -import Utility.AuthToken import Utility.Tor -import P2P.Protocol as P2P import P2P.IO -import P2P.Annex import P2P.Auth import P2P.Address import Annex.UUID -import Types.UUID -import Messages -import Git -import Git.Command -import Utility.Debug +import qualified RemoteDaemon.Transport.P2PGeneric as P2PGeneric -import Control.Concurrent import Control.Concurrent.STM -import Control.Concurrent.STM.TBMQueue import Control.Concurrent.Async #ifndef mingw32_HOST_OS import System.Posix.User @@ -48,30 +35,19 @@ server ichan th@(TransportHandle (LocalRepo r) _ _) = go u <- liftAnnex th getUUID msock <- liftAnnex th torSocketFile case msock of - Nothing -> do - debugTor "Tor hidden service not enabled" + Nothing -> return False - Just sock -> do - void $ async $ startservice sock u + Just socketfile -> do + void $ async $ startservice socketfile u return True - startservice sock u = do - q <- newTBMQueueIO maxConnections - replicateM_ maxConnections $ - forkIO $ forever $ serveClient th u r q + startservice socketfile u = do + sock <- listenUnixSocket socketfile + P2PGeneric.serveConnections + loadP2PAuthTokensTor + (P2PNetName "tor") + th u r sock - debugTor "Tor hidden service running" - serveUnixSocket sock $ \conn -> do - ok <- atomically $ ifM (isFullTBMQueue q) - ( return False - , do - writeTBMQueue q conn - return True - ) - unless ok $ do - hClose conn - liftAnnex th $ warning "dropped Tor connection, too busy" - handlecontrol servicerunning = do msg <- atomically $ readTChan ichan case msg of @@ -84,115 +60,12 @@ server ichan th@(TransportHandle (LocalRepo r) _ _) = go -- changes as tor takes care of all that. _ -> handlecontrol servicerunning --- How many clients to serve at a time, maximum. This is to avoid DOS attacks. -maxConnections :: Int -maxConnections = 100 - -serveClient :: TransportHandle -> UUID -> Repo -> TBMQueue Handle -> IO () -serveClient th@(TransportHandle _ _ rd) u r q = bracket setup cleanup start - where - setup = do - h <- atomically $ readTBMQueue q - debugTor "serving a Tor connection" - return h - - cleanup Nothing = return () - cleanup (Just h) = do - debugTor "done with Tor connection" - hClose h - - start Nothing = return () - start (Just h) = do - -- Avoid doing any work in the liftAnnex, since only one - -- can run at a time. - st <- liftAnnex th dupState - ((), (st', _rd)) <- Annex.run (st, rd) $ do - -- Load auth tokens for every connection, to notice - -- when the allowed set is changed. - allowed <- loadP2PAuthTokensTor - let conn = P2PConnection - { connRepo = Just r - , connCheckAuth = (`isAllowedAuthToken` allowed) - , connIhdl = P2PHandle h - , connOhdl = P2PHandle h - , connProcess = Nothing - , connIdent = ConnIdent $ Just "tor remotedaemon" - } - -- not really Client, but we don't know their uuid yet - runstauth <- liftIO $ mkRunState Client - v <- liftIO $ runNetProto runstauth conn $ P2P.serveAuth u - case v of - Right (Just theiruuid) -> authed conn theiruuid - Right Nothing -> liftIO $ debugTor - "Tor connection failed to authenticate" - Left e -> liftIO $ debugTor $ - "Tor connection error before authentication: " ++ describeProtoFailure e - -- Merge the duplicated state back in. - liftAnnex th $ mergeState st' - - authed conn theiruuid = - bracket watchChangedRefs (liftIO . maybe noop stopWatchingChangedRefs) $ \crh -> do - runst <- liftIO $ mkRunState (Serving theiruuid crh) - v' <- runFullProto runst conn $ - P2P.serveAuthed P2P.ServeReadWrite u - case v' of - Right () -> return () - Left e -> liftIO $ debugTor $ - "Tor connection error: " ++ describeProtoFailure e - --- Connect to peer's tor hidden service. +-- Connect to peer's tor hidden service. P2PGeneric can do this, +-- since it uses connectPeer which also supports tor. transport :: Transport -transport (RemoteRepo r gc) url@(RemoteURI uri) th ichan ochan = - case unformatP2PAddress (show uri) of - Nothing -> return () - Just addr -> robustConnection 1 $ do - g <- liftAnnex th Annex.gitRepo - bracket (connectPeer (Just g) addr) closeConnection (go addr) - where - go addr conn = do - myuuid <- liftAnnex th getUUID - authtoken <- fromMaybe nullAuthToken - <$> liftAnnex th (loadP2PRemoteAuthToken addr) - runst <- mkRunState Client - res <- runNetProto runst conn $ P2P.auth myuuid authtoken noop - case res of - Right (Just theiruuid) -> do - expecteduuid <- liftAnnex th $ getRepoUUID r - if expecteduuid == theiruuid - then do - send (CONNECTED url) - status <- handlecontrol - `race` handlepeer runst conn - send (DISCONNECTED url) - return $ either id id status - else return ConnectionStopping - _ -> return ConnectionClosed - - send msg = atomically $ writeTChan ochan msg - - handlecontrol = do - msg <- atomically $ readTChan ichan - case msg of - STOP -> return ConnectionStopping - LOSTNET -> return ConnectionStopping - _ -> handlecontrol +transport = P2PGeneric.transport - handlepeer runst conn = do - v <- runNetProto runst conn P2P.notifyChange - case v of - Right (Just (ChangedRefs shas)) -> do - whenM (checkShouldFetch gc th shas) $ - fetch - handlepeer runst conn - _ -> return ConnectionClosed - - fetch = do - send (SYNCING url) - ok <- inLocalRepo th $ - runBool [Param "fetch", Param $ Git.repoDescribe r] - send (DONESYNCING url ok) - -torSocketFile :: Annex.Annex (Maybe OsPath) +torSocketFile :: Annex (Maybe OsPath) torSocketFile = do u <- getUUID let ident = fromUUID u @@ -202,6 +75,3 @@ torSocketFile = do let uid = 0 #endif liftIO $ getHiddenServiceSocketFile torAppName uid ident - -debugTor :: String -> IO () -debugTor = debug "RemoteDaemon.Transport.Tor" diff --git a/Utility/Tor.hs b/Utility/Tor.hs index cd564d14ae..a49d7375a7 100644 --- a/Utility/Tor.hs +++ b/Utility/Tor.hs @@ -36,7 +36,7 @@ import qualified System.Random as R type OnionPort = Int newtype OnionAddress = OnionAddress String - deriving (Show, Eq) + deriving (Show, Eq, Ord) type OnionSocket = OsPath diff --git a/git-annex.cabal b/git-annex.cabal index 199e97e692..0da9a56845 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -980,6 +980,7 @@ Executable git-annex RemoteDaemon.Core RemoteDaemon.Transport RemoteDaemon.Transport.GCrypt + RemoteDaemon.Transport.P2PGeneric RemoteDaemon.Transport.Tor RemoteDaemon.Transport.Ssh RemoteDaemon.Transport.Ssh.Types -- 2.30.2