1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Program.Mighty.Process (
getMightyPid,
) where
import Control.Monad.Trans.Resource (runResourceT)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Conduit
import qualified Data.Conduit.Binary as CB
import qualified Data.Conduit.List as CL
import Data.Conduit.Process
import Data.Function
import Data.List
import System.Posix.Types
----------------------------------------------------------------
data PsResult = PsResult
{ uid :: ByteString
, pid :: ProcessID
, ppid :: ProcessID
, command :: ByteString
}
deriving (Eq, Show)
toPsResult :: [ByteString] -> PsResult
toPsResult (a : b : c : _ : _ : _ : _ : h : _) =
PsResult
{ uid = a
, pid = maybe 0 (fromIntegral . fst) $ BS.readInt b
, ppid = maybe 0 (fromIntegral . fst) $ BS.readInt c
, command = h
}
toPsResult _ = PsResult "unknown" 0 0 "unknown"
----------------------------------------------------------------
runPS :: IO [PsResult]
runPS = snd <$> runResourceT (sourceCmdWithConsumer "ps -ef" consumer)
where
consumer =
CB.lines
.| CL.map BS.words
.| CL.map toPsResult
.| CL.filter mighty
.| CL.consume
commandName = last . split '/' . command
mighty ps =
"mighty" `BS.isInfixOf` name
&& not ("mightyctl" `BS.isInfixOf` name)
where
name = commandName ps
----------------------------------------------------------------
findParent :: [PsResult] -> [PsResult]
findParent ps = deleteAloneChild $ masters ++ candidates
where
iAmMaster p = ppid p == 1
masters = filter iAmMaster ps
rest = filter (not . iAmMaster) ps
candidates =
map head $
filter (\xs -> length xs == 1) $ -- master is alone
groupBy ((==) `on` ppid) $
sortOn ppid rest
deleteAloneChild :: [PsResult] -> [PsResult]
deleteAloneChild [] = []
deleteAloneChild (p : ps) = p : deleteAloneChild (filter noParent ps)
where
parent = pid p
noParent x = ppid x /= parent
----------------------------------------------------------------
-- | Getting the process id of a running Mighty.
getMightyPid :: IO [ProcessID]
getMightyPid = map pid . findParent <$> runPS
----------------------------------------------------------------
split :: Char -> ByteString -> [ByteString]
split _ "" = []
split c s = case BS.break (c ==) s of
("", r) -> split c (BS.tail r)
(s', "") -> [s']
(s', r) -> s' : split c (BS.tail r)
|
