diff options
Diffstat (limited to 'Presence/UTmp.hs')
-rw-r--r-- | Presence/UTmp.hs | 31 |
1 files changed, 19 insertions, 12 deletions
diff --git a/Presence/UTmp.hs b/Presence/UTmp.hs index f22d1426..99d51205 100644 --- a/Presence/UTmp.hs +++ b/Presence/UTmp.hs | |||
@@ -19,18 +19,15 @@ import Data.Maybe | |||
19 | import System.Posix.Signals | 19 | import System.Posix.Signals |
20 | import System.Posix.Types | 20 | import System.Posix.Types |
21 | import Control.Monad | 21 | import Control.Monad |
22 | import Data.Char | ||
23 | import Data.Word | 22 | import Data.Word |
24 | import Data.Int | 23 | import Data.Int |
25 | import Control.Monad.Error.Class | 24 | import Control.Monad.Error.Class |
26 | import System.IO.Error | 25 | import System.IO.Error |
27 | import Debug.Trace | ||
28 | import qualified Paths | 26 | import qualified Paths |
29 | import Data.Text ( Text ) | 27 | import Data.Text ( Text ) |
30 | import Unsafe.Coerce ( unsafeCoerce ) | 28 | import Unsafe.Coerce ( unsafeCoerce ) |
31 | import qualified Data.Text as Text | 29 | import Network.Socket ( SockAddr(..) ) |
32 | import qualified Data.Text.Encoding as Text | 30 | import qualified Data.Text.Encoding as Text |
33 | import qualified Codec.Binary.Base16 as Hex | ||
34 | 31 | ||
35 | 32 | ||
36 | utmp_file = Paths.utmp -- "/var/run/utmp" | 33 | utmp_file = Paths.utmp -- "/var/run/utmp" |
@@ -49,7 +46,10 @@ decode_utmp_bytestring = | |||
49 | , UnsignedLE 2 -- exit status (int) | 46 | , UnsignedLE 2 -- exit status (int) |
50 | , UnsignedLE 4 -- session id (int) | 47 | , UnsignedLE 4 -- session id (int) |
51 | , Fixed 8 -- time entry was made | 48 | , Fixed 8 -- time entry was made |
52 | , Fixed 16 -- remote addr v6 | 49 | , Unsigned 4 -- remote addr v6 addr[0] |
50 | , Unsigned 4 -- remote addr v6 addr[1] | ||
51 | , Unsigned 4 -- remote addr v6 addr[2] | ||
52 | , Unsigned 4 -- remote addr v6 addr[3] | ||
53 | , Skip 20 -- reserved | 53 | , Skip 20 -- reserved |
54 | ]) | 54 | ]) |
55 | 55 | ||
@@ -67,7 +67,8 @@ utmp = fmap (map decode_utmp_bytestring . utmp_records) utmp_bs | |||
67 | 67 | ||
68 | toStr = takeWhile (/='\0') . C.unpack | 68 | toStr = takeWhile (/='\0') . C.unpack |
69 | 69 | ||
70 | interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv6) = | 70 | interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time |
71 | ,addr0,addr1,addr2,addr3) = | ||
71 | ( (toEnum . fromIntegral) typ :: UT_Type | 72 | ( (toEnum . fromIntegral) typ :: UT_Type |
72 | , toStr user, toStr tty, processId pid, toStr hostv4 ) | 73 | , toStr user, toStr tty, processId pid, toStr hostv4 ) |
73 | where | 74 | where |
@@ -122,13 +123,14 @@ data UtmpRecord = UtmpRecord | |||
122 | , utmpPid :: CPid | 123 | , utmpPid :: CPid |
123 | , utmpHost :: Text | 124 | , utmpHost :: Text |
124 | , utmpSession :: Int32 | 125 | , utmpSession :: Int32 |
125 | , utmpRemoteAddr :: Text | 126 | , utmpRemoteAddr :: Maybe SockAddr |
126 | } | 127 | } |
127 | deriving ( Show, Read, Eq, Ord ) | 128 | deriving ( Show, Eq, Ord ) |
128 | 129 | ||
129 | toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs | 130 | toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs |
130 | 131 | ||
131 | interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,addr) = | 132 | interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4 |
133 | ,term,exit,session,time,addr0,addr1,addr2,addr3) = | ||
132 | UtmpRecord | 134 | UtmpRecord |
133 | { utmpType = toEnum (fromIntegral typ) :: UT_Type | 135 | { utmpType = toEnum (fromIntegral typ) :: UT_Type |
134 | , utmpUser = toText user | 136 | , utmpUser = toText user |
@@ -136,7 +138,12 @@ interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,addr | |||
136 | , utmpPid = processId pid | 138 | , utmpPid = processId pid |
137 | , utmpHost = toText hostv4 | 139 | , utmpHost = toText hostv4 |
138 | , utmpSession = coerceToSigned session | 140 | , utmpSession = coerceToSigned session |
139 | , utmpRemoteAddr = Text.pack (Hex.encode $ map (fromIntegral . ord) $ C.unpack addr) } | 141 | , utmpRemoteAddr = |
142 | if all (==0) [addr1,addr2,addr3] | ||
143 | then do guard (addr0/=0) | ||
144 | Just $ SockAddrInet6 0 0 (0,0,0xFFFF,addr0) 0 | ||
145 | else Just $ SockAddrInet6 0 0 (addr0,addr1,addr2,addr3) 0 | ||
146 | } | ||
140 | where | 147 | where |
141 | processId = CPid . coerceToSigned | 148 | processId = CPid . coerceToSigned |
142 | 149 | ||