Fixed exit off-by-4 error in utmp parsing. Stopped filtering

DEAD_PROCESS in case we want to use the data for special handling
of screen ttys.

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
     , 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
 
 {-