{-# LANGUAGE TemplateHaskell #-}
module UTmp 
    ( users
    , users2
    , utmp_file
    , UserName
    , Tty
    , ProcessID
    , UtmpRecord(..)
    , UT_Type(..)
    ) 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 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 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"

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 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
               ])

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

toStr = takeWhile (/='\0') . C.unpack

interp_utmp_record (typ,pid,tty,inittab,user,hostv4,term,exit,session,time,hostv6) =
    ( (toEnum . fromIntegral) typ :: UT_Type
    , toStr user, toStr tty, processId pid, toStr hostv4 )
 where
    processId = CPid . coerceToSigned

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

only3 (a,b,c,_) = (a,b,c)

data UtmpRecord = UtmpRecord
  { 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,addr) =
    UtmpRecord
        { utmpType = toEnum (fromIntegral typ) :: UT_Type
        , utmpUser = toText user
        , utmpTty  = toText tty
        , utmpPid  = processId pid
        , utmpHost = toText hostv4
        , utmpSession = coerceToSigned session
        , utmpRemoteAddr = Text.pack (Hex.encode $ map (fromIntegral . ord) $ C.unpack addr) }
 where
    processId = CPid . coerceToSigned

-- users2 :: IO [(UserName, Tty, ProcessID)]
users2 = do
    us <- utmp
    let us' = map interp_utmp_record2 us
    us3 <- filterM (processAlive . utmpPid) us'
    return us3

{- 
 - This is how the w command reports idle time:
/* stat the device file to get an idle time */
static time_t idletime(const char *restrict const tty)
{
        struct stat sbuf;
        if (stat(tty, &sbuf) != 0)
                return 0;
        return time(NULL) - sbuf.st_atime;
}
 - THis might be useful fo rimplementing
 - xep-0012 Last Activity
 - iq get {jabber:iq:last}query
 - 
 -}