delay a bit before first utmp scan so that we know active tty

1 files changed, 19 insertions, 10 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index ff2f18cf..7bf9d117 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -33,7 +33,9 @@ import System.Posix.User
 import qualified Data.Set as Set
 import           Data.Set as Set (Set,(\\))
 import Control.Concurrent.MVar.Strict
+import Control.Concurrent (threadDelay)
 import Control.DeepSeq
+import Debug.Trace
 
 import ByteStringOperators
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -65,7 +67,7 @@ toJabberId host (user,tty,_) =
       then Just (jid user host tty)
       else Nothing
 
-track_login :: MVar (Set JID) -> t -> IO ()
+track_login :: MVar (ByteString,Set JID) -> t -> IO ()
 track_login tracked e = do
 #ifndef NOUTMP
     us <- users
@@ -73,13 +75,17 @@ track_login tracked e = do
     let us = []
 #endif
     let ids = Set.fromList $ mapMaybe (toJabberId "localhost") us
-    state <- swapMVar tracked ids
+    (tty,state) <- modifyMVar tracked $ \(tty,st) ->
+                    return ((tty,ids),(tty,st))
     let arrivals   = ids \\ state
         departures = state \\ ids
     forM_ (Set.toList departures) $ \id -> do
         putStrLn $ bshow id <++> " Offline."
-    forM_ (Set.toList arrivals) $ \id -> do
-        putStrLn $ bshow id <++> " Available."
+    forM_ (Set.toList arrivals) $ \jid -> do
+      case fmap (==tty) $ resource jid of
+        Just True  -> putStrLn $ bshow jid <++> " Available."
+        Just False -> putStrLn $ bshow jid <++> " Away."
+        Nothing    -> trace "Unexpected lack of resource" $ return ()
 
 data UnixSession = UnixSession {
     unix_uid :: (IORef (Maybe UserID)),
@@ -118,8 +124,9 @@ instance XMPPSession UnixSession where
 
 on_chvt tracked vtnum = do
     let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum)
-    L.putStrLn $ "changed vt to " <++> tty
-    state <- readMVar tracked
+    L.putStrLn $ "VT switch: " <++> tty
+    state <- modifyMVar tracked $ \(_,us) -> do
+                return ((tty,us),us)
     forM_ (Set.toList state) $ \jid -> do
       case fmap (==tty) $ resource jid of
         Just True  -> putStrLn $ bshow jid <++> " Available."
@@ -129,14 +136,14 @@ on_chvt tracked vtnum = do
 
 start :: IO ()
 start = do
-    tracked <- newMVar Set.empty
+    tracked <- newMVar ("",Set.empty)
     let dologin e = track_login tracked e
         dologin :: t -> IO ()
-    dologin ()
 #ifndef NOUTMP
     installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing
 #endif
     -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing
+    mtty <- monitorTTY (on_chvt tracked)
     inotify <- initINotify
 #ifndef NOUTMP
     wd <- addWatch
@@ -145,9 +152,11 @@ start = do
             utmp_file
             dologin
 #endif
-    mtty <- monitorTTY (on_chvt tracked)
     sock <- listenForXmppClients UnixSessions 5222 HNil
-    putStrLn "Hit enter to terminate..."
+
+    threadDelay 1000 -- wait a moment to obtain current tty
+    dologin ()
+    putStrLn "\nHit enter to terminate...\n"
     getLine
     {-
     let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")