started project

1 files changed, 93 insertions, 0 deletions

diff --git a/Presence/UTmp.hs b/Presence/UTmp.hs
new file mode 100644
index 00000000..c94dcef2
--- /dev/null
+++ b/Presence/UTmp.hs
@@ -0,0 +1,93 @@
+
+{-# LANGUAGE TemplateHaskell #-}
+module UTmp (users, utmp_file) where
+
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as C
+import Data.BitSyntax
+import Data.Functor.Identity
+import Foreign.C.String
+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
+
+import Todo
+
+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)); }
+
+users = do
+    us <- utmp
+    let us' = map interp_utmp_record us
+        us'' = mapMaybe user_proc us'
+        user_proc (u,tty,pid,USER_PROCESS) = Just (u,tty,pid)
+        user_proc _                        = Nothing
+        onThrd f (_,_,pid) = f pid
+    us3 <- filterM (onThrd processAlive) us''
+    return us3