diff --git a/CHANGES.md b/CHANGES.md index 817866930c..027deec236 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -110,6 +110,14 @@ - Fixed windows getting lost when used in conjunction with `smartBorders` and a single window. + - No longer needs `pstree` to detect child/parent relationships. + + - Fixed some false positives in child/parent relationship detection. + + * `XMonad.Actions.SpawnOn` + + - Fixed parsing of `/proc/*/stat` to correctly handle complex process names. + * `XMonad.Util.EZConfig` - Added support for Modifier Keys `KeySym`s for Emacs-like `additionalKeysP`. diff --git a/XMonad/Actions/SpawnOn.hs b/XMonad/Actions/SpawnOn.hs index 083fa5f2c2..85d8e202c6 100644 --- a/XMonad/Actions/SpawnOn.hs +++ b/XMonad/Actions/SpawnOn.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE LambdaCase #-} + ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SpawnOn @@ -28,11 +30,7 @@ module XMonad.Actions.SpawnOn ( shellPromptOn ) where -import Control.Exception (tryJust) -import System.IO.Error (isDoesNotExistError) -import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID) -import Text.Printf (printf) import XMonad import XMonad.Prelude @@ -42,6 +40,7 @@ import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.Process (getPPIDChain) -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -72,29 +71,13 @@ instance ExtensionClass Spawner where initialValue = Spawner [] -getPPIDOf :: ProcessID -> Maybe ProcessID -getPPIDOf thisPid = - case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger thisPid of - Left _ -> Nothing - Right contents -> case lines contents of - [] -> Nothing - first : _ -> case words first of - _ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int) - _ -> Nothing - -getPPIDChain :: ProcessID -> [ProcessID] -getPPIDChain thisPid = ppid_chain thisPid [] - where ppid_chain pid' acc = - if pid' == 0 - then acc - else case getPPIDOf pid' of - Nothing -> acc - Just ppid -> ppid_chain ppid (ppid : acc) - -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner f = XS.modify (Spawner . f . pidsRef) +modifySpawnerM :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> X () +modifySpawnerM f = XS.modifyM (fmap Spawner . f . pidsRef) + -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. manageSpawn :: ManageHook @@ -103,22 +86,16 @@ manageSpawn = manageSpawnWithGC (return . take 20) manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@ -> ManageHook -manageSpawnWithGC garbageCollect = do - Spawner pids <- liftX XS.get - mp <- pid - let ppid_chain = case mp of - Just winpid -> winpid : getPPIDChain winpid - Nothing -> [] - known_window_handlers = [ mpid - | ppid <- ppid_chain - , Just mpid <- [lookup ppid pids] ] - case known_window_handlers of - [] -> idHook - (mh:_) -> do - whenJust mp $ \p -> liftX $ do - ps <- XS.gets pidsRef - XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps) - mh +manageSpawnWithGC garbageCollect = pid >>= \case + Nothing -> mempty + Just p -> do + Spawner pids <- liftX XS.get + ppid_chain <- io $ getPPIDChain p + case mapMaybe (`lookup` pids) ppid_chain of + [] -> mempty + mh : _ -> liftX (gc p) >> mh + where + gc p = modifySpawnerM $ garbageCollect . filter ((/= p) . fst) mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt cb c = do diff --git a/XMonad/Hooks/WindowSwallowing.hs b/XMonad/Hooks/WindowSwallowing.hs index 2126451f66..323dba0b79 100644 --- a/XMonad/Hooks/WindowSwallowing.hs +++ b/XMonad/Hooks/WindowSwallowing.hs @@ -19,9 +19,6 @@ -- window, and allows you "swallow" that parent window for the time the new -- window is running. -- --- __NOTE__: This module depends on @pstree@ to analyze the process hierarchy, so make --- sure that is on your @$PATH@. --- -- __NOTE__ that this does not always work perfectly: -- -- - Because window swallowing needs to check the process hierarchy, it requires @@ -36,7 +33,9 @@ -- by looking at the window. This requires the @_NET_WM_PID@ X-property to be set. -- If any application you want to use this with does not provide the @_NET_WM_PID@, -- there is not much you can do except for reaching out to the author of that --- application and asking them to set that property. +-- application and asking them to set that property. Additionally, +-- applications running in their own PID namespace, such as those in +-- Flatpak, can't set a correct @_NET_WM_PID@ even if they wanted to. ----------------------------------------------------------------------------- module XMonad.Hooks.WindowSwallowing ( -- * Usage @@ -50,8 +49,9 @@ import qualified XMonad.StackSet as W import XMonad.Layout.SubLayouts import qualified XMonad.Util.ExtensibleState as XS import XMonad.Util.WindowProperties -import XMonad.Util.Run ( runProcessWithInput ) +import XMonad.Util.Process ( getPPIDChain ) import qualified Data.Map.Strict as M +import System.Posix.Types ( ProcessID ) -- $usage -- You can use this module by including the following in your @~\/.xmonad/xmonad.hs@: @@ -226,12 +226,10 @@ moveFloatingState from to ws = ws -- | check if a given process is a child of another process. This depends on "pstree" being in the PATH -- NOTE: this does not work if the child process does any kind of process-sharing. isChildOf - :: Int -- ^ child PID - -> Int -- ^ parent PID + :: ProcessID -- ^ child PID + -> ProcessID -- ^ parent PID -> IO Bool -isChildOf child parent = do - output <- runProcessWithInput "pstree" ["-T", "-p", show parent] "" - return $ any (show child `isInfixOf`) $ lines output +isChildOf child parent = (parent `elem`) <$> getPPIDChain child data SwallowingState = SwallowingState diff --git a/XMonad/Util/ExtensibleState.hs b/XMonad/Util/ExtensibleState.hs index ba9c33fb9f..2babc7f746 100644 --- a/XMonad/Util/ExtensibleState.hs +++ b/XMonad/Util/ExtensibleState.hs @@ -21,6 +21,8 @@ module XMonad.Util.ExtensibleState ( put , modify , modify' + , modifyM + , modifyM' , remove , get , gets @@ -89,12 +91,20 @@ modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleSt -- | Apply a function to a stored value of the matching type or the initial value if there -- is none. modify :: (ExtensionClass a, XLike m) => (a -> a) -> m () -modify f = put . f =<< get +modify = modifyM . (pure .) --- | Like @modify@ but the result value is applied strictly in respect to --- the monadic environment. +-- | Apply an action to a stored value of the matching type or the initial value if there +-- is none. +modifyM :: (ExtensionClass a, XLike m) => (a -> m a) -> m () +modifyM f = put =<< f =<< get + +-- | Like 'modify' but the result value is forced to WHNF before being stored. modify' :: (ExtensionClass a, XLike m) => (a -> a) -> m () -modify' f = (put $!) . f =<< get +modify' = modifyM' . (pure .) + +-- | Like 'modifyM' but the result value is forced to WHNF before being stored. +modifyM' :: (ExtensionClass a, XLike m) => (a -> m a) -> m () +modifyM' f = (put $!) =<< f =<< get -- | Add a value to the extensible state field. A previously stored value with the same -- type will be overwritten. (More precisely: A value whose string representation of its type diff --git a/XMonad/Util/Process.hs b/XMonad/Util/Process.hs new file mode 100644 index 0000000000..18c4eb71a4 --- /dev/null +++ b/XMonad/Util/Process.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} + +-- | +-- Module : XMonad.Util.Process +-- Description : Utilities for unix processes. +-- Copyright : (c) 2022 Tomáš Janoušek +-- License : BSD3 +-- Maintainer : Tomáš Janoušek +-- +-- This module should not be directly used by users, it's just common code for +-- other modules. +-- +module XMonad.Util.Process ( + getPPIDOf, + getPPIDChain, + ) where + +import Control.Exception (SomeException, handle) +import System.Posix.Types (ProcessID) +import qualified Data.ByteString.Char8 as B + +import XMonad.Prelude (fi) + +-- | Get the parent process id (PPID) of a given process. +getPPIDOf :: ProcessID -> IO (Maybe ProcessID) +getPPIDOf pid = + handle + (\(_ :: SomeException) -> pure Nothing) + (parse <$> B.readFile ("/proc/" <> show pid <> "/stat")) + where + -- Parse PPID out of /proc/*/stat, being careful not to trip over + -- processes with names like ":-) 1 2 3 4 5 6". + -- Inspired by https://gitlab.com/procps-ng/procps/-/blob/bcce3e440a1e1ee130c7371251a39c031519336a/proc/readproc.c#L561 + parse stat = case B.words $ snd $ B.spanEnd (/= ')') stat of + _ : (B.readInt -> Just (ppid, "")) : _ -> Just (fi ppid) + _ -> Nothing + +-- | Get the chain of parent processes of a given pid. Starts with the given +-- pid and continues up until the parent of all. +getPPIDChain :: ProcessID -> IO [ProcessID] +getPPIDChain pid = (pid :) <$> (maybe (pure []) getPPIDChain =<< getPPIDOf pid) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index adb6c2c597..e402b2cf76 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -368,6 +368,7 @@ library XMonad.Util.Parser XMonad.Util.Paste XMonad.Util.PositionStore + XMonad.Util.Process XMonad.Util.PureX XMonad.Util.Rectangle XMonad.Util.RemoteWindows @@ -439,6 +440,7 @@ test-suite tests XMonad.Util.NamedActions XMonad.Util.NamedWindows XMonad.Util.Parser + XMonad.Util.Process XMonad.Util.PureX XMonad.Util.Rectangle XMonad.Util.Run @@ -454,6 +456,7 @@ test-suite tests build-depends: base , QuickCheck >= 2 , X11 >= 1.10 && < 1.11 + , bytestring >= 0.10 && < 0.12 , containers , directory , time >= 1.8 && < 1.13