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
This commit is contained in:
Tomas Janousek
2022-07-04 01:05:45 +01:00
parent 5557944fb6
commit fc482b8771
6 changed files with 92 additions and 53 deletions

View File

@@ -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