summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/UTmp.hs52
1 files changed, 28 insertions, 24 deletions
diff --git a/Presence/UTmp.hs b/Presence/UTmp.hs
index 86a19751..f22d1426 100644
--- a/Presence/UTmp.hs
+++ b/Presence/UTmp.hs
@@ -7,6 +7,7 @@ module UTmp
7 , Tty 7 , Tty
8 , ProcessID 8 , ProcessID
9 , UtmpRecord(..) 9 , UtmpRecord(..)
10 , UT_Type(..)
10 ) where 11 ) where
11 12
12import qualified Data.ByteString as S 13import qualified Data.ByteString as S
@@ -18,14 +19,18 @@ import Data.Maybe
18import System.Posix.Signals 19import System.Posix.Signals
19import System.Posix.Types 20import System.Posix.Types
20import Control.Monad 21import Control.Monad
21import Unsafe.Coerce 22import Data.Char
22import Data.Word 23import Data.Word
23import Data.Int 24import Data.Int
24import Control.Monad.Error.Class 25import Control.Monad.Error.Class
25import System.IO.Error 26import System.IO.Error
27import Debug.Trace
26import qualified Paths 28import qualified Paths
27import Data.Text ( Text ) 29import Data.Text ( Text )
30import Unsafe.Coerce ( unsafeCoerce )
31import qualified Data.Text as Text
28import qualified Data.Text.Encoding as Text 32import qualified Data.Text.Encoding as Text
33import qualified Codec.Binary.Base16 as Hex
29 34
30 35
31utmp_file = Paths.utmp -- "/var/run/utmp" 36utmp_file = Paths.utmp -- "/var/run/utmp"
@@ -40,9 +45,9 @@ decode_utmp_bytestring =
40 , Fixed 4 -- inittab id 45 , Fixed 4 -- inittab id
41 , Fixed 32 -- username 46 , Fixed 32 -- username
42 , Fixed 256 -- remote host 47 , Fixed 256 -- remote host
43 , UnsignedLE 4 -- termination status 48 , UnsignedLE 2 -- termination status
44 , UnsignedLE 4 -- exit status 49 , UnsignedLE 2 -- exit status (int)
45 , Fixed 4 -- session id 50 , UnsignedLE 4 -- session id (int)
46 , Fixed 8 -- time entry was made 51 , Fixed 8 -- time entry was made
47 , Fixed 16 -- remote addr v6 52 , Fixed 16 -- remote addr v6
48 , Skip 20 -- reserved 53 , Skip 20 -- reserved
@@ -66,9 +71,10 @@ interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv
66 ( (toEnum . fromIntegral) typ :: UT_Type 71 ( (toEnum . fromIntegral) typ :: UT_Type
67 , toStr user, toStr tty, processId pid, toStr hostv4 ) 72 , toStr user, toStr tty, processId pid, toStr hostv4 )
68 where 73 where
69 processId = CPid . coerce 74 processId = CPid . coerceToSigned
70 coerce :: Word32 -> Int32 75
71 coerce = unsafeCoerce 76coerceToSigned :: Word32 -> Int32
77coerceToSigned = unsafeCoerce
72 78
73 79
74data UT_Type 80data UT_Type
@@ -86,7 +92,7 @@ data UT_Type
86 92
87 | ACCOUNTING 93 | ACCOUNTING
88 94
89 deriving (Enum,Show,Eq,Read) 95 deriving (Enum,Show,Eq,Ord,Read)
90 96
91processAlive pid = do 97processAlive pid = do
92 catchError (do { signalProcess nullSignal pid ; return True }) 98 catchError (do { signalProcess nullSignal pid ; return True })
@@ -110,37 +116,35 @@ users = fmap (map only3) $ do
110only3 (a,b,c,_) = (a,b,c) 116only3 (a,b,c,_) = (a,b,c)
111 117
112data UtmpRecord = UtmpRecord 118data UtmpRecord = UtmpRecord
113 { utmpUser :: Text 119 { utmpType :: UT_Type
120 , utmpUser :: Text
114 , utmpTty :: Text 121 , utmpTty :: Text
115 , utmpPid :: CPid 122 , utmpPid :: CPid
116 , utmpHost :: Text 123 , utmpHost :: Text
124 , utmpSession :: Int32
125 , utmpRemoteAddr :: Text
117 } 126 }
118 deriving ( Show, Read, Eq, Ord ) 127 deriving ( Show, Read, Eq, Ord )
119 128
120toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs 129toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs
121 130
122interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv6) = 131interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,addr) =
123 ( (toEnum . fromIntegral) typ :: UT_Type 132 UtmpRecord
124 , UtmpRecord 133 { utmpType = toEnum (fromIntegral typ) :: UT_Type
125 { utmpUser = toText user 134 , utmpUser = toText user
126 , utmpTty = toText tty 135 , utmpTty = toText tty
127 , utmpPid = processId pid 136 , utmpPid = processId pid
128 , utmpHost = toText hostv4 } 137 , utmpHost = toText hostv4
129 ) 138 , utmpSession = coerceToSigned session
139 , utmpRemoteAddr = Text.pack (Hex.encode $ map (fromIntegral . ord) $ C.unpack addr) }
130 where 140 where
131 processId = CPid . coerce 141 processId = CPid . coerceToSigned
132 coerce :: Word32 -> Int32
133 coerce = unsafeCoerce
134 142
135-- users2 :: IO [(UserName, Tty, ProcessID)] 143-- users2 :: IO [(UserName, Tty, ProcessID)]
136users2 = do 144users2 = do
137 us <- utmp 145 us <- utmp
138 let us' = map interp_utmp_record2 us 146 let us' = map interp_utmp_record2 us
139 us'' = mapMaybe user_proc us' 147 us3 <- filterM (processAlive . utmpPid) us'
140 user_proc (USER_PROCESS, rec)
141 = Just rec
142 user_proc _ = Nothing
143 us3 <- filterM (processAlive . utmpPid) us''
144 return us3 148 return us3
145 149
146{- 150{-