{-# LANGUAGE TemplateHaskell #-}
module UTmp 
    ( users
    , utmp_file
    , UserName
    , Tty
    , ProcessID
    ) 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 System.Posix.Signals
import System.Posix.Types
import Control.Monad
import Unsafe.Coerce
import Data.Word
import Data.Int
import Control.Monad.Error.Class
import System.IO.Error


utmp_file = "/var/run/utmp"

utmp_bs = S.readFile utmp_file

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 4 -- termination status
               , UnsignedLE 4 -- exit status
               , Fixed 4 -- session id
               , Fixed 8 -- time entry was made
               , Fixed 16 -- remote addr v6
               , Skip 20 -- reserved
               ])

utmp_size = 384 -- 768


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 = fmap (map decode_utmp_bytestring . utmp_records) utmp_bs


interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv6) =
    (toStr user, toStr tty, processId pid, (toEnum . fromIntegral) typ :: UT_Type)
 where
    toStr = takeWhile (/='\0') . C.unpack
    processId = CPid . coerce
    coerce :: Word32 -> Int32
    coerce = 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,Read)

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 = do
    us <- utmp
    let us' = map interp_utmp_record us
        us'' = mapMaybe user_proc us'
        user_proc (u,tty,pid,USER_PROCESS) = Just (L.pack u,L.pack tty,pid)
        user_proc _                        = Nothing
        onThrd f (_,_,pid) = f pid
    us3 <- filterM (onThrd processAlive) us''
    return us3