It sends tox-messages to pidgin!

3 files changed, 58 insertions, 33 deletions

diff --git a/Presence/ConfigFiles.hs b/Presence/ConfigFiles.hs
index 5682ea94..46d5a01c 100644
--- a/Presence/ConfigFiles.hs
+++ b/Presence/ConfigFiles.hs
@@ -16,6 +16,8 @@ import ByteStringOperators () -- For NFData instance
 import Data.List (partition)
 import Data.Maybe (catMaybes,isJust)
 
+import DPut
+
 type User = ByteString
 type Profile = String
 
@@ -36,9 +38,15 @@ configPath :: User -> Profile -> String -> IO String
 configPath user "." filename = do
     ue <- getUserEntryForName (unpack user)
     return $ (++("/"++configDir++"/"++filename)) $ homeDirectory ue
+ `catchIOError` \e -> do
+    dput XJabber $ "configPath " ++ show user ++ "\".\": " ++ show e
+    return $ (++("/"++configDir++"/"++filename)) $ "/tmp"
 configPath user profile filename = do
     ue <- getUserEntryForName (unpack user)
     return $ (++("/"++configDir++"/"++profile++"/"++filename)) $ homeDirectory ue
+ `catchIOError` \e -> do
+    dput XJabber $ "configPath " ++ show user ++ " " ++ show profile ++ ": " ++ show e
+    return $ (++("/"++configDir++"/"++filename)) $ "/tmp"
 
 createConfigFile :: ByteString -> FilePath -> IO ()
 createConfigFile tag path = do
diff --git a/Presence/ConsoleWriter.hs b/Presence/ConsoleWriter.hs
index 6b611e68..7c377d83 100644
--- a/Presence/ConsoleWriter.hs
+++ b/Presence/ConsoleWriter.hs
@@ -23,6 +23,7 @@ import System.Posix.Process ( forkProcess, exitImmediately, executeFile )
 import System.Posix.User  ( setUserID, getUserEntryForName, userID )
 import System.Posix.Files ( getFileStatus, fileMode )
 import System.INotify ( initINotify, EventVariety(Modify), addWatch )
+import System.IO.Error
 import Data.Word      ( Word8 )
 import Data.Text      ( Text )
 import Data.Map       ( Map )
@@ -34,6 +35,7 @@ import qualified Data.Text as Text
 -- import qualified Data.Text.IO as Text
 import qualified Network.BSD as BSD
 
+import DPut
 import UTmp           ( users2, utmp_file, UtmpRecord(..), UT_Type(..) )
 import FGConsole      ( forkTTYMonitor )
 import XMPPServer     ( Stanza, makePresenceStanza, JabberShow(..), stanzaType
@@ -256,14 +258,19 @@ deliverGUIMessage cw tty utmp msg = do
                 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]
-        executeFile "/usr/bin/notify-send" False [text] (Just [("DISPLAY",display)])
-        exitImmediately ExitSuccess
+    muentry <- fmap Just (getUserEntryForName (Text.unpack $ utmpUser utmp))
+                `catchIOError` \e -> do
+                    dput XJabber $ "deliverGUIMessage(getUserEntryForName "++show (utmpUser utmp)++"): "++show e
+                    return Nothing
+    forM_ muentry $ \uentry -> do
+        let display = Text.unpack $ utmpHost utmp
+        pid <- forkProcess $ do
+            setUserID (userID uentry)
+            setEnv "DISPLAY" display True
+            -- rawSystem "/usr/bin/notify-send" [text]
+            executeFile "/usr/bin/notify-send" False [text] (Just [("DISPLAY",display)])
+            exitImmediately ExitSuccess
+        return ()
     return True
 
 crlf :: Text -> Text
diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index daa93716..697c1476 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -99,8 +99,8 @@ data ToxManager k = ToxManager
 
 data PresenceState = forall status. PresenceState
     { clients         :: TVar (Map ConnectionKey ClientState)
-    , clientsByUser   :: TVar (Map Text LocalPresence) -- TODO: For tox-enabled clients, the lookup key should be the client's toxid
-                                                       --       rather than the unix user.
+    , clientsByUser   :: TVar (Map Text LocalPresence)
+    , clientsByProfile :: TVar (Map Text LocalPresence)
     , remotesByPeer   :: TVar (Map ConnectionKey
                                    (Map UserName RemotePresence))
     , server          :: TMVar (XMPPServer, Connection.Manager status Text)
@@ -115,18 +115,20 @@ newPresenceState :: Maybe ConsoleWriter
                  -> TMVar (XMPPServer, Connection.Manager status Text)
                  -> IO PresenceState
 newPresenceState cw toxman xmpp = atomically $ do
-        clients <- newTVar Map.empty
-        clientsByUser <- newTVar Map.empty
-        remotesByPeer <- newTVar Map.empty
-        keyToChan <- newTVar Map.empty
+        clients          <- newTVar Map.empty
+        clientsByUser    <- newTVar Map.empty
+        clientsByProfile <- newTVar Map.empty
+        remotesByPeer    <- newTVar Map.empty
+        keyToChan        <- newTVar Map.empty
         let st = PresenceState
-                    { clients       = clients
-                    , clientsByUser = clientsByUser
-                    , remotesByPeer = remotesByPeer
-                    , keyToChan     = keyToChan
-                    , server        = xmpp
-                    , consoleWriter = cw
-                    , toxManager    = Nothing
+                    { clients          = clients
+                    , clientsByUser    = clientsByUser
+                    , clientsByProfile = clientsByProfile
+                    , remotesByPeer    = remotesByPeer
+                    , keyToChan        = keyToChan
+                    , server           = xmpp
+                    , consoleWriter    = cw
+                    , toxManager       = Nothing
                     }
         return $ st { toxManager = fmap ($ st) toxman }
 
@@ -277,10 +279,11 @@ chooseResourceName state k addr clientsNameForMe desired = do
 
     atomically $ do
         modifyTVar' (clients state) $ Map.insert k client
-        modifyTVar' (clientsByUser state) $ flip Map.alter (clientUser client)
-            $ \mb -> Just $ maybe (pcSingletonNetworkClient k client)
+        let add mb = Just $ maybe (pcSingletonNetworkClient k client)
                                   (pcInsertNetworkClient k client)
                                   mb
+        modifyTVar' (clientsByUser    state) $ Map.alter add (clientUser client)
+        modifyTVar' (clientsByProfile state) $ Map.alter add (clientProfile client)
 
     localJID (clientUser client) (clientProfile client) (clientResource client)
 
@@ -477,8 +480,8 @@ eofConn state k = do
             stanza <- makePresenceStanza "jabber:server" Nothing Offline
             informClientPresence state k stanza
             atomically $ do
-                modifyTVar' (clientsByUser state)
-                    $ Map.alter (delclient k) (clientUser client)
+                modifyTVar' (clientsByUser    state) $ Map.alter (delclient k) (clientUser    client)
+                modifyTVar' (clientsByProfile state) $ Map.alter (delclient k) (clientProfile client)
         PeerKey {} -> do
             let h = peerKeyToText k
             jids <- atomically $ do
@@ -600,24 +603,31 @@ deliverMessage state fail msg =
         (mine,(n,h,r)) <- rewriteJIDForClient laddr to []
         if not mine then fail else do
         let to' = unsplitJID (n,h,r)
-        cmap <- atomically . readTVar $ clientsByUser state
+        let (cmapVar,ckey) = case ctyp of
+                Tox  -> (clientsByProfile state , n <&> (<> ".tox") )
+                XMPP -> (clientsByUser    state , n                 )
+        cmap <- atomically . readTVar $ cmapVar
         chans <- fmap (fromMaybe []) $ do
-            -- TODO: Tox-enabled clients need to be found by tox key.
-            forM (n >>= flip Map.lookup cmap) $ \presence_container -> do
+            forM (ckey >>= flip Map.lookup cmap) $ \presence_container -> do
             let ks = Map.keys (networkClients presence_container)
                 chans = do
                     (k,client) <- Map.toList $ networkClients presence_container
                     chan <- maybeToList $ Map.lookup k key_to_chan
-                    return (clientProfile client, chan)
-            forM chans $ \(profile,chan) -> do
-            buds <- configText ConfigFiles.getBuddies (fromJust n) profile
-            from' <- do
+                    return (clientProfile client, clientUser client, chan)
+            forM chans $ \(profile,user,chan) -> do
+            buds <- configText ConfigFiles.getBuddies user profile
+            from' <- case ctyp of
+              Tox  -> return $ stanzaFrom msg
+              XMPP -> do
                 forM (stanzaFrom msg) $ \from -> do
                 (_,trip) <- rewriteJIDForClient laddr from buds
                 return $ unsplitJID trip
+            to' <- case ctyp of
+                XMPP -> return $ stanzaTo msg
+                Tox  -> return $ Just $ unsplitJID (Just user, profile, Nothing)
             return (from',chan)
         putStrLn $ "chan count: " ++ show (length chans)
-        if null chans then do
+        if null chans then when (ctyp == XMPP) $ do
             forM_ (stanzaFrom msg) $ \from -> do
             from' <- do
                 -- Fallback to "." profile when no clients.