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 TemplateHaskell #-}
module UTmp (users, utmp_file) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C
import Data.BitSyntax
import Data.Functor.Identity
import Data.Maybe
import System.Posix.Signals
import System.Posix.Types
import Control.Monad
import Unsafe.Coerce
import Data.Word
import Data.Int
import Control.Monad.Error.Class
import System.IO.Error
utmp_file = "/var/run/utmp"
utmp_bs = S.readFile utmp_file
decode_utmp_bytestring =
runIdentity
. $(bitSyn [ UnsignedLE 4 -- type
, UnsignedLE 4 -- pid
, Fixed 32 -- tty
, Fixed 4 -- inittab id
, Fixed 32 -- username
, Fixed 256 -- remote host
, UnsignedLE 4 -- termination status
, UnsignedLE 4 -- exit status
, Fixed 4 -- session id
, Fixed 8 -- time entry was made
, Fixed 16 -- remote addr v6
, Skip 20 -- reserved
])
utmp_size = 384 -- 768
utmp_records bs | S.length bs >= utmp_size
= u:utmp_records us
where
(u,us) = S.splitAt utmp_size bs
utmp_records bs = [bs]
utmp = fmap (map decode_utmp_bytestring . utmp_records) utmp_bs
interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv6) =
(toStr user, toStr tty, processId pid, (toEnum . fromIntegral) typ :: UT_Type)
where
toStr = takeWhile (/='\0') . C.unpack
processId = CPid . coerce
coerce :: Word32 -> Int32
coerce = unsafeCoerce
data UT_Type
= EMPTY -- No valid user accounting information. */
| RUN_LVL -- The system's runlevel. */
| BOOT_TIME -- Time of system boot. */
| NEW_TIME -- Time after system clock changed. */
| OLD_TIME -- Time when system clock changed. */
| INIT_PROCESS -- Process spawned by the init process. */
| LOGIN_PROCESS -- Session leader of a logged in user. */
| USER_PROCESS -- Normal process. */
| DEAD_PROCESS -- Terminated process. */
| ACCOUNTING
deriving (Enum,Show,Eq,Read)
processAlive pid = do
catchError (do { signalProcess nullSignal pid ; return True })
$ \e -> do { return (not ( isDoesNotExistError e)); }
users = do
us <- utmp
let us' = map interp_utmp_record us
us'' = mapMaybe user_proc us'
user_proc (u,tty,pid,USER_PROCESS) = Just (u,tty,pid)
user_proc _ = Nothing
onThrd f (_,_,pid) = f pid
us3 <- filterM (onThrd processAlive) us''
return us3
|
