State changes on vt switch.

2 files changed, 57 insertions, 12 deletions

diff --git a/Presence/ByteStringOperators.hs b/Presence/ByteStringOperators.hs
index 26b64bcf..2815f05a 100644
--- a/Presence/ByteStringOperators.hs
+++ b/Presence/ByteStringOperators.hs
@@ -3,6 +3,11 @@ module ByteStringOperators where
 import qualified Data.ByteString as S (ByteString)
 import Data.ByteString.Lazy.Char8 as L 
 
+-- These two were imported to provide an NFData instance.
+import qualified Data.ByteString.Lazy.Internal as L (ByteString(..))
+import Control.DeepSeq
+
+
 (<++>) :: ByteString -> ByteString -> ByteString
 (<++.>) :: ByteString -> S.ByteString -> ByteString
 (<.++>) :: S.ByteString -> ByteString -> ByteString
@@ -16,5 +21,20 @@ infixr 5 <.++>
 infixr 5 <++>
 infixr 5 <++.>
 
+Nothing <?++> b = b
+Just a  <?++> b = a <++> b
+infixr 5 <?++>
+
+a <++?> Nothing = a
+a <++?> Just b  = a <++> b
+infixr 5 <++?>
+
 bshow :: Show a => a -> ByteString
 bshow = L.pack . show
+
+
+instance NFData L.ByteString where
+    rnf L.Empty       = ()
+    rnf (L.Chunk _ b) = rnf b
+
+
diff --git a/Presence/main.hs b/Presence/main.hs
index 36796b6e..ff2f18cf 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -9,6 +9,7 @@ import System.Posix.Signals
 import System.Posix.Types
 import System.Posix.Process
 import Data.Maybe
+import Data.Char
 
 import System.INotify
 #ifndef NOUTMP
@@ -31,22 +32,40 @@ import LocalPeerCred
 import System.Posix.User
 import qualified Data.Set as Set
 import           Data.Set as Set (Set,(\\))
+import Control.Concurrent.MVar.Strict
+import Control.DeepSeq
 
 import ByteStringOperators
 import qualified Data.ByteString.Lazy.Char8 as L
-import           Data.ByteString.Lazy.Char8 as L (putStrLn)
+import           Data.ByteString.Lazy.Char8 as L (ByteString,putStrLn)
 import qualified Prelude
 import           Prelude hiding (putStrLn)
 
 
-jid user host rsrc = user <++> "@" <++> host <++> "/" <++> rsrc
+-- | Jabber ID (JID) datatype
+data JID = JID { name :: Maybe ByteString
+               -- ^ Account name
+               , server :: ByteString
+               -- ^ Server adress
+               , resource :: Maybe ByteString
+               -- ^ Resource name
+               }
+ deriving (Ord,Eq)
+
+instance Show JID where
+    show (JID n s r ) = L.unpack $ fmap (<++>"@") n <?++> s <++?> fmap ("/"<++>) r
+
+instance NFData JID where
+    rnf v@(JID n s r) = n `seq` s `seq` r `seq` ()
+
+jid user host rsrc = JID (Just user) host (Just rsrc)  --  user <++> "@" <++> host <++> "/" <++> rsrc
 
 toJabberId host (user,tty,_) = 
     if L.take 3 tty == "tty"
       then Just (jid user host tty)
       else Nothing
 
-track_login :: IORef (Set L.ByteString) -> t -> IO ()
+track_login :: MVar (Set JID) -> t -> IO ()
 track_login tracked e = do
 #ifndef NOUTMP
     us <- users
@@ -54,15 +73,13 @@ track_login tracked e = do
     let us = []
 #endif
     let ids = Set.fromList $ mapMaybe (toJabberId "localhost") us
-    -- forM_ ids L.putStrLn
-    state <- readIORef tracked
+    state <- swapMVar tracked ids
     let arrivals   = ids \\ state
         departures = state \\ ids
     forM_ (Set.toList departures) $ \id -> do
-        putStrLn $ id <++> " logged out."
+        putStrLn $ bshow id <++> " Offline."
     forM_ (Set.toList arrivals) $ \id -> do
-        putStrLn $ id <++> " logged in."
-    writeIORef tracked ids
+        putStrLn $ bshow id <++> " Available."
 
 data UnixSession = UnixSession {
     unix_uid :: (IORef (Maybe UserID)),
@@ -99,12 +116,20 @@ instance XMPPSession UnixSession where
         return jid
     closeSession _             = L.putStrLn "SESSION: close"
 
-on_chvt vtnum = do
-    L.putStrLn $ "changed vt to " <++> bshow vtnum
+on_chvt tracked vtnum = do
+    let tty = L.snoc "tty" $ intToDigit (fromIntegral vtnum)
+    L.putStrLn $ "changed vt to " <++> tty
+    state <- readMVar tracked
+    forM_ (Set.toList state) $ \jid -> do
+      case fmap (==tty) $ resource jid of
+        Just True  -> putStrLn $ bshow jid <++> " Available."
+        Just False -> putStrLn $ bshow jid <++> " Away."
+        Nothing    -> return ()
+
 
 start :: IO ()
 start = do
-    tracked <- newIORef Set.empty
+    tracked <- newMVar Set.empty
     let dologin e = track_login tracked e
         dologin :: t -> IO ()
     dologin ()
@@ -120,7 +145,7 @@ start = do
             utmp_file
             dologin
 #endif
-    mtty <- monitorTTY on_chvt
+    mtty <- monitorTTY (on_chvt tracked)
     sock <- listenForXmppClients UnixSessions 5222 HNil
     putStrLn "Hit enter to terminate..."
     getLine