diff options
author | joe <joe@jerkface.net> | 2014-03-14 12:54:53 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-03-14 12:54:53 -0400 |
commit | 0e78e2e0329ddf9dffdb0a5b030e21772168f32e (patch) | |
tree | 5aee5d3f535fe48d3b3b1e0fb009e4400ea03472 | |
parent | 92faec23cc13774962eb4b144218d1b901e492c7 (diff) |
Attempt to detect screen original tty ("cruft" output)
-rw-r--r-- | consolation.hs | 13 |
1 files changed, 9 insertions, 4 deletions
diff --git a/consolation.hs b/consolation.hs index 3daa258b..2b181dc1 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(..), UT_Type(USER_PROCESS) ) | 22 | import UTmp ( users2, utmp_file, UtmpRecord(..), UT_Type(..) ) |
23 | import FGConsole ( monitorTTY ) | 23 | import FGConsole ( monitorTTY ) |
24 | 24 | ||
25 | data ConsoleState = ConsoleState | 25 | data ConsoleState = ConsoleState |
@@ -35,11 +35,16 @@ onLogin cs start = \e -> do | |||
35 | us <- UTmp.users2 | 35 | us <- UTmp.users2 |
36 | let (m,cruft) = | 36 | let (m,cruft) = |
37 | foldl' (\(m,cruft) x -> | 37 | foldl' (\(m,cruft) x -> |
38 | if utmpType x==USER_PROCESS | 38 | case utmpType x of |
39 | then (Map.insert (utmpTty x) x m,cruft) | 39 | USER_PROCESS |
40 | else (m,Map.insert (utmpTty x) x cruft)) | 40 | -> (Map.insert (utmpTty x) x m,cruft) |
41 | DEAD_PROCESS | utmpPid x /= 0 | ||
42 | -> (m,Map.insert (utmpTty x) x cruft) | ||
43 | _ -> (m,cruft)) | ||
41 | (Map.empty,Map.empty) | 44 | (Map.empty,Map.empty) |
42 | us | 45 | us |
46 | forM_ (Map.elems cruft) $ \c -> do | ||
47 | putStrLn $ "cruft " ++ show (utmpTty c, utmpPid c,utmpHost c, utmpRemoteAddr c) | ||
43 | newborn <- atomically $ do | 48 | newborn <- atomically $ do |
44 | old <- readTVar (csUtmp cs) -- swapTVar (csUtmp cs) m | 49 | old <- readTVar (csUtmp cs) -- swapTVar (csUtmp cs) m |
45 | newborn <- flip Traversable.mapM (m Map.\\ old) | 50 | newborn <- flip Traversable.mapM (m Map.\\ old) |