From fc482b877183efad30b061b885e68ca4a983fd11 Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Mon, 4 Jul 2022 01:05:45 +0100 Subject: [PATCH] X.A.SpawnOn, X.H.WindowSwallowing: Fix parsing of process PPIDs This fixes several issues related to parsing of parent PIDs: * A process with lines or spaces or parentheses in its process name would confuse the code in X.A.SpawnOn and possibly lead to a `Prelude.read: no parse` exception. * `X.H.WindowSwallowing.isChildOf` looked for the parent PID anywhere in the output of pstree, so single-digit parent PIDs would be considered as parents of any process with that digit anywhere in its chain of parent PIDs. (Note that apps in PID namespaces like in Flatpak often have single-digit PIDs.) * `pstree` is no longer required in `$PATH`. Fixes: https://github.com/xmonad/xmonad-contrib/issues/726 --- CHANGES.md | 8 +++++ XMonad/Actions/SpawnOn.hs | 55 ++++++++++---------------------- XMonad/Hooks/WindowSwallowing.hs | 18 +++++------ XMonad/Util/ExtensibleState.hs | 18 ++++++++--- XMonad/Util/Process.hs | 43 +++++++++++++++++++++++++ xmonad-contrib.cabal | 3 ++ 6 files changed, 92 insertions(+), 53 deletions(-) create mode 100644 XMonad/Util/Process.hs diff --git a/CHANGES.md b/CHANGES.md index 81786693..027deec2 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 083fa5f2..85d8e202 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 2126451f..323dba0b 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 ba9c33fb..2babc7f7 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 00000000..18c4eb71 --- /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 adb6c2c5..e402b2cf 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