diff options
author | Joey Hess <joey@kitenet.net> | 2012-10-26 19:38:27 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-10-26 19:38:27 -0400 |
commit | 26fb68355b4ad95f99b2d14110e683109d0bab3d (patch) | |
tree | 7c022bafa308328672341824ef5ac38974a80202 /Utility/DBus.hs | |
parent | 3c0cc8b6c68b4b09668142b202a068b0ae23998c (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.hs | 16 |
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 |