webapp: Fix a race that sometimes caused alerts or other notifications to be missed...

When a page is loaded, the javascript requests an notification url, and
does long polling on the url to be informed of changes. But if a change
occured before the notification url was requested, it would not be notified
of that change, and so the page display would not update.

I fixed this by *always* updating the page display after it gets
the notification url. This is extra work, but the overhead is not noticable
in the other overhead of loading a page.

(A nicer way would be to somehow record the version of a page initially
loaded, and then compare it with the current version when getting the
notification url, and only force an update if it's changed. But getting
the "version" of the different parts of the page that use long polling
is difficult.)

diff --git a/Assistant/Threads/DaemonStatus.hs b/Assistant/Threads/DaemonStatus.hs
index fffc6ed37fdfda83dd577582d97c2a7805c8c69c..5bbb15acbe7b558c92e50ddf8c65000e3bede357 100644 (file)
--- a/Assistant/Threads/DaemonStatus.hs
+++ b/Assistant/Threads/DaemonStatus.hs
@@ -17,7 +17,7 @@ import Utility.NotificationBroadcaster
  -}
 daemonStatusThread :: NamedThread
 daemonStatusThread = namedThread "DaemonStatus" $ do
-       notifier <- liftIO . newNotificationHandle
+       notifier <- liftIO . newNotificationHandle False
                =<< changeNotifier <$> getDaemonStatus
        checkpoint
        runEvery (Seconds tenMinutes) <~> do

diff --git a/Assistant/Threads/TransferPoller.hs b/Assistant/Threads/TransferPoller.hs
index 20b832652dbdaff6c987531c9523f9dce259deb4..68075cac8a9eca513d053abdc02b384ceba9b80d 100644 (file)
--- a/Assistant/Threads/TransferPoller.hs
+++ b/Assistant/Threads/TransferPoller.hs
@@ -21,7 +21,7 @@ import qualified Data.Map as M
 transferPollerThread :: NamedThread
 transferPollerThread = namedThread "TransferPoller" $ do
        g <- liftAnnex gitRepo
-       tn <- liftIO . newNotificationHandle =<<
+       tn <- liftIO . newNotificationHandle True =<<
                transferNotifier <$> getDaemonStatus
        forever $ do
                liftIO $ threadDelay 500000 -- 0.5 seconds

diff --git a/Assistant/WebApp.hs b/Assistant/WebApp.hs
index 17aa0ac82c6bb29ae4822b17a4366685d452579b..0812acb4d195d65b4411418eac13474c73fe0e63 100644 (file)
--- a/Assistant/WebApp.hs
+++ b/Assistant/WebApp.hs
@@ -30,7 +30,7 @@ waitNotifier getbroadcaster nid = liftAssistant $ do
 newNotifier :: forall sub. (Assistant NotificationBroadcaster) -> GHandler sub WebApp NotificationId
 newNotifier getbroadcaster = liftAssistant $ do
        b <- getbroadcaster
-       liftIO $ notificationHandleToId <$> newNotificationHandle b
+       liftIO $ notificationHandleToId <$> newNotificationHandle True b
 
 {- Adds the auth parameter as a hidden field on a form. Must be put into
  - every form. -}

diff --git a/Utility/NotificationBroadcaster.hs b/Utility/NotificationBroadcaster.hs
index 413ec2d755b04cd267286555ab4b020a1410c1f3..b873df655fe0fa4fb09546c8cf769a25f6de9eeb 100644 (file)
--- a/Utility/NotificationBroadcaster.hs
+++ b/Utility/NotificationBroadcaster.hs
@@ -40,14 +40,23 @@ data NotificationHandle = NotificationHandle NotificationBroadcaster Notificatio
 newNotificationBroadcaster :: IO NotificationBroadcaster
 newNotificationBroadcaster = atomically $ newTMVar []
 
-{- Allocates a notification handle for a client to use. -}
-newNotificationHandle :: NotificationBroadcaster -> IO NotificationHandle
-newNotificationHandle b = NotificationHandle
+{- Allocates a notification handle for a client to use.
+ -
+ - An immediate notification can be forced the first time waitNotification
+ - is called on the handle. This is useful in cases where a notification
+ - may be sent while the new handle is being constructed. Normally,
+ - such a notification would be missed. Forcing causes extra work,
+ - but ensures such notifications get seen.
+ -}
+newNotificationHandle :: Bool -> NotificationBroadcaster -> IO NotificationHandle
+newNotificationHandle force b = NotificationHandle
        <$> pure b
        <*> addclient
   where
        addclient = do
-               s <- newEmptySV
+               s <- if force
+                       then newSV ()
+                       else newEmptySV
                atomically $ do
                        l <- takeTMVar b
                        putTMVar b $ l ++ [s]

diff --git a/debian/changelog b/debian/changelog
index a37eec4212317d03be7337ad922f9f7700368278..38c329dcd659bee25e00b3bc67e3337cdfd1d822 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -2,6 +2,8 @@ git-annex (4.20130324) UNRELEASED; urgency=low
 
   * Group subcommands into sections in usage. Closes: #703797
   * Per-command usage messages.
+  * webapp: Fix a race that sometimes caused alerts or other notifications
+    to be missed if they occurred while a page was loading.
 
  -- Joey Hess <joeyh@debian.org>  Mon, 25 Mar 2013 10:21:46 -0400