diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Changelog for status-notifier-item +## 0.3.2.2 - 2026-02-11 +- Fix watcher registration ownership checks by requiring explicit service-name + registrations to be initiated by the current owner. +- Fix watcher duplicate handling by coalescing path-first and name-first + registrations from the same sender/path pair. +- Add an isolated DBus integration test suite covering watcher/host behavior + and regression tests for registration ownership and deduplication. + ## 0.3.2.1 - 2026-02-09 - Add name-owner resolution fallback for signal sender identification, fixing noisy errors when items register under well-known bus names. 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 @@ -63,27 +63,50 @@ registerStatusNotifierItem MethodCall { methodCallSender = sender } name = runExceptT $ do - let maybeBusName = getFirst $ mconcat $ - map First [T.parseBusName name, sender] + let parsedBusName = T.parseBusName name parseServiceError = makeErrorReply errorInvalidParameters $ printf "the provided service %s could not be parsed \ \as a bus name or an object path." name + senderMissingError = makeErrorReply errorInvalidParameters $ + "Unable to identify sender for registration." path = fromMaybe Item.defaultPath $ T.parseObjectPath name remapErrorName = left $ (`makeErrorReply` "Failed to verify ownership.") . M.methodErrorName - busName <- ExceptT $ return $ maybeToEither parseServiceError maybeBusName + resolveOwner bus + | ":" `isPrefixOf` (coerce bus :: String) = return (Just bus) + | otherwise = do + result <- DBusTH.getNameOwner client (coerce bus) + return $ busName_ <$> either (const Nothing) Just result + when (isNothing parsedBusName && isNothing (T.parseObjectPath name)) $ + throwE parseServiceError + senderName <- ExceptT $ return $ maybeToEither senderMissingError sender + busName <- + case parsedBusName of + Just providedBusName -> do + owner <- ExceptT $ remapErrorName <$> + DBusTH.getNameOwner client (coerce providedBusName) + unless (owner == coerce senderName) $ + throwE $ makeErrorReply errorInvalidParameters $ + printf "Sender %s does not own service %s." + (coerce senderName :: String) + name + return providedBusName + Nothing -> return senderName let item = ItemEntry { serviceName = busName , servicePath = path } - hasOwner <- ExceptT $ remapErrorName <$> - DBusTH.nameHasOwner client (coerce busName) lift $ modifyMVar_ notifierItems $ \currentItems -> - if itemIsRegistered item currentItems - then - return currentItems - else - do + do + ownerPathMatches <- filterM (\existingItem -> + if servicePath existingItem == path + then do + existingOwner <- resolveOwner (serviceName existingItem) + return $ existingOwner == Just senderName + else return False) currentItems + if itemIsRegistered item currentItems || not (null ownerPathMatches) + then return currentItems + else do emitStatusNotifierItemRegistered client $ renderServiceName item return $ item : currentItems 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.1 +version: 0.3.2.2 synopsis: A wrapper over the StatusNotifierItem/libappindicator dbus specification description: Please see the README on Github at category: Desktop @@ -95,4 +95,27 @@ , hslogger , optparse-applicative , status-notifier-item + default-language: Haskell2010 + +test-suite status-notifier-item-test + type: exitcode-stdio-1.0 + main-is: Main.hs + other-modules: + HostSpec + TestSupport + UtilSpec + WatcherSpec + Paths_status_notifier_item + hs-source-dirs: + test + build-depends: + base >=4.7 && <5 + , containers + , dbus >=1.2.1 && <2.0.0 + , directory + , hslogger + , hspec + , process + , status-notifier-item + , unix default-language: Haskell2010 diff --git a/test/HostSpec.hs b/test/HostSpec.hs new file mode 100644 --- /dev/null +++ b/test/HostSpec.hs @@ -0,0 +1,136 @@ +{-# LANGUAGE OverloadedStrings #-} + +module HostSpec (spec) where + +import Control.Concurrent (newChan, readChan, writeChan) +import Control.Exception (finally) +import Control.Monad (replicateM) +import Data.List (sort) +import qualified Data.Map.Strict as Map +import DBus (busName_) +import DBus.Client +import StatusNotifier.Host.Service hiding (startWatcher) +import System.Timeout (timeout) +import Test.Hspec + +import TestSupport + +spec :: Spec +spec = around withIsolatedSessionBus $ do + describe "StatusNotifier.Host.Service integration" $ do + it "receives ItemAdded then ItemRemoved for a registered item" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-a"} + events <- newChan + _ <- addUpdateHandler host (\ut info -> writeChan events (ut, itemServiceName info)) + + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.HostItemA" defaultPath "folder" + + added <- timeout 1500000 (readChan events) + added `shouldBe` Just (ItemAdded, busName_ "org.test.HostItemA") + + cleanup + + removed <- timeout 1500000 (readChan events) + removed `shouldBe` Just (ItemRemoved, busName_ "org.test.HostItemA") + + it "replays existing items to newly-added handlers" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.HostItemB" defaultPath "browser" + + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-b"} + events <- newChan + _ <- addUpdateHandler host (\ut info -> writeChan events (ut, itemServiceName info)) + + replayed <- timeout 1500000 (readChan events) + replayed `shouldBe` Just (ItemAdded, busName_ "org.test.HostItemB") + + cleanup + + it "stops dispatching updates after removeUpdateHandler" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-c"} + events <- newChan + token <- addUpdateHandler host (\ut info -> writeChan events (ut, itemServiceName info)) + removeUpdateHandler host token + + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.HostItemC" defaultPath "help-about" + cleanup + + noEvent <- timeout 500000 (readChan events) + noEvent `shouldBe` Nothing + + it "keeps itemInfoMap in sync across add/remove transitions" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-d"} + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.HostItemD" defaultPath "mail-send" + + addedMapReady <- + waitFor 1500000 $ do + current <- itemInfoMap host + pure $ busName_ "org.test.HostItemD" `elem` Map.keys current + addedMapReady `shouldBe` True + + cleanup + + removedMapReady <- + waitFor 1500000 $ do + current <- itemInfoMap host + pure $ busName_ "org.test.HostItemD" `notElem` Map.keys current + removedMapReady `shouldBe` True + + it "loads item icon names into itemInfoMap" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-e"} + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.HostItemE" defaultPath "drive-harddisk" + (do + populated <- + waitFor 1500000 $ do + current <- itemInfoMap host + pure $ case Map.lookup (busName_ "org.test.HostItemE") current of + Just info -> iconName info == "drive-harddisk" + Nothing -> False + populated `shouldBe` True + ) `finally` cleanup + + it "replays all pre-existing items to newly-added handlers" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + itemClientA <- connectSession + itemClientB <- connectSession + cleanupA <- registerSimpleItem itemClientA "org.test.HostItemF" defaultPath "audio-volume-high" + cleanupB <- registerSimpleItem itemClientB "org.test.HostItemG" defaultPath "audio-volume-low" + (do + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-f"} + events <- newChan + _ <- addUpdateHandler host (\ut info -> writeChan events (ut, itemServiceName info)) + replayed <- replicateM 2 (timeout 1500000 (readChan events)) + let addedNames = sort [name | Just (ItemAdded, name) <- replayed] + addedNames + `shouldBe` sort [busName_ "org.test.HostItemF", busName_ "org.test.HostItemG"] + ) `finally` (cleanupA >> cleanupB) + + it "does not emit updates for forceUpdate on unknown services" $ \() -> do + _watcher <- startWatcher + hostClient <- connectSession + Just host <- build defaultParams {dbusClient = Just hostClient, uniqueIdentifier = "host-g"} + events <- newChan + _ <- addUpdateHandler host (\ut info -> writeChan events (ut, itemServiceName info)) + forceUpdate host (busName_ "org.test.DoesNotExist") + noEvent <- timeout 500000 (readChan events) + noEvent `shouldBe` Nothing + current <- itemInfoMap host + Map.null current `shouldBe` True + +defaultPath :: String +defaultPath = "/StatusNotifierItem" diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,13 @@ +module Main (main) where + +import Test.Hspec + +import qualified HostSpec +import qualified UtilSpec +import qualified WatcherSpec + +main :: IO () +main = hspec $ do + UtilSpec.spec + WatcherSpec.spec + HostSpec.spec diff --git a/test/TestSupport.hs b/test/TestSupport.hs new file mode 100644 --- /dev/null +++ b/test/TestSupport.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module TestSupport + ( withIsolatedSessionBus + , startWatcher + , registerSimpleItem + , waitFor + ) where + +import Control.Concurrent (threadDelay) +import Control.Exception (SomeException, bracket, try) +import DBus (busName_, objectPath_) +import DBus.Client + ( Client + , Interface (..) + , RequestNameReply (NamePrimaryOwner) + , connectSession + , export + , readOnlyProperty + , releaseName + , requestName + ) +import StatusNotifier.Watcher.Constants + ( defaultWatcherParams + , watcherDBusClient + , watcherStop + ) +import qualified StatusNotifier.Watcher.Client as WatcherClient +import qualified StatusNotifier.Watcher.Service as WatcherService +import System.Environment (lookupEnv, setEnv, unsetEnv) +import System.Exit (ExitCode, ExitCode (ExitSuccess)) +import System.Process (readProcessWithExitCode) +import Test.Hspec + +data BusEnv = BusEnv + { previousAddress :: Maybe String + , previousPid :: Maybe String + , daemonPid :: String + } + +withIsolatedSessionBus :: ActionWith () -> IO () +withIsolatedSessionBus action = + bracket setup teardown (const $ action ()) + +setup :: IO BusEnv +setup = do + oldAddress <- lookupEnv "DBUS_SESSION_BUS_ADDRESS" + oldPid <- lookupEnv "DBUS_SESSION_BUS_PID" + (code, out, err) <- + readProcessWithExitCode + "dbus-daemon" + ["--session", "--fork", "--print-address=1", "--print-pid=1"] + "" + case (code, lines out) of + (ExitSuccess, address : pidLine : _) -> do + setEnv "DBUS_SESSION_BUS_ADDRESS" address + setEnv "DBUS_SESSION_BUS_PID" pidLine + pure BusEnv + { previousAddress = oldAddress + , previousPid = oldPid + , daemonPid = pidLine + } + _ -> + error $ + "Failed to start test dbus-daemon: exit=" + <> show code + <> " stdout=" + <> show out + <> " stderr=" + <> show err + +teardown :: BusEnv -> IO () +teardown BusEnv {..} = do + -- Terminate bus daemon. If it is already gone, ignore the error. + _ <- + ( try $ + readProcessWithExitCode + "kill" + ["-TERM", daemonPid] + "" + ) :: + IO (Either SomeException (ExitCode, String, String)) + restore "DBUS_SESSION_BUS_ADDRESS" previousAddress + restore "DBUS_SESSION_BUS_PID" previousPid + where + restore key value = maybe (unsetEnv key) (setEnv key) value + +startWatcher :: IO Client +startWatcher = do + client <- connectSession + (_, startFn) <- + WatcherService.buildWatcher + defaultWatcherParams + { watcherDBusClient = Just client + , watcherStop = pure () + } + reply <- startFn + reply `shouldBe` NamePrimaryOwner + pure client + +registerSimpleItem :: + Client -> + String -> + String -> + String -> + IO (IO ()) +registerSimpleItem client busName objectPath iconName = do + let iface = + Interface + { interfaceName = "org.kde.StatusNotifierItem" + , interfaceMethods = [] + , interfaceProperties = + [ readOnlyProperty "IconName" (pure iconName) + , readOnlyProperty "OverlayIconName" (pure ("" :: String)) + , readOnlyProperty "ItemIsMenu" (pure False) + ] + , interfaceSignals = [] + } + path = objectPath_ objectPath + + export client path iface + _ <- requestName client (busName_ busName) [] + registerResult <- WatcherClient.registerStatusNotifierItem client busName + registerResult `shouldBe` Right () + pure $ do + _ <- releaseName client (busName_ busName) + pure () + +waitFor :: Int -> IO Bool -> IO Bool +waitFor timeoutMicros predicate = + go 0 + where + step = 20000 + go elapsed + | elapsed >= timeoutMicros = predicate + | otherwise = do + ok <- predicate + if ok + then pure True + else threadDelay step >> go (elapsed + step) diff --git a/test/UtilSpec.hs b/test/UtilSpec.hs new file mode 100644 --- /dev/null +++ b/test/UtilSpec.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} + +module UtilSpec (spec) where + +import qualified DBus.Internal.Message as M +import DBus.Internal.Types (ErrorName, Serial (..), errorName_) +import StatusNotifier.Util +import Test.Hspec + +spec :: Spec +spec = do + describe "splitServiceName" $ do + it "splits a bus name with no path" $ + splitServiceName "org.example.Service" + `shouldBe` ("org.example.Service", Nothing) + + it "splits a bus name with an object path suffix" $ + splitServiceName "org.example.Service/StatusNotifierItem" + `shouldBe` ("org.example.Service", Just "/StatusNotifierItem") + + it "splits a bus name with a nested object path suffix" $ + splitServiceName "org.example.Service/StatusNotifierItem/Submenu" + `shouldBe` ("org.example.Service", Just "/StatusNotifierItem/Submenu") + + it "keeps path-only values intact when no bus name is present" $ + splitServiceName "/StatusNotifierItem" + `shouldBe` ("/StatusNotifierItem", Nothing) + + it "returns an empty bus component for empty input" $ + splitServiceName "" + `shouldBe` ("", Nothing) + + describe "convertARGBToABGR" $ do + it "swaps red and blue channels while preserving alpha/green" $ + convertARGBToABGR 0x11223344 `shouldBe` 0x11443322 + + it "leaves values unchanged when red and blue channels are equal" $ + convertARGBToABGR 0xAADD33DD `shouldBe` 0xAADD33DD + + describe "maybeToEither" $ do + it "returns Right for Just values" $ + maybeToEither "err" (Just (3 :: Int)) `shouldBe` Right 3 + + it "returns Left default for Nothing" $ + maybeToEither "err" (Nothing :: Maybe Int) `shouldBe` Left ("err" :: String) + + describe "exemptUnknownMethod" $ do + it "converts unknown-method errors to Right default" $ + exemptUnknownMethod "fallback" (Left $ mkMethodError errorUnknownMethod) + `shouldBe` Right ("fallback" :: String) + + it "keeps non-unknown errors intact" $ + exemptUnknownMethod "fallback" (Left $ mkMethodError errorFailed) + `shouldBe` Left (mkMethodError errorFailed) + + it "passes through successful values unchanged" $ + exemptUnknownMethod "fallback" (Right ("ok" :: String)) + `shouldBe` Right "ok" + + describe "exemptAll" $ do + it "maps all errors to Right default" $ + exemptAll "fallback" (Left $ mkMethodError $ errorName_ "org.example.Error") + `shouldBe` Right ("fallback" :: String) + + it "passes through successful values unchanged" $ + exemptAll "fallback" (Right ("ok" :: String)) + `shouldBe` Right "ok" + +mkMethodError :: ErrorName -> M.MethodError +mkMethodError errName = + M.MethodError + { M.methodErrorName = errName + , M.methodErrorSerial = Serial 0 + , M.methodErrorSender = Nothing + , M.methodErrorDestination = Nothing + , M.methodErrorBody = [] + } + +errorUnknownMethod :: ErrorName +errorUnknownMethod = errorName_ "org.freedesktop.DBus.Error.UnknownMethod" + +errorFailed :: ErrorName +errorFailed = errorName_ "org.freedesktop.DBus.Error.Failed" diff --git a/test/WatcherSpec.hs b/test/WatcherSpec.hs new file mode 100644 --- /dev/null +++ b/test/WatcherSpec.hs @@ -0,0 +1,135 @@ +{-# LANGUAGE OverloadedStrings #-} + +module WatcherSpec (spec) where + +import Control.Exception (finally) +import Data.Either (isLeft) +import Data.List (isPrefixOf) +import DBus.Client +import qualified StatusNotifier.Watcher.Client as WatcherClient +import Test.Hspec + +import TestSupport + +spec :: Spec +spec = around withIsolatedSessionBus $ do + describe "StatusNotifier.Watcher.Service integration" $ do + it "starts with no registered items" $ \() -> do + watcher <- startWatcher + entries <- WatcherClient.getRegisteredSNIEntries watcher + entries `shouldBe` Right [] + + it "registers an item and exposes it via RegisteredSNIEntries" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.ItemA" defaultPath "network-wireless" + (do + result <- WatcherClient.getRegisteredSNIEntries watcher + result `shouldSatisfy` \v -> + case v of + Right entries -> any ((== defaultPath) . snd) entries + Left _ -> False + ) `finally` cleanup + + it "is idempotent when the same item registers twice" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + _ <- requestName itemClient "org.test.ItemB" [] + WatcherClient.registerStatusNotifierItem itemClient "org.test.ItemB" + `shouldReturn` Right () + WatcherClient.registerStatusNotifierItem itemClient "org.test.ItemB" + `shouldReturn` Right () + Right entries <- WatcherClient.getRegisteredSNIEntries watcher + let matches = filter (== ("org.test.ItemB", "/StatusNotifierItem")) entries + length matches `shouldBe` 1 + + it "returns the object path for a registered name with no explicit path" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + _ <- requestName itemClient "org.test.ItemC" [] + WatcherClient.registerStatusNotifierItem itemClient "org.test.ItemC" + `shouldReturn` Right () + WatcherClient.getObjectPathForItemName watcher "org.test.ItemC" + `shouldReturn` Right "/StatusNotifierItem" + + it "accepts path-only registration and stores the sender unique name" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + WatcherClient.registerStatusNotifierItem itemClient "/CustomPath" + `shouldReturn` Right () + Right entries <- WatcherClient.getRegisteredSNIEntries watcher + let customEntries = filter ((== "/CustomPath") . snd) entries + length customEntries `shouldBe` 1 + case customEntries of + (serviceName, _) : _ -> serviceName `shouldSatisfy` (":" `isPrefixOf`) + _ -> expectationFailure "Expected exactly one custom entry" + + it "returns direct paths from service/path lookups without registration" $ \() -> do + watcher <- startWatcher + WatcherClient.getObjectPathForItemName watcher "org.test.Missing/CustomPath" + `shouldReturn` Right "/CustomPath" + + it "returns an error for unknown services without explicit paths" $ \() -> do + watcher <- startWatcher + result <- WatcherClient.getObjectPathForItemName watcher "org.test.Missing" + result `shouldSatisfy` isLeft + + it "rejects registration for unowned well-known names" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + result <- WatcherClient.registerStatusNotifierItem itemClient "org.test.Unowned" + result `shouldSatisfy` isLeft + Right entries <- WatcherClient.getRegisteredSNIEntries watcher + entries `shouldNotContain` [("org.test.Unowned", "/StatusNotifierItem")] + + it "deduplicates a client that registers by path and then by service name" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + WatcherClient.registerStatusNotifierItem itemClient "/StatusNotifierItem" + `shouldReturn` Right () + _ <- requestName itemClient "org.test.PathThenName" [] + WatcherClient.registerStatusNotifierItem itemClient "org.test.PathThenName" + `shouldReturn` Right () + Right entries <- WatcherClient.getRegisteredSNIEntries watcher + let matching = filter ((== "/StatusNotifierItem") . snd) entries + length matching `shouldBe` 1 + + it "unregisters items when their bus name disappears" $ \() -> do + watcher <- startWatcher + itemClient <- connectSession + cleanup <- registerSimpleItem itemClient "org.test.ItemD" defaultPath "utilities-terminal" + Right before <- WatcherClient.getRegisteredSNIEntries watcher + before `shouldContain` [("org.test.ItemD", "/StatusNotifierItem")] + cleanup + removed <- + waitFor 1500000 $ do + result <- WatcherClient.getRegisteredSNIEntries watcher + pure $ case result of + Right entries -> ("org.test.ItemD", "/StatusNotifierItem") `notElem` entries + Left _ -> False + removed `shouldBe` True + + it "only unregisters the disconnected item when multiple are present" $ \() -> do + watcher <- startWatcher + itemClientA <- connectSession + itemClientB <- connectSession + cleanupA <- registerSimpleItem itemClientA "org.test.ItemE" defaultPath "media-playback-start" + cleanupB <- registerSimpleItem itemClientB "org.test.ItemF" defaultPath "media-playback-stop" + (do + Right before <- WatcherClient.getRegisteredSNIEntries watcher + before `shouldContain` [("org.test.ItemE", "/StatusNotifierItem")] + before `shouldContain` [("org.test.ItemF", "/StatusNotifierItem")] + cleanupA + stable <- + waitFor 1500000 $ do + result <- WatcherClient.getRegisteredSNIEntries watcher + pure $ case result of + Right entries -> + ("org.test.ItemE", "/StatusNotifierItem") `notElem` entries + && ("org.test.ItemF", "/StatusNotifierItem") `elem` entries + Left _ -> False + stable `shouldBe` True + ) `finally` cleanupB + +defaultPath :: String +defaultPath = "/StatusNotifierItem"