graceful quit from accept loop

1 files changed, 26 insertions, 0 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index 1eb0c0ed..b0f73a9e 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 
 import System.Directory
 import System.IO
@@ -10,9 +11,15 @@ import System.Posix.Process
 import Data.Maybe
 
 import System.INotify
+#ifndef NOUTMP
 import UTmp
+#endif
 import FGConsole
 import XMPPServer
+import Data.HList
+import Network.Socket (sClose)
+import Control.Concurrent (threadDelay)
+import Control.Exception (handle,SomeException(..))
 
 jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc
 
@@ -22,6 +29,7 @@ toJabberId host (user,tty,_) =
       then Just (jid user host tty)
       else Nothing
 
+#ifndef NOUTMP
 utmp_event e = do
     -- print e
     putStrLn "---"
@@ -29,26 +37,44 @@ utmp_event e = do
     let ids = mapMaybe (toJabberId "localhost") us
         ids :: [String]
     forM_ ids putStrLn
+#endif
 
 on_chvt vtnum = do
     putStrLn $ "changed vt to "++ show vtnum
 
 start :: IO ()
 start = do
+#ifndef NOUTMP
     installHandler sigUSR1 (Catch (utmp_event (userError "signaled"))) Nothing
+#endif
+    -- installHandler sigTERM (CatchOnce (utmp_event (userError "term signaled"))) Nothing
     inotify <- initINotify
     print inotify
+#ifndef NOUTMP
     wd <- addWatch
             inotify
             [CloseWrite] -- [Open,Close,Access,Modify,Move]
             utmp_file
             utmp_event
     print wd
+#endif
     mtty <- monitorTTY on_chvt
+    sock <- listenForXmppClients 5222 HNil
     putStrLn "Hit enter to terminate..."
     getLine
+    {-
+    let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")
+    handle doException $ do
+    -}
+    sClose sock
+    -- threadDelay 1000
+    putStrLn "closed listener."
     unmonitorTTY mtty
+    putStrLn "unhooked tty monitor."
+#ifndef NOUTMP
     removeWatch wd
+#endif
+    putStrLn "Normal termination."
 
 sendUSR1 pid = do
     signalProcess sigUSR1 pid