summaryrefslogtreecommitdiff
path: root/Presence/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/main.hs')
-rw-r--r--Presence/main.hs26
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 @@
1{-# LANGUAGE CPP #-}
1 2
2import System.Directory 3import System.Directory
3import System.IO 4import System.IO
@@ -10,9 +11,15 @@ import System.Posix.Process
10import Data.Maybe 11import Data.Maybe
11 12
12import System.INotify 13import System.INotify
14#ifndef NOUTMP
13import UTmp 15import UTmp
16#endif
14import FGConsole 17import FGConsole
15import XMPPServer 18import XMPPServer
19import Data.HList
20import Network.Socket (sClose)
21import Control.Concurrent (threadDelay)
22import Control.Exception (handle,SomeException(..))
16 23
17jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc 24jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc
18 25
@@ -22,6 +29,7 @@ toJabberId host (user,tty,_) =
22 then Just (jid user host tty) 29 then Just (jid user host tty)
23 else Nothing 30 else Nothing
24 31
32#ifndef NOUTMP
25utmp_event e = do 33utmp_event e = do
26 -- print e 34 -- print e
27 putStrLn "---" 35 putStrLn "---"
@@ -29,26 +37,44 @@ utmp_event e = do
29 let ids = mapMaybe (toJabberId "localhost") us 37 let ids = mapMaybe (toJabberId "localhost") us
30 ids :: [String] 38 ids :: [String]
31 forM_ ids putStrLn 39 forM_ ids putStrLn
40#endif
32 41
33on_chvt vtnum = do 42on_chvt vtnum = do
34 putStrLn $ "changed vt to "++ show vtnum 43 putStrLn $ "changed vt to "++ show vtnum
35 44
36start :: IO () 45start :: IO ()
37start = do 46start = do
47#ifndef NOUTMP
38 installHandler sigUSR1 (Catch (utmp_event (userError "signaled"))) Nothing 48 installHandler sigUSR1 (Catch (utmp_event (userError "signaled"))) Nothing
49#endif
50 -- installHandler sigTERM (CatchOnce (utmp_event (userError "term signaled"))) Nothing
39 inotify <- initINotify 51 inotify <- initINotify
40 print inotify 52 print inotify
53#ifndef NOUTMP
41 wd <- addWatch 54 wd <- addWatch
42 inotify 55 inotify
43 [CloseWrite] -- [Open,Close,Access,Modify,Move] 56 [CloseWrite] -- [Open,Close,Access,Modify,Move]
44 utmp_file 57 utmp_file
45 utmp_event 58 utmp_event
46 print wd 59 print wd
60#endif
47 mtty <- monitorTTY on_chvt 61 mtty <- monitorTTY on_chvt
62 sock <- listenForXmppClients 5222 HNil
48 putStrLn "Hit enter to terminate..." 63 putStrLn "Hit enter to terminate..."
49 getLine 64 getLine
65 {-
66 let doException (SomeException e) = Prelude.putStrLn ("\n\nexception: " ++ show e ++ "\n\n")
67 handle doException $ do
68 -}
69 sClose sock
70 -- threadDelay 1000
71 putStrLn "closed listener."
50 unmonitorTTY mtty 72 unmonitorTTY mtty
73 putStrLn "unhooked tty monitor."
74#ifndef NOUTMP
51 removeWatch wd 75 removeWatch wd
76#endif
77 putStrLn "Normal termination."
52 78
53sendUSR1 pid = do 79sendUSR1 pid = do
54 signalProcess sigUSR1 pid 80 signalProcess sigUSR1 pid