From 1d0b692198085aa380809105aed37ad3987e8f9f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 27 Mar 2013 14:56:15 -0400 Subject: [PATCH] webapp: Fix a race that sometimes caused alerts or other notifications to be missed if they occurred while a page was loading. 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.) --- Assistant/Threads/DaemonStatus.hs | 2 +- Assistant/Threads/TransferPoller.hs | 2 +- Assistant/WebApp.hs | 2 +- Utility/NotificationBroadcaster.hs | 17 +++++++++++++---- debian/changelog | 2 ++ 5 files changed, 18 insertions(+), 7 deletions(-) diff --git a/Assistant/Threads/DaemonStatus.hs b/Assistant/Threads/DaemonStatus.hs index fffc6ed37f..5bbb15acbe 100644 --- 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 20b832652d..68075cac8a 100644 --- 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 17aa0ac82c..0812acb4d1 100644 --- 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 413ec2d755..b873df655f 100644 --- 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 a37eec4212..38c329dcd6 100644 --- 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 Mon, 25 Mar 2013 10:21:46 -0400