summaryrefslogtreecommitdiff
path: root/xmppServer.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-03-16 14:04:14 -0400
committerjoe <joe@jerkface.net>2014-03-16 14:04:14 -0400
commitfe3087cc86552fdccac5b90d49d998611a493a45 (patch)
tree092c07e4754bed7013a4c0adb1db28ccba1d3cef /xmppServer.hs
parent0658b76ea0874d0ea789659effed102002486d01 (diff)
Deliver messages to X via notify-send.
Diffstat (limited to 'xmppServer.hs')
-rw-r--r--xmppServer.hs29
1 files changed, 17 insertions, 12 deletions
diff --git a/xmppServer.hs b/xmppServer.hs
index ef71380b..a406366a 100644
--- a/xmppServer.hs
+++ b/xmppServer.hs
@@ -434,16 +434,22 @@ deliverMessage state fail msg =
434 if not mine then fail else do 434 if not mine then fail else do
435 let to' = unsplitJID (n,h,r) 435 let to' = unsplitJID (n,h,r)
436 cmap <- atomically . readTVar $ clientsByUser state 436 cmap <- atomically . readTVar $ clientsByUser state
437 flip (maybe fail) n $ \n -> do 437 (from',chans,ks) <- do
438 flip (maybe fail) (Map.lookup n cmap) $ \presence_container -> do 438 flip (maybe $ return (Nothing,[],[])) n $ \n -> do
439 buds <- configText ConfigFiles.getBuddies n 439 buds <- configText ConfigFiles.getBuddies n
440 from' <- do 440 from' <- do
441 flip (maybe $ return Nothing) (stanzaFrom msg) $ \from -> do 441 flip (maybe $ return Nothing) (stanzaFrom msg) $ \from -> do
442 (_,trip) <- rewriteJIDForClient laddr from buds 442 (_,trip) <- rewriteJIDForClient laddr from buds
443 return . Just $ unsplitJID trip 443 return . Just $ unsplitJID trip
444 let ks = Map.keys (networkClients presence_container) 444 let nope = return (from',[],[])
445 chans = mapMaybe (flip Map.lookup key_to_chan) ks 445 flip (maybe nope) (Map.lookup n cmap) $ \presence_container -> do
446 if null chans then deliverToConsole state fail msg else do 446 let ks = Map.keys (networkClients presence_container)
447 chans = mapMaybe (flip Map.lookup key_to_chan) ks
448 return (from',chans,ks)
449 putStrLn $ "chan count: " ++ show (length chans)
450 let msg' = msg { stanzaTo=Just to'
451 , stanzaFrom=from' }
452 if null chans then deliverToConsole state fail msg' else do
447 forM_ chans $ \Conn { connChan=chan} -> do 453 forM_ chans $ \Conn { connChan=chan} -> do
448 putStrLn $ "sending "++show (stanzaId msg)++" to clients "++show ks 454 putStrLn $ "sending "++show (stanzaId msg)++" to clients "++show ks
449 -- TODO: Cloning isn't really neccessary unless there are multiple 455 -- TODO: Cloning isn't really neccessary unless there are multiple
@@ -452,8 +458,7 @@ deliverMessage state fail msg =
452 -- consumable stanzas and announcables use write-only broadcast 458 -- consumable stanzas and announcables use write-only broadcast
453 -- channels that must be cloned in order to be consumed. 459 -- channels that must be cloned in order to be consumed.
454 -- For now, we are doing redundant cloning. 460 -- For now, we are doing redundant cloning.
455 dup <- cloneStanza (msg { stanzaTo=Just to' 461 dup <- cloneStanza msg'
456 , stanzaFrom=from' })
457 sendModifiedStanzaToClient dup 462 sendModifiedStanzaToClient dup
458 chan 463 chan
459 464