mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-07-31 20:21:51 -07:00
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:
@@ -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
|
||||
|
Reference in New Issue
Block a user