diff options
author | joe <joe@jerkface.net> | 2013-06-17 16:19:15 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-06-17 16:19:15 -0400 |
commit | 7adaccbf993c602f09b2b9e7dea0360ac0dce93e (patch) | |
tree | 6c4b3aaa4c551ae8d8b897725d0cb5791836878c /Presence/main.hs | |
parent | 5982df9112b7e5fe7bcab62434771f1ca979e14d (diff) |
Switched UTmp.users to return ByteStrings instead of Strings.
Diffstat (limited to 'Presence/main.hs')
-rw-r--r-- | Presence/main.hs | 39 |
1 files changed, 27 insertions, 12 deletions
diff --git a/Presence/main.hs b/Presence/main.hs index d679fdba..f0bc39f5 100644 --- a/Presence/main.hs +++ b/Presence/main.hs | |||
@@ -1,6 +1,7 @@ | |||
1 | {-# LANGUAGE CPP #-} | 1 | {-# LANGUAGE CPP #-} |
2 | {-# LANGUAGE OverloadedStrings #-} | 2 | {-# LANGUAGE OverloadedStrings #-} |
3 | {-# LANGUAGE TypeFamilies #-} | 3 | {-# LANGUAGE TypeFamilies #-} |
4 | module Main where | ||
4 | 5 | ||
5 | import System.Directory | 6 | import System.Directory |
6 | import Control.Monad | 7 | import Control.Monad |
@@ -11,7 +12,15 @@ import Data.Maybe | |||
11 | 12 | ||
12 | import System.INotify | 13 | import System.INotify |
13 | #ifndef NOUTMP | 14 | #ifndef NOUTMP |
14 | import UTmp | 15 | import UTmp |
16 | -- Breaks profiling build with error: | ||
17 | -- Dynamic linking required, but this is a non-standard build (eg. prof). | ||
18 | -- You need to build the program twice: once the normal way, and then | ||
19 | -- in the desired way using -osuf to set the object file suffix. | ||
20 | -- | ||
21 | -- TODO: Figure out wtf ghc is trying to tell me. | ||
22 | -- In the mean time, use -DNOTMP to build for profiling. | ||
23 | -- | ||
15 | #endif | 24 | #endif |
16 | import FGConsole | 25 | import FGConsole |
17 | import XMPPServer | 26 | import XMPPServer |
@@ -22,25 +31,28 @@ import LocalPeerCred | |||
22 | import ByteStringOperators | 31 | import ByteStringOperators |
23 | import qualified Data.ByteString.Lazy.Char8 as L | 32 | import qualified Data.ByteString.Lazy.Char8 as L |
24 | import System.Posix.User | 33 | import System.Posix.User |
34 | import qualified Data.Set as Set | ||
35 | import Data.Set (Set) | ||
25 | 36 | ||
26 | 37 | ||
27 | jid user host rsrc = user ++ "@" ++ host ++ "/" ++ rsrc | 38 | jid user host rsrc = user <++> "@" <++> host <++> "/" <++> rsrc |
28 | 39 | ||
29 | toJabberId :: String -> (String,String,t) -> Maybe String | ||
30 | toJabberId host (user,tty,_) = | 40 | toJabberId host (user,tty,_) = |
31 | if take 3 tty == "tty" | 41 | if L.take 3 tty == "tty" |
32 | then Just (jid user host tty) | 42 | then Just (jid user host tty) |
33 | else Nothing | 43 | else Nothing |
34 | 44 | ||
35 | #ifndef NOUTMP | 45 | track_login :: IORef (Set L.ByteString) -> t -> IO () |
36 | utmp_event e = do | 46 | track_login tracked e = do |
37 | -- print e | 47 | -- print e |
38 | putStrLn "---" | 48 | putStrLn "---" |
49 | #ifndef NOUTMP | ||
39 | us <- users | 50 | us <- users |
40 | let ids = mapMaybe (toJabberId "localhost") us | 51 | #else |
41 | ids :: [String] | 52 | let us = [] |
42 | forM_ ids putStrLn | ||
43 | #endif | 53 | #endif |
54 | let ids = mapMaybe (toJabberId "localhost") us | ||
55 | forM_ ids L.putStrLn | ||
44 | 56 | ||
45 | data UnixSession = UnixSession { | 57 | data UnixSession = UnixSession { |
46 | unix_uid :: (IORef (Maybe UserID)), | 58 | unix_uid :: (IORef (Maybe UserID)), |
@@ -82,10 +94,13 @@ on_chvt vtnum = do | |||
82 | 94 | ||
83 | start :: IO () | 95 | start :: IO () |
84 | start = do | 96 | start = do |
97 | tracked <- newIORef Set.empty | ||
98 | let dologin e = track_login tracked e | ||
99 | dologin :: t -> IO () | ||
85 | #ifndef NOUTMP | 100 | #ifndef NOUTMP |
86 | installHandler sigUSR1 (Catch (utmp_event (userError "signaled"))) Nothing | 101 | installHandler sigUSR1 (Catch (dologin (userError "signaled"))) Nothing |
87 | #endif | 102 | #endif |
88 | -- installHandler sigTERM (CatchOnce (utmp_event (userError "term signaled"))) Nothing | 103 | -- installHandler sigTERM (CatchOnce (dologin (userError "term signaled"))) Nothing |
89 | inotify <- initINotify | 104 | inotify <- initINotify |
90 | print inotify | 105 | print inotify |
91 | #ifndef NOUTMP | 106 | #ifndef NOUTMP |
@@ -93,7 +108,7 @@ start = do | |||
93 | inotify | 108 | inotify |
94 | [CloseWrite] -- [Open,Close,Access,Modify,Move] | 109 | [CloseWrite] -- [Open,Close,Access,Modify,Move] |
95 | utmp_file | 110 | utmp_file |
96 | utmp_event | 111 | dologin |
97 | print wd | 112 | print wd |
98 | #endif | 113 | #endif |
99 | mtty <- monitorTTY on_chvt | 114 | mtty <- monitorTTY on_chvt |