diff --git a/P2P/IO.hs b/P2P/IO.hs index 3e0999775f..89f712fcae 100644 --- a/P2P/IO.hs +++ b/P2P/IO.hs @@ -12,35 +12,33 @@ module P2P.IO , P2PConnection(..) , connectPeer , closeConnection + , serveUnixSocket , setupHandle , runNetProto , runNet ) where +import Common import P2P.Protocol import P2P.Address -import Utility.Process import Git import Git.Command import Utility.AuthToken -import Utility.SafeCommand import Utility.SimpleProtocol -import Utility.Exception import Utility.Metered import Utility.Tor -import Utility.FileSystemEncoding +import Utility.FileMode -import Control.Monad import Control.Monad.Free import Control.Monad.IO.Class import System.Exit (ExitCode(..)) import Network.Socket -import System.IO import Control.Concurrent import Control.Concurrent.Async import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import System.Log.Logger (debugM) +import qualified Network.Socket as S -- Type of interpreters of the Proto free monad. type RunProto m = forall a. (MonadIO m, MonadMask m) => Proto a -> m (Either String a) @@ -68,6 +66,34 @@ closeConnection conn = do hClose (connIhdl conn) hClose (connOhdl conn) +-- Serves the protocol on a unix socket. +-- +-- The callback is run to serve a connection, and is responsible for +-- closing the Handle when done. +-- +-- Note that while the callback is running, other connections won't be +-- processes, so longterm work should be run in a separate thread by +-- the callback. +serveUnixSocket :: FilePath -> (Handle -> IO ()) -> IO () +serveUnixSocket unixsocket serveconn = do + nukeFile unixsocket + soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol + S.bind soc (S.SockAddrUnix unixsocket) + -- Allow everyone to read and write to the socket, + -- so a daemon like tor, that is probably running as a different + -- de sock $ addModes + -- user, can access it. + -- + -- Connections have to authenticate to do anything, + -- so it's fine that other local users can connect to the + -- socket. + modifyFileMode unixsocket $ addModes + [groupReadMode, groupWriteMode, otherReadMode, otherWriteMode] + S.listen soc 2 + forever $ do + (conn, _) <- S.accept soc + setupHandle conn >>= serveconn + setupHandle :: Socket -> IO Handle setupHandle s = do h <- socketToHandle s ReadWriteMode diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index 0fbe9a7200..e7d3794d66 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -14,7 +14,6 @@ import Annex.ChangedRefs import RemoteDaemon.Types import RemoteDaemon.Common import Utility.Tor -import Utility.FileMode import Utility.AuthToken import P2P.Protocol as P2P import P2P.IO @@ -33,7 +32,6 @@ import System.Log.Logger (debugM) import Control.Concurrent.STM import Control.Concurrent.STM.TBMQueue import Control.Concurrent.Async -import qualified Network.Socket as S -- Run tor hidden service. server :: TransportHandle -> IO () @@ -48,30 +46,16 @@ server th@(TransportHandle (LocalRepo r) _) = do replicateM_ maxConnections $ forkIO $ forever $ serveClient th u r q - nukeFile sock - soc <- S.socket S.AF_UNIX S.Stream S.defaultProtocol - S.bind soc (S.SockAddrUnix sock) - -- Allow everyone to read and write to the socket; tor - -- is probably running as a different user. - -- Connections have to authenticate to do anything, - -- so it's fine that other local users can connect to the - -- socket. - modifyFileMode sock $ addModes - [groupReadMode, groupWriteMode, otherReadMode, otherWriteMode] - - S.listen soc 2 debugM "remotedaemon" "Tor hidden service running" - forever $ do - (conn, _) <- S.accept soc - h <- setupHandle conn + serveUnixSocket sock $ \conn -> do ok <- atomically $ ifM (isFullTBMQueue q) ( return False , do - writeTBMQueue q h + writeTBMQueue q conn return True ) unless ok $ do - hClose h + hClose conn warningIO "dropped Tor connection, too busy" go _ Nothing = debugM "remotedaemon" "Tor hidden service not enabled"