summaryrefslogtreecommitdiff
path: root/Presence/main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/main.hs')
-rw-r--r--Presence/main.hs98
1 files changed, 68 insertions, 30 deletions
diff --git a/Presence/main.hs b/Presence/main.hs
index 8c2371f4..cfc7154c 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -57,6 +57,74 @@ import Network.Socket (Family(AF_INET,AF_INET6))
57import Holumbus.Data.MultiMap as MM (MultiMap) 57import Holumbus.Data.MultiMap as MM (MultiMap)
58import qualified Holumbus.Data.MultiMap as MM 58import qualified Holumbus.Data.MultiMap as MM
59 59
60{- PresenceState
61 -
62 - This is the global state for the xmpp daemon.
63 - It is not directly accessed outside of this module.
64 -}
65data PresenceState = PresenceState
66 { hostname :: Peer -- ByteString, TODO: remove this, its always LocalHost now
67
68 -- currentTTY - a string such as "tty7" which is kept up to date as console
69 -- switches occur.
70 , currentTTY :: TVar ByteString
71
72 -- activeUsers - a is a set of triples representing data in /var/run/utmp
73 -- it is kept up to date by an inotify watch on that file.
74 , activeUsers :: TVar (Set (UserName, Tty, ProcessID))
75
76 -- subscriberMap - the idea was to allow subscribing to a particular user only.
77 -- When that user becomes present, an announcement would be sent
78 -- on the channel associated with him. This functionality is currently
79 -- unused and may be removed soon if it's decided its unneccessary.
80 , subscriberMap :: TVar (Map JID (RefCount,TChan Presence)) -- UNUSED as yet
81
82 -- localSubscriber - a channel and reference count where all presence events are
83 -- announced.
84 , localSubscriber :: TMVar (RefCount,TChan Presence) -- TODO: rename this, its not just locals
85 -- ... or make a seperate channel for remotes
86
87 -- rosterChannel - a channel and reference count where all roster change events are
88 -- announced
89 , rosterChannel :: TMVar (RefCount,TChan RosterEvent)
90
91
92 -- remoteUsers - a cache of remote users considered to be online. These are sent to a client
93 -- on connect so that it can populate it's notion of online users.
94 , remoteUsers :: TVar (Map Peer (RefCount,TVar (MultiMap JabberUser (JabberResource,JabberShow))))
95
96 -- outGoingConnections - a set of channels that may be used to send messages to remote peers.
97 , outGoingConnections :: TVar (Map Peer (TChan OutBoundMessage, ThreadId))
98 }
99
100
101
102
103{- newPresenceState
104 -
105 - This is a smart constructor for the global state.
106 - This is currently used only from Main.start and PresenceState
107 - records are not created by any means other than this constructor.
108 -}
109newPresenceState hostname = atomically $ do
110 tty <- newTVar ""
111 us <- newTVar (Set.empty)
112 subs <- newTVar (Map.empty)
113 locals_greedy <- newEmptyTMVar
114 rchan <- newEmptyTMVar
115 remotes <- newTVar (Map.empty)
116 server_connections <- newServerConnections
117 return $ PresenceState hostname tty us subs locals_greedy rchan remotes server_connections
118
119
120data ClientSession = ClientSession {
121 localhost :: Peer, -- ByteString,
122 unix_uid :: (IORef (Maybe (UserID,L.ByteString))),
123 unix_resource :: (IORef (Maybe L.ByteString)),
124 chans :: TVar [RefCountedChan],
125 presence_state :: PresenceState
126}
127
60type RefCount = Int 128type RefCount = Int
61 129
62type JabberResource = L.ByteString 130type JabberResource = L.ByteString
@@ -70,18 +138,6 @@ splitResource (JID (Just n) p r ) = Just (JabberUser n p, r)
70 138
71unsplitResource (JabberUser n p) r = JID (Just n) p r 139unsplitResource (JabberUser n p) r = JID (Just n) p r
72 140
73data PresenceState = PresenceState
74 { hostname :: Peer -- ByteString, TODO: remove this, its always LocalHost now
75 , currentTTY :: TVar ByteString
76 , activeUsers :: TVar (Set (UserName, Tty, ProcessID))
77 , subscriberMap :: TVar (Map JID (RefCount,TChan Presence)) -- UNUSED as yet
78 , localSubscriber :: TMVar (RefCount,TChan Presence) -- TODO: rename this, its not just locals
79 -- ... or make a seperate channel for remotes
80 , rosterChannel :: TMVar (RefCount,TChan RosterEvent)
81 , remoteUsers :: TVar (Map Peer (RefCount,TVar (MultiMap JabberUser (JabberResource,JabberShow))))
82 , outGoingConnections :: TVar (Map Peer (TChan OutBoundMessage, ThreadId))
83 }
84
85 141
86rosterPush msg state = do 142rosterPush msg state = do
87 let rchan = rosterChannel state 143 let rchan = rosterChannel state
@@ -102,14 +158,6 @@ getJabberUserForId muid =
102 ) 158 )
103 muid 159 muid
104 160
105data ClientSession = ClientSession {
106 localhost :: Peer, -- ByteString,
107 unix_uid :: (IORef (Maybe (UserID,L.ByteString))),
108 unix_resource :: (IORef (Maybe L.ByteString)),
109 chans :: TVar [RefCountedChan],
110 presence_state :: PresenceState
111}
112
113cmpJID newitem jid = do 161cmpJID newitem jid = do
114 -- putStrLn $ "Comparing "<++>bshow jid 162 -- putStrLn $ "Comparing "<++>bshow jid
115 olditem <- parseHostNameJID jid 163 olditem <- parseHostNameJID jid
@@ -513,16 +561,6 @@ update_presence locals_greedy subscribers state getStatus =
513 sendPresence chan jid status 561 sendPresence chan jid status
514 putStrLn $ bshow jid <++> " " <++> bshow status 562 putStrLn $ bshow jid <++> " " <++> bshow status
515 563
516newPresenceState hostname = atomically $ do
517 tty <- newTVar ""
518 us <- newTVar (Set.empty)
519 subs <- newTVar (Map.empty)
520 locals_greedy <- newEmptyTMVar
521 rchan <- newEmptyTMVar
522 remotes <- newTVar (Map.empty)
523 server_connections <- newServerConnections
524 return $ PresenceState hostname tty us subs locals_greedy rchan remotes server_connections
525
526sendProbes state jid = do 564sendProbes state jid = do
527 L.putStrLn $ "sending probes for " <++> bshow jid 565 L.putStrLn $ "sending probes for " <++> bshow jid
528 withJust (name jid) $ \user -> do 566 withJust (name jid) $ \user -> do