diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,19 @@ ## Unreleased +## 0.3.2.15 - 2026-07-02 +- Bound every DBus call made during host and watcher startup with a timeout so + a single unresponsive item (a process that owns its `StatusNotifierItem` bus + name but never services its connection) can no longer hang startup + indefinitely. Previously such an item would block `Host.build` (and any tray + UI built from it) and the watcher's cache-validation pass forever, since the + `dbus` library does not time out method calls on its own. +- Watcher: bound the per-item introspection performed while validating cached + items during startup; unresponsive items are dropped instead of blocking the + watcher before it exports its object. +- Host: bound the per-item property fetch in `buildItemInfo` and the + `RegisterStatusNotifierHost`/`RegisteredStatusNotifierItems` watcher calls. + ## 0.3.2.14 - 2026-05-13 - Clean up generated DBus client, service, and watcher code for newer compiler warning compatibility. diff --git a/src/StatusNotifier/Host/Service.hs b/src/StatusNotifier/Host/Service.hs --- a/src/StatusNotifier/Host/Service.hs +++ b/src/StatusNotifier/Host/Service.hs @@ -182,6 +182,17 @@ } deriving (Typeable) +-- | How long to wait for a single item's properties when building its +-- 'ItemInfo' before treating the item as unresponsive. +itemBuildTimeout :: Int +itemBuildTimeout = 5 * 1000000 + +-- | How long to wait for the watcher to answer before giving up on a call. A +-- watcher stuck in its own startup can own the bus name without servicing +-- requests. +watcherCallTimeout :: Int +watcherCallTimeout = 5 * 1000000 + build :: Params -> IO (Maybe Host) build Params @@ -253,7 +264,13 @@ let (bus, maybePath) = splitServiceName name in (busName_ bus, objectPath_ <$> maybePath) - buildItemInfo name = runExceptT $ do + -- Bound the full item property fetch: a wedged item process that owns + -- its bus name but never services its connection would otherwise + -- block the host (and with it the entire tray build) forever. + buildItemInfo name = + callWithTimeout itemBuildTimeout $ buildItemInfoUnbounded name + + buildItemInfoUnbounded name = runExceptT $ do let (itemBusName, maybePath) = parseServiceName name itemPath <- case maybePath of Just parsedPath -> return parsedPath @@ -431,7 +448,9 @@ maxRetries :: Int maxRetries = 20 fetchWatcherItems retries = do - watcherItemsResult <- W.getRegisteredStatusNotifierItems client + watcherItemsResult <- + callWithTimeout watcherCallTimeout $ + W.getRegisteredStatusNotifierItems client case watcherItemsResult of Right watcherItems -> return $ Right watcherItems Left err -> @@ -643,9 +662,9 @@ itemInfos <- createAll serviceNames let newMap = Map.fromList $ map (itemServiceName &&& id) itemInfos resultMap = Map.union itemInfoMap newMap - W.registerStatusNotifierHost client busName + callWithTimeout watcherCallTimeout (W.registerStatusNotifierHost client busName) >>= either logErrorAndShutdown (const $ return (resultMap, True)) - W.getRegisteredStatusNotifierItems client + callWithTimeout watcherCallTimeout (W.getRegisteredStatusNotifierItems client) >>= either logErrorAndShutdown finishInitialization startWatcherIfNeeded = do diff --git a/src/StatusNotifier/Util.hs b/src/StatusNotifier/Util.hs --- a/src/StatusNotifier/Util.hs +++ b/src/StatusNotifier/Util.hs @@ -4,6 +4,7 @@ import Control.Arrow import Control.Lens +import DBus (methodError) import DBus.Client import qualified DBus.Generation as G import qualified DBus.Internal.Message as M @@ -21,6 +22,21 @@ import StatusNotifier.TH import System.ByteOrder (fromBigEndian) import System.Log.Logger +import System.Timeout (timeout) + +-- | Run a DBus call with an upper bound on how long it may block. An +-- unresponsive peer (a process that owns a bus name but never services its +-- connection) otherwise blocks callers indefinitely, since the dbus library +-- does not time out calls on its own. On timeout, the call resolves to a +-- 'M.MethodError' so existing error handling drops the peer gracefully. +callWithTimeout :: + Int -> + IO (Either M.MethodError a) -> + IO (Either M.MethodError a) +callWithTimeout micros action = + fromMaybe (Left timeoutError) <$> timeout micros action + where + timeoutError = methodError (T.Serial 0) errorFailed splitServiceName :: String -> (String, Maybe String) splitServiceName name = diff --git a/src/StatusNotifier/Watcher/Service.hs b/src/StatusNotifier/Watcher/Service.hs --- a/src/StatusNotifier/Watcher/Service.hs +++ b/src/StatusNotifier/Watcher/Service.hs @@ -29,6 +29,11 @@ import System.Log.Logger import Text.Printf +-- | How long to wait for a cached item to answer introspection during +-- startup validation before dropping it. +persistedItemValidationTimeout :: Int +persistedItemValidationTimeout = 2 * 1000000 + buildWatcher :: WatcherParams -> IO (Interface, IO RequestNameReply) buildWatcher WatcherParams @@ -160,8 +165,13 @@ (renderServiceName item) return Nothing Just validOwner -> do + -- Bound the introspection call: a wedged item process that + -- owns its bus name but never services its connection would + -- otherwise block watcher startup forever, before the + -- watcher object is even exported. objectResult <- - getInterfaceAt client (serviceName item) (servicePath item) + callWithTimeout persistedItemValidationTimeout $ + getInterfaceAt client (serviceName item) (servicePath item) case objectResult of Right (Just objectInfo) | hasStatusNotifierItemInterface objectInfo -> diff --git a/status-notifier-item.cabal b/status-notifier-item.cabal --- a/status-notifier-item.cabal +++ b/status-notifier-item.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: status-notifier-item -version: 0.3.2.14 +version: 0.3.2.15 synopsis: A wrapper over the StatusNotifierItem/libappindicator dbus specification description: Please see the README on Github at category: Desktop