aboutsummaryrefslogtreecommitdiff
path: root/Utility/DBus.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-26 19:38:27 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-26 19:38:27 -0400
commit26fb68355b4ad95f99b2d14110e683109d0bab3d (patch)
tree7c022bafa308328672341824ef5ac38974a80202 /Utility/DBus.hs
parent3c0cc8b6c68b4b09668142b202a068b0ae23998c (diff)
NetWatcher: When dbus connection is lost, try to reconnect.
MountWatcher can't do this, because it uses the session dbus, and won't have access to the new DBUS_SESSION_BUS_ADDRESS if a new session is started. Bumped dbus library version, FD leak in it is fixed.
Diffstat (limited to 'Utility/DBus.hs')
-rw-r--r--Utility/DBus.hs16
1 files changed, 8 insertions, 8 deletions
diff --git a/Utility/DBus.hs b/Utility/DBus.hs
index 3b34e00ac..a1a4c4804 100644
--- a/Utility/DBus.hs
+++ b/Utility/DBus.hs
@@ -5,7 +5,7 @@
- Licensed under the GNU GPL version 3 or higher.
-}
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}
module Utility.DBus where
@@ -65,15 +65,15 @@ runClient getaddr clientaction = do
- If the connection is lost, runs onretry, which can do something like
- a delay, or printing a warning, and has a state value (useful for
- exponential backoff). Once onretry returns, the connection is retried.
- -
- - Warning: Currently connectWith can throw a SocketError and leave behind
- - an open FD. So each retry leaks one FD. -}
+ -}
persistentClient :: IO (Maybe Address) -> v -> (SomeException -> v -> IO v) -> (Client -> IO ()) -> IO ()
-persistentClient getaddr v onretry clientaction = do
+persistentClient getaddr v onretry clientaction =
{- runClient can fail with not just ClientError, but also other
- - things, if dbus is not running. -}
- r <- E.try (runClient getaddr clientaction) :: IO (Either SomeException ())
- either retry return r
+ - things, if dbus is not running. Let async exceptions through. -}
+ runClient getaddr clientaction `E.catches`
+ [ Handler (\ (e :: AsyncException) -> E.throw e)
+ , Handler (\ (e :: SomeException) -> retry e)
+ ]
where
retry e = do
v' <- onretry e v