cleaner debug output

3 files changed, 30 insertions, 17 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
index adc3de84..deab779b 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -24,6 +24,8 @@ import Control.Exception (handle,SomeException(..))
 import Data.HList
 import Data.HList.TypeEqGeneric1()
 import Data.HList.TypeCastGeneric1()
+import System.IO.Error
+import ByteStringOperators
 
 
 newtype ConnId = ConnId Int
@@ -50,9 +52,6 @@ doServer port g startCon = runServer2 port (runConn2 g)
         hSetBuffering h NoBuffering
         st'' <- startCon sock (h .*. st)
         let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")
-        handle doException $ do
-            -- PEER CRED: (0,4294967295,4294967295)
-            -- PEER NAME: 127.0.0.1:37253
         handle doException $ fix $ \loop -> do
             let continue () = hIsEOF h >>= flip when loop . not
             packet <- getPacket h
@@ -73,12 +72,19 @@ doServer port g startCon = runServer2 port (runConn2 g)
         listen sock 2
         forkIO $ do
             mainLoop sock (ConnId 0) go
-            L.putStrLn $ "quit accept loop"
+            -- L.putStrLn $ "quit accept loop"
         return sock
      where
         mainLoop sock idnum@(ConnId n) go = do
-            let doException (SomeException e) = do
-                Prelude.putStrLn ("\n\naccept-loop exception: " ++ show e ++ "\n\n")
+            let doException ioerror = do
+                let typ = ioeGetErrorType ioerror
+                if -- typ == InvalidArgument  
+                   -- but the symbol is not exported :/
+                   bshow typ=="invalid argument" 
+                  then do
+                    L.putStrLn $ "quit accept-loop."
+                  else do
+                    L.putStrLn ("accept-loop exception: " <++> bshow ioerror <++> "\n")
                 return Nothing
             mcon <- handle doException $ fix $ \loop -> do
                 con <- accept sock
diff --git a/Presence/main.hs b/Presence/main.hs
index dd6bfb2e..36796b6e 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -30,7 +30,7 @@ import Control.Exception
 import LocalPeerCred
 import System.Posix.User
 import qualified Data.Set as Set
-import           Data.Set (Set)
+import           Data.Set as Set (Set,(\\))
 
 import ByteStringOperators
 import qualified Data.ByteString.Lazy.Char8 as L
@@ -48,15 +48,21 @@ toJabberId host (user,tty,_) =
 
 track_login :: IORef (Set L.ByteString) -> t -> IO ()
 track_login tracked e = do
-    -- print e
-    putStrLn "---"
 #ifndef NOUTMP
     us <- users
 #else
     let us = []
 #endif
-    let ids = mapMaybe (toJabberId "localhost") us
-    forM_ ids L.putStrLn
+    let ids = Set.fromList $ mapMaybe (toJabberId "localhost") us
+    -- forM_ ids L.putStrLn
+    state <- readIORef tracked
+    let arrivals   = ids \\ state
+        departures = state \\ ids
+    forM_ (Set.toList departures) $ \id -> do
+        putStrLn $ id <++> " logged out."
+    forM_ (Set.toList arrivals) $ \id -> do
+        putStrLn $ id <++> " logged in."
+    writeIORef tracked ids
 
 data UnixSession = UnixSession {
     unix_uid :: (IORef (Maybe UserID)),
@@ -101,19 +107,18 @@ start = do
     tracked <- newIORef Set.empty
     let dologin e = track_login tracked e
         dologin :: t -> IO ()
+    dologin ()
 #ifndef NOUTMP
     installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing
 #endif
     -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing
     inotify <- initINotify
-    print inotify
 #ifndef NOUTMP
     wd <- addWatch
             inotify
             [CloseWrite] -- [Open,Close,Access,Modify,Move]
             utmp_file
             dologin
-    print wd
 #endif
     mtty <- monitorTTY on_chvt
     sock <- listenForXmppClients UnixSessions 5222 HNil
diff --git a/Presence/monitortty.c b/Presence/monitortty.c
index 7b5dc82c..675abe5c 100644
--- a/Presence/monitortty.c
+++ b/Presence/monitortty.c
@@ -110,7 +110,7 @@ int tty = -1;
 
 void *write_vtch(void *pfd) {
         int fd = (int)(intptr_t)pfd;
-        printf("START write_vtch fd=%i\n",fd);
+        printf("started VT_WAITEVENT loop fd=%i\n",fd);
         pthread_mutex_lock(&mu);
         tty = ttyfd();
         pthread_mutex_unlock(&mu);
@@ -131,6 +131,7 @@ void *write_vtch(void *pfd) {
                 }
                 do {
                         vt_wait(tty);
+                        // printf("vt_wait() finished. tty=%d fd=%d\n",tty,fd);
                         active_tty = get_active(tty);
                 } while (active_tty==reported_tty);
         }
@@ -138,7 +139,7 @@ void *write_vtch(void *pfd) {
         // TODO:
         //  use VT_GETSTATE
         //  use VT_WAITEVENT
-        printf("QUIT write_vtch\n");
+        printf("stopped VT_WAITEVENT loop\n");
         tty = -1;
         pthread_mutex_destroy(&mu);
         return NULL;
@@ -147,7 +148,7 @@ void *write_vtch(void *pfd) {
 
 void monitorTTY(int fd) {
         pthread_mutex_init(&mu,NULL);
-        printf ("Hello world.\n");
+        // printf ("Hello world.\n");
         pthread_create (&mt, NULL, write_vtch, (void*)(intptr_t)fd);
 }
 
@@ -158,8 +159,9 @@ void closeTTY() {
         active = get_active(tty);
         fd = tty;
         pthread_mutex_unlock(&mu);
-        pthread_cancel(mt);
+        // pthread_cancel(mt);
         char cmd[40]; cmd[39] = '\0';
+        // Hack to wake up from VT_WAITEVENT ioctl
         snprintf(cmd,39,"chvt %i;chvt %i",active+1,active);
         system(cmd);
         pthread_join(mt,NULL);