2 files changed, 41 insertions, 29 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
     , Tty
     , ProcessID
     , UtmpRecord(..)
+    , UT_Type(..)
     ) where
 
 import qualified Data.ByteString as S
@@ -18,14 +19,18 @@ import Data.Maybe
 import System.Posix.Signals
 import System.Posix.Types
 import Control.Monad
-import Unsafe.Coerce
+import Data.Char
 import Data.Word
 import Data.Int
 import Control.Monad.Error.Class
 import System.IO.Error
+import Debug.Trace
 import qualified Paths
-import Data.Text ( Text )
+import Data.Text     ( Text )
+import Unsafe.Coerce ( unsafeCoerce )
+import qualified Data.Text as Text
 import qualified Data.Text.Encoding as Text
+import qualified Codec.Binary.Base16 as Hex
 
 
 utmp_file = Paths.utmp -- "/var/run/utmp"
@@ -40,9 +45,9 @@ decode_utmp_bytestring =
                , Fixed 4 -- inittab id
                , Fixed 32 -- username
                , Fixed 256 -- remote host
-               , UnsignedLE 4 -- termination status
-               , UnsignedLE 4 -- exit status
-               , Fixed 4 -- session id
+               , UnsignedLE 2 -- termination status
+               , UnsignedLE 2 -- exit status (int)
+               , UnsignedLE 4 -- session id  (int)
                , Fixed 8 -- time entry was made
                , Fixed 16 -- remote addr v6
                , Skip 20 -- reserved
@@ -66,9 +71,10 @@ interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv
     ( (toEnum . fromIntegral) typ :: UT_Type
     , toStr user, toStr tty, processId pid, toStr hostv4 )
  where
-    processId = CPid . coerce
-    coerce :: Word32 -> Int32
-    coerce = unsafeCoerce
+    processId = CPid . coerceToSigned
+
+coerceToSigned :: Word32 -> Int32
+coerceToSigned = unsafeCoerce
 
 
 data UT_Type
@@ -86,7 +92,7 @@ data UT_Type
 
  | ACCOUNTING      
 
- deriving (Enum,Show,Eq,Read)
+ deriving (Enum,Show,Eq,Ord,Read)
 
 processAlive pid = do
     catchError (do { signalProcess nullSignal pid ; return True })
@@ -110,37 +116,35 @@ users = fmap (map only3) $ do
 only3 (a,b,c,_) = (a,b,c)
 
 data UtmpRecord = UtmpRecord
-  { utmpUser :: Text
+  { utmpType :: UT_Type
+  , utmpUser :: Text
   , utmpTty :: Text
   , utmpPid :: CPid
   , utmpHost :: Text
+  , utmpSession :: Int32
+  , utmpRemoteAddr :: Text
   }
  deriving ( Show, Read, Eq, Ord )
 
 toText bs = Text.decodeUtf8 $ C.takeWhile (/='\0') bs
 
-interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv6) =
-    ( (toEnum . fromIntegral) typ :: UT_Type
-    , UtmpRecord
-        { utmpUser = toText user
+interp_utmp_record2 (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,addr) =
+    UtmpRecord
+        { utmpType = toEnum (fromIntegral typ) :: UT_Type
+        , utmpUser = toText user
         , utmpTty  = toText tty
         , utmpPid  = processId pid
-        , utmpHost = toText hostv4 }
-    )
+        , utmpHost = toText hostv4
+        , utmpSession = coerceToSigned session
+        , utmpRemoteAddr = Text.pack (Hex.encode $ map (fromIntegral . ord) $ C.unpack addr) }
  where
-    processId = CPid . coerce
-    coerce :: Word32 -> Int32
-    coerce = unsafeCoerce
+    processId = CPid . coerceToSigned
 
 -- users2 :: IO [(UserName, Tty, ProcessID)]
 users2 = do
     us <- utmp
     let us' = map interp_utmp_record2 us
-        us'' = mapMaybe user_proc us'
-        user_proc (USER_PROCESS, rec)
-                    = Just rec
-        user_proc _ = Nothing
-    us3 <- filterM (processAlive . utmpPid) us''
+    us3 <- filterM (processAlive . utmpPid) us'
     return us3
 
 {- 
diff --git a/consolation.hs b/consolation.hs
index 640b51c2..0c6e907a 100644
--- a/consolation.hs
+++ b/consolation.hs
@@ -19,7 +19,7 @@ import qualified Data.Text.IO as Text
 import qualified Network.BSD as BSD
 
 import WaitForSignal  ( waitForTermSignal )
-import UTmp           ( users2, utmp_file, UtmpRecord(..) )
+import UTmp           ( users2, utmp_file, UtmpRecord(..), UT_Type(USER_PROCESS) )
 import FGConsole      ( monitorTTY )
 
 data ConsoleState = ConsoleState
@@ -33,7 +33,13 @@ newConsoleState = atomically $
 
 onLogin cs start = \e -> do
     us <- UTmp.users2
-    let m = foldl' (\m x -> Map.insert (utmpTty x) x m) Map.empty us
+    let (m,cruft) =
+            foldl' (\(m,cruft) x ->
+                        if utmpType x==USER_PROCESS
+                            then (Map.insert (utmpTty x) x m,cruft)
+                            else (m,Map.insert (utmpTty x) x cruft))
+                   (Map.empty,Map.empty)
+                   us
     newborn <- atomically $ do
         old <- readTVar (csUtmp cs) -- swapTVar (csUtmp cs) m
         newborn <- flip Traversable.mapM (m Map.\\ old)
@@ -89,9 +95,11 @@ newCon log activeTTY utmp = do
     flip (maybe $ return ()) u $ \u -> do
     jid <- ujid u
     log $ status (resource u) tty tu <> " " <> jid <> "  pid=" <> tshow (utmpPid u)
-            <> if istty (resource u)
-                then " host=" <> tshow (utmpHost u)
-                else ""
+            <> (if istty (resource u)
+                 then " host=" <> tshow (utmpHost u)
+                 else "")
+            <> " session=" <> tshow (utmpSession u)
+            <> " addr=" <> utmpRemoteAddr u
     loop tty tu (Just u)
  where
     bstatus r ttynum mtu