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
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
|
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RankNTypes #-}
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 Data.String
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types
import System.Posix.User
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 :: IsString s => s
utmp_file = fromString $ Paths.utmp -- "/var/run/utmp"
utmp_bs :: IO C.ByteString
utmp_bs = S.readFile utmp_file
decode_utmp_bytestring ::
C.ByteString
-> (Word32,
Word32,
C.ByteString,
C.ByteString,
C.ByteString,
C.ByteString,
Word16,
Word16,
Word32,
C.ByteString,
Word32,
Word32,
Word32,
Word32)
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 :: Int
utmp_size = 384 -- 768
utmp_records :: C.ByteString -> [C.ByteString]
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 ::
IO
[(Word32,
Word32,
C.ByteString,
C.ByteString,
C.ByteString,
C.ByteString,
Word16,
Word16,
Word32,
C.ByteString,
Word32,
Word32,
Word32,
Word32)]
utmp = fmap (map decode_utmp_bytestring . utmp_records) utmp_bs
toStr :: C.ByteString -> [Char]
toStr = takeWhile (/='\0') . C.unpack
interp_utmp_record ::
forall t t1 t2 t3 t4 t5 t6 t7 t8 a.
Integral a =>
(a,
Word32,
C.ByteString,
t,
C.ByteString,
C.ByteString,
t1,
t2,
t3,
t4,
t5,
t6,
t7,
t8)
-> (UT_Type, [Char], [Char], CPid, [Char])
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 :: ProcessID -> IO Bool
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 = utmp_users `catchIOError` \_ -> do
-- If we can't read utmp file, then return a list with only the current
-- user.
uname <- getLoginName
pid <- getProcessID -- TODO: XXX: Does this make sense as a fallback?
return [(L.pack uname,L.empty,pid)]
where
utmp_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 :: forall t t1 t2 t3. (t1, t2, t3, t) -> (t1, t2, t3)
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 :: C.ByteString -> Text
toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs
interp_utmp_record2 ::
forall t t1 t2 t3 a.
Integral a =>
(a,
Word32,
C.ByteString,
t,
C.ByteString,
C.ByteString,
t1,
t2,
Word32,
t3,
Word32,
Word32,
Word32,
Word32)
-> UtmpRecord
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 [UtmpRecord]
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
-
-}
|
