summaryrefslogtreecommitdiff
path: root/Presence/ConsoleWriter.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-11-20 21:07:16 -0500
committerjoe <joe@jerkface.net>2017-11-20 21:07:16 -0500
commit8413039df93b239ea3fcadc1872277201c1b5399 (patch)
treef0593cb83e8b0015878d7da9230e19bd63bfbcc9 /Presence/ConsoleWriter.hs
parentc1d033886f9d0b7038bc453795f043d1e97f94b2 (diff)
WIP: Multiple identities/rosters for a single unix user.
Diffstat (limited to 'Presence/ConsoleWriter.hs')
-rw-r--r--Presence/ConsoleWriter.hs17
1 files changed, 9 insertions, 8 deletions
diff --git a/Presence/ConsoleWriter.hs b/Presence/ConsoleWriter.hs
index 986294f4..b80e477a 100644
--- a/Presence/ConsoleWriter.hs
+++ b/Presence/ConsoleWriter.hs
@@ -100,8 +100,8 @@ onLogin cs start = \e -> do
100 $ \tuvar -> do 100 $ \tuvar -> do
101 tu <- readTVar tuvar 101 tu <- readTVar tuvar
102 return (tty,tu) 102 return (tty,tu)
103 103
104 forM_ (Map.elems newborn) $ 104 forM_ (Map.elems newborn) $
105 forkIO . start getActive 105 forkIO . start getActive
106 -- forM_ (Map.elems dead ) $ putStrLn . ("gone: "++) . show 106 -- forM_ (Map.elems dead ) $ putStrLn . ("gone: "++) . show
107 107
@@ -297,7 +297,7 @@ writeAllPty cw msg = do
297 && Text.all isDigit (Text.drop 4 k) 297 && Text.all isDigit (Text.drop 4 k)
298 bs <- forM (Map.toList ptys) $ \(tty,utmp) -> do 298 bs <- forM (Map.toList ptys) $ \(tty,utmp) -> do
299 deliverTerminalMessage cw ("/dev/" <> tty) utmp msg 299 deliverTerminalMessage cw ("/dev/" <> tty) utmp msg
300 return $ or bs 300 return $ or bs
301 301
302resource :: UtmpRecord -> Text 302resource :: UtmpRecord -> Text
303resource u = 303resource u =
@@ -341,10 +341,11 @@ newCon log cw activeTTY utmp = do
341 statusv <- atomically $ newTVar (Just stanza) 341 statusv <- atomically $ newTVar (Just stanza)
342 flgs <- atomically $ newTVar 0 342 flgs <- atomically $ newTVar 0
343 let client = ClientState { clientResource = r 343 let client = ClientState { clientResource = r
344 , clientUser = utmpUser u 344 , clientUser = utmpUser u
345 , clientPid = Nothing 345 , clientProfile = "."
346 , clientStatus = statusv 346 , clientPid = Nothing
347 , clientFlags = flgs } 347 , clientStatus = statusv
348 , clientFlags = flgs }
348 atomically $ do 349 atomically $ do
349 modifyTVar (cwClients cw) $ Map.insert r client 350 modifyTVar (cwClients cw) $ Map.insert r client
350 putTMVar (cwPresenceChan cw) (client,stanza) 351 putTMVar (cwPresenceChan cw) (client,stanza)
@@ -359,7 +360,7 @@ newCon log cw activeTTY utmp = do
359 guard (not $ Text.null $ utmpHost tu) 360 guard (not $ Text.null $ utmpHost tu)
360 return tu 361 return tu
361 match mtu = searchstr mtu `Text.isInfixOf` Text.dropWhile (/=':') r 362 match mtu = searchstr mtu `Text.isInfixOf` Text.dropWhile (/=':') r
362 jstatus r ttynum tu = 363 jstatus r ttynum tu =
363 if bstatus r ttynum tu 364 if bstatus r ttynum tu
364 then Available 365 then Available
365 else Away 366 else Away