Attempt to detect screen original tty ("cruft" output)

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
 import qualified Network.BSD as BSD
 
 import WaitForSignal  ( waitForTermSignal )
-import UTmp           ( users2, utmp_file, UtmpRecord(..), UT_Type(USER_PROCESS) )
+import UTmp           ( users2, utmp_file, UtmpRecord(..), UT_Type(..) )
 import FGConsole      ( monitorTTY )
 
 data ConsoleState = ConsoleState
@@ -35,11 +35,16 @@ onLogin cs start = \e -> do
     us <- UTmp.users2
     let (m,cruft) =
             foldl' (\(m,cruft) x ->
-                        if utmpType x==USER_PROCESS
-                            then (Map.insert (utmpTty x) x m,cruft)
-                            else (m,Map.insert (utmpTty x) x cruft))
+                        case utmpType x of
+                         USER_PROCESS
+                           -> (Map.insert (utmpTty x) x m,cruft)
+                         DEAD_PROCESS | utmpPid x /= 0
+                           -> (m,Map.insert (utmpTty x) x cruft)
+                         _ -> (m,cruft))
                    (Map.empty,Map.empty)
                    us
+    forM_ (Map.elems cruft) $ \c -> do
+        putStrLn $ "cruft " ++ show (utmpTty c, utmpPid c,utmpHost c, utmpRemoteAddr c)
     newborn <- atomically $ do
         old <- readTVar (csUtmp cs) -- swapTVar (csUtmp cs) m
         newborn <- flip Traversable.mapM (m Map.\\ old)