diff options
author | joe <joe@jerkface.net> | 2014-03-16 14:04:14 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-03-16 14:04:14 -0400 |
commit | fe3087cc86552fdccac5b90d49d998611a493a45 (patch) | |
tree | 092c07e4754bed7013a4c0adb1db28ccba1d3cef /xmppServer.hs | |
parent | 0658b76ea0874d0ea789659effed102002486d01 (diff) |
Deliver messages to X via notify-send.
Diffstat (limited to 'xmppServer.hs')
-rw-r--r-- | xmppServer.hs | 29 |
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 | ||