diff options
Diffstat (limited to 'consolation.hs')
-rw-r--r-- | consolation.hs | 18 |
1 files changed, 13 insertions, 5 deletions
diff --git a/consolation.hs b/consolation.hs index 640b51c2..0c6e907a 100644 --- a/consolation.hs +++ b/consolation.hs | |||
@@ -19,7 +19,7 @@ import qualified Data.Text.IO as Text | |||
19 | import qualified Network.BSD as BSD | 19 | import qualified Network.BSD as BSD |
20 | 20 | ||
21 | import WaitForSignal ( waitForTermSignal ) | 21 | import WaitForSignal ( waitForTermSignal ) |
22 | import UTmp ( users2, utmp_file, UtmpRecord(..) ) | 22 | import UTmp ( users2, utmp_file, UtmpRecord(..), UT_Type(USER_PROCESS) ) |
23 | import FGConsole ( monitorTTY ) | 23 | import FGConsole ( monitorTTY ) |
24 | 24 | ||
25 | data ConsoleState = ConsoleState | 25 | data ConsoleState = ConsoleState |
@@ -33,7 +33,13 @@ newConsoleState = atomically $ | |||
33 | 33 | ||
34 | onLogin cs start = \e -> do | 34 | onLogin cs start = \e -> do |
35 | us <- UTmp.users2 | 35 | us <- UTmp.users2 |
36 | let m = foldl' (\m x -> Map.insert (utmpTty x) x m) Map.empty us | 36 | let (m,cruft) = |
37 | foldl' (\(m,cruft) x -> | ||
38 | if utmpType x==USER_PROCESS | ||
39 | then (Map.insert (utmpTty x) x m,cruft) | ||
40 | else (m,Map.insert (utmpTty x) x cruft)) | ||
41 | (Map.empty,Map.empty) | ||
42 | us | ||
37 | newborn <- atomically $ do | 43 | newborn <- atomically $ do |
38 | old <- readTVar (csUtmp cs) -- swapTVar (csUtmp cs) m | 44 | old <- readTVar (csUtmp cs) -- swapTVar (csUtmp cs) m |
39 | newborn <- flip Traversable.mapM (m Map.\\ old) | 45 | newborn <- flip Traversable.mapM (m Map.\\ old) |
@@ -89,9 +95,11 @@ newCon log activeTTY utmp = do | |||
89 | flip (maybe $ return ()) u $ \u -> do | 95 | flip (maybe $ return ()) u $ \u -> do |
90 | jid <- ujid u | 96 | jid <- ujid u |
91 | log $ status (resource u) tty tu <> " " <> jid <> " pid=" <> tshow (utmpPid u) | 97 | log $ status (resource u) tty tu <> " " <> jid <> " pid=" <> tshow (utmpPid u) |
92 | <> if istty (resource u) | 98 | <> (if istty (resource u) |
93 | then " host=" <> tshow (utmpHost u) | 99 | then " host=" <> tshow (utmpHost u) |
94 | else "" | 100 | else "") |
101 | <> " session=" <> tshow (utmpSession u) | ||
102 | <> " addr=" <> utmpRemoteAddr u | ||
95 | loop tty tu (Just u) | 103 | loop tty tu (Just u) |
96 | where | 104 | where |
97 | bstatus r ttynum mtu | 105 | bstatus r ttynum mtu |