Deliver messages to X via notify-send.

1 files changed, 24 insertions, 4 deletions

diff --git a/Presence/ConsoleWriter.hs b/Presence/ConsoleWriter.hs
index 2024131b..d75dfec0 100644
--- a/Presence/ConsoleWriter.hs
+++ b/Presence/ConsoleWriter.hs
@@ -16,6 +16,11 @@ import Data.Monoid
 import Data.Char
 import Data.Maybe
 import System.Environment
+import System.Process ( rawSystem )
+import System.Exit ( ExitCode(ExitSuccess) )
+import System.Posix.Env     ( setEnv )
+import System.Posix.Process ( forkProcess, exitImmediately )
+import System.Posix.User  ( setUserID, getUserEntryForName, userID )
 import System.Posix.Files ( getFileStatus, fileMode )
 import System.INotify ( initINotify, EventVariety(Modify), addWatch )
 import Data.Word      ( Word8 )
@@ -32,7 +37,8 @@ import qualified Network.BSD as BSD
 import UTmp           ( users2, utmp_file, UtmpRecord(..), UT_Type(..) )
 import FGConsole      ( monitorTTY )
 import XMPPServer     ( Stanza, makePresenceStanza, JabberShow(..), stanzaType
-                      , LangSpecificMessage(..), msgLangMap, cloneStanza )
+                      , LangSpecificMessage(..), msgLangMap, cloneStanza, stanzaFrom )
+import ControlMaybe   ( handleIO_ )
 import ClientState
 
 data ConsoleWriter = ConsoleWriter
@@ -197,6 +203,7 @@ readEnvFile var file = fmap parse $ readFile file
 
 writeActiveTTY :: ConsoleWriter -> Stanza -> IO Bool
 writeActiveTTY cw msg = do
+    putStrLn $ "writeActiveTTY"
     (tty, mbu) <- atomically $ do
                 num <- readTVar $ csActiveTTY cw
                 utmp <- readTVar $ csUtmp cw
@@ -212,9 +219,22 @@ writeActiveTTY cw msg = do
         _ -> deliverTerminalMessage cw tty utmp msg
 
 deliverGUIMessage cw tty utmp msg = do
-    -- TODO: deliver to active x (notify-send of libnotify package)
-    --         chpst seems neccessary for notify-send to work
-    return False
+    text <- do
+        t <- messageText msg
+        return $ Text.unpack
+            $ case stanzaFrom msg of
+                Just from -> from <> ": " <> t
+                Nothing -> t
+    putStrLn $ "deliverGUI: " ++ text
+    handleIO_ (return False) $ do
+    uentry <- getUserEntryForName (Text.unpack $ utmpUser utmp)
+    let display = Text.unpack $ utmpHost utmp
+    pid <- forkProcess $ do
+        setUserID (userID uentry)
+        setEnv "DISPLAY" display True
+        rawSystem "/usr/bin/notify-send" [text]
+        exitImmediately ExitSuccess
+    return True
 
 deliverTerminalMessage cw tty utmp msg = do
     mode <- fmap fileMode (getFileStatus $ Text.unpack tty)