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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
{-# LANGUAGE TemplateHaskell #-}
module UTmp
( users
, users2
, utmp_file
, UserName
, Tty
, ProcessID
, UtmpRecord(..)
, UT_Type(..)
) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.BitSyntax
import Data.Functor.Identity
import Data.Maybe
import System.Posix.Signals
import System.Posix.Types
import Control.Monad
import Data.Word
import Data.Int
import Control.Monad.Error.Class
import System.IO.Error
import qualified Paths
import Data.Text ( Text )
import Unsafe.Coerce ( unsafeCoerce )
import Network.Socket ( SockAddr(..) )
import qualified Data.Text.Encoding as Text
import SockAddr ()
utmp_file = Paths.utmp -- "/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 2 -- termination status
, UnsignedLE 2 -- exit status (int)
, UnsignedLE 4 -- session id (int)
, Fixed 8 -- time entry was made
, Unsigned 4 -- remote addr v6 addr[0]
, Unsigned 4 -- remote addr v6 addr[1]
, Unsigned 4 -- remote addr v6 addr[2]
, Unsigned 4 -- remote addr v6 addr[3]
, 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
toStr = takeWhile (/='\0') . C.unpack
interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time
,addr0,addr1,addr2,addr3) =
( (toEnum . fromIntegral) typ :: UT_Type
, toStr user, toStr tty, processId pid, toStr hostv4 )
where
processId = CPid . coerceToSigned
coerceToSigned :: Word32 -> Int32
coerceToSigned = 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,Ord,Read)
processAlive pid = do
catchError (do { signalProcess nullSignal pid ; return True })
$ \e -> do { return (not ( isDoesNotExistError e)); }
type UserName = L.ByteString
type Tty = L.ByteString
users :: IO [(UserName, Tty, ProcessID)]
users = fmap (map only3) $ do
us <- utmp
let us' = map interp_utmp_record us
us'' = mapMaybe user_proc us'
user_proc (USER_PROCESS, u,tty,pid, hostv4)
= Just (L.pack u,L.pack tty,pid,hostv4)
user_proc _ = Nothing
onThrd f (_,_,pid,_) = f pid
us3 <- filterM (onThrd processAlive) us''
return us3
only3 (a,b,c,_) = (a,b,c)
data UtmpRecord = UtmpRecord
{ utmpType :: UT_Type
, utmpUser :: Text
, utmpTty :: Text
, utmpPid :: CPid
, utmpHost :: Text
, utmpSession :: Int32
, utmpRemoteAddr :: Maybe SockAddr
}
deriving ( Show, Eq, Ord )
toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs
interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4
,term,exit,session,time,addr0,addr1,addr2,addr3) =
UtmpRecord
{ utmpType = toEnum (fromIntegral typ) :: UT_Type
, utmpUser = toText user
, utmpTty = toText tty
, utmpPid = processId pid
, utmpHost = toText hostv4
, utmpSession = coerceToSigned session
, utmpRemoteAddr =
if all (==0) [addr1,addr2,addr3]
then do guard (addr0/=0)
Just $ SockAddrInet6 0 0 (0,0,0xFFFF,addr0) 0
else Just $ SockAddrInet6 0 0 (addr0,addr1,addr2,addr3) 0
}
where
processId = CPid . coerceToSigned
-- users2 :: IO [(UserName, Tty, ProcessID)]
users2 = do
us <- utmp
let us' = map interp_utmp_record2 us
us3 <- filterM (processAlive . utmpPid) us'
return us3
{-
- This is how the w command reports idle time:
/* stat the device file to get an idle time */
static time_t idletime(const char *restrict const tty)
{
struct stat sbuf;
if (stat(tty, &sbuf) != 0)
return 0;
return time(NULL) - sbuf.st_atime;
}
- THis might be useful fo rimplementing
- xep-0012 Last Activity
- iq get {jabber:iq:last}query
-
-}
|
