From ee728c1e73ffc7c86c52f3f123adbe0cf2a81a28 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 10 Dec 2016 11:32:05 -0400 Subject: fix build with old stm Old stm lacks isFullTMQueue. To avoid needing to update stm on the Android autobuilder, I switched to a TBMQueue. It never needs to be closed, but the overhead is minimal. --- RemoteDaemon/Transport/Tor.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) (limited to 'RemoteDaemon') diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index 220a3616d..61e1189a5 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -31,6 +31,7 @@ import System.PosixCompat.User import Control.Concurrent import System.Log.Logger (debugM) import Control.Concurrent.STM +import Control.Concurrent.STM.TBMQueue import Control.Concurrent.Async import qualified Network.Socket as S @@ -39,7 +40,7 @@ server :: TransportHandle -> IO () server th@(TransportHandle (LocalRepo r) _) = do u <- liftAnnex th getUUID - q <- newTBQueueIO maxConnections + q <- newTBMQueueIO maxConnections replicateM_ maxConnections $ forkIO $ forever $ serveClient th u r q @@ -59,10 +60,10 @@ server th@(TransportHandle (LocalRepo r) _) = do forever $ do (conn, _) <- S.accept soc h <- setupHandle conn - ok <- atomically $ ifM (isFullTBQueue q) + ok <- atomically $ ifM (isFullTBMQueue q) ( return False , do - writeTBQueue q h + writeTBMQueue q h return True ) unless ok $ do @@ -73,19 +74,21 @@ server th@(TransportHandle (LocalRepo r) _) = do maxConnections :: Int maxConnections = 100 -serveClient :: TransportHandle -> UUID -> Repo -> TBQueue Handle -> IO () +serveClient :: TransportHandle -> UUID -> Repo -> TBMQueue Handle -> IO () serveClient th u r q = bracket setup cleanup start where setup = do - h <- atomically $ readTBQueue q + h <- atomically $ readTBMQueue q debugM "remotedaemon" "serving a Tor connection" return h - cleanup h = do + cleanup Nothing = return () + cleanup (Just h) = do debugM "remotedaemon" "done with Tor connection" hClose h - start h = do + 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 -- cgit v1.2.3