only start ref change watcher thread once per P2P connection

This is more efficient. Note that the peer will get CHANGED messages for
all refs changed since the connection opened, even if those changes
happened before it sent NOTIFYCHANGE.

diff --git a/P2P/Annex.hs b/P2P/Annex.hs
index e9b59652c063d904fe1db8ae84b8e0d681dac13c..351fb38bb7dfb09e4c624e1d4efb7195faa75d17 100644 (file)
--- a/P2P/Annex.hs
+++ b/P2P/Annex.hs
@@ -25,10 +25,8 @@ import Utility.Metered
 
 import Control.Monad.Free
 
--- When we're serving a peer, we know their uuid, and can use it to update
--- transfer logs.
 data RunMode
-       = Serving UUID
+       = Serving UUID ChangedRefsHandle
        | Client
 
 -- Full interpreter for Proto, that can receive and send objects.
@@ -115,18 +113,17 @@ runLocal runmode runner a = case a of
                                protoaction False
                                next
                        Right _ -> runner next
-       WaitRefChange next -> do
-               v <- tryNonAsync $ bracket
-                       watchChangedRefs
-                       (liftIO . stopWatchingChangedRefs)
-                       (liftIO . waitChangedRefs)
-               case v of
-                       Left e -> return (Left (show e))
-                       Right changedrefs -> runner (next changedrefs)
+       WaitRefChange next -> case runmode of
+               Serving _ h -> do
+                       v <- tryNonAsync $ liftIO $ waitChangedRefs h
+                       case v of
+                               Left e -> return (Left (show e))
+                               Right changedrefs -> runner (next changedrefs)
+               _ -> return $ Left "change notification not implemented for client"
   where
        transfer mk k af ta = case runmode of
                -- Update transfer logs when serving.
-               Serving theiruuid -> 
+               Serving theiruuid _ -> 
                        mk theiruuid k af noRetry ta noNotification
                -- Transfer logs are updated higher in the stack when
                -- a client.

diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs
index 0dd1d1ba2763f4a5791801c695a70ca8f0896aec..5ea06ac2c3f1c807fe2e2d550b6152ef91298092 100644 (file)
--- a/RemoteDaemon/Transport/Tor.hs
+++ b/RemoteDaemon/Transport/Tor.hs
@@ -10,6 +10,7 @@ module RemoteDaemon.Transport.Tor (server) where
 import Common
 import qualified Annex
 import Annex.Concurrent
+import Annex.ChangedRefs
 import RemoteDaemon.Types
 import RemoteDaemon.Common
 import Utility.Tor
@@ -71,12 +72,18 @@ maxConnections :: Int
 maxConnections = 10
 
 serveClient :: TransportHandle -> UUID -> Repo -> TBQueue Handle -> IO ()
-serveClient th u r q = bracket setup cleanup go
+serveClient th u r q = bracket setup cleanup start
   where
-       setup = atomically $ readTBQueue q
-       cleanup = hClose
-       go h = do
+       setup = do
+               h <- atomically $ readTBQueue q
                debugM "remotedaemon" "serving a Tor connection"
+               return h
+       
+       cleanup h = do
+               debugM "remotedaemon" "done with Tor connection"
+               hClose h
+
+       start h = do
                -- Avoid doing any work in the liftAnnex, since only one
                -- can run at a time.
                st <- liftAnnex th dupState
@@ -92,16 +99,18 @@ serveClient th u r q = bracket setup cleanup go
                                }
                        v <- liftIO $ runNetProto conn $ serveAuth u
                        case v of
-                               Right (Just theiruuid) -> void $ do
-                                       v' <- runFullProto (Serving theiruuid) conn $
-                                               serveAuthed u
-                                       case v' of
-                                               Right () -> return ()
-                                               Left e -> liftIO $ debugM "remotedaemon" ("Tor connection error: " ++ e)
+                               Right (Just theiruuid) -> authed conn theiruuid
                                Right Nothing -> liftIO $
                                        debugM "remotedaemon" "Tor connection failed to authenticate"
                                Left e -> liftIO $
                                        debugM "remotedaemon" ("Tor connection error before authentication: " ++ e)
                -- Merge the duplicated state back in.
                liftAnnex th $ mergeState st'
-               debugM "remotedaemon" "done with Tor connection"
+       
+       authed conn theiruuid = 
+               bracket watchChangedRefs (liftIO . stopWatchingChangedRefs) $ \crh -> do
+                       v' <- runFullProto (Serving theiruuid crh) conn $
+                               serveAuthed u
+                       case v' of
+                               Right () -> return ()
+                               Left e -> liftIO $ debugM "remotedaemon" ("Tor connection error: " ++ e)