summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/DNSCache.hs5
-rw-r--r--Presence/Presence.hs9
-rw-r--r--Presence/XMPPServer.hs6
3 files changed, 11 insertions, 9 deletions
diff --git a/Presence/DNSCache.hs b/Presence/DNSCache.hs
index aaf1a7be..afcc227c 100644
--- a/Presence/DNSCache.hs
+++ b/Presence/DNSCache.hs
@@ -50,6 +50,7 @@ import SockAddr ()
50import ControlMaybe ( handleIO_ ) 50import ControlMaybe ( handleIO_ )
51import GetHostByAddr ( getHostByAddr ) 51import GetHostByAddr ( getHostByAddr )
52import InterruptibleDelay 52import InterruptibleDelay
53import DPut
53 54
54type TimeStamp = UTCTime 55type TimeStamp = UTCTime
55 56
@@ -106,7 +107,7 @@ make6mapped4 addr@(SockAddrInet port a) = SockAddrInet6 port 0 (0,0,0xFFFF,fromB
106 107
107tryForkOS :: IO () -> IO ThreadId 108tryForkOS :: IO () -> IO ThreadId
108tryForkOS action = catchIOError (forkOS action) $ \e -> do 109tryForkOS action = catchIOError (forkOS action) $ \e -> do
109 hPutStrLn stderr $ "DNSCache: Link with -threaded to avoid excessively long time-out." 110 dput XMisc $ "DNSCache: Link with -threaded to avoid excessively long time-out."
110 forkIO action 111 forkIO action
111 112
112 113
@@ -152,7 +153,7 @@ strip_brackets s =
152 153
153reportTimeout :: forall a. Show a => a -> IO () 154reportTimeout :: forall a. Show a => a -> IO ()
154reportTimeout addrtext = do 155reportTimeout addrtext = do
155 hPutStrLn stderr $ "timeout resolving: "++show addrtext 156 dput XMisc $ "timeout resolving: "++show addrtext
156 -- killThread rt 157 -- killThread rt
157 158
158unmap6mapped4 :: SockAddr -> SockAddr 159unmap6mapped4 :: SockAddr -> SockAddr
diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 2f59a52f..18bde516 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -62,6 +62,7 @@ import Util
62import qualified Connection 62import qualified Connection
63import Network.Tox.NodeId (id2key,key2id) 63import Network.Tox.NodeId (id2key,key2id)
64import Crypto.Tox (decodeSecret) 64import Crypto.Tox (decodeSecret)
65import DPut
65 66
66isPeerKey :: ConnectionKey -> Bool 67isPeerKey :: ConnectionKey -> Bool
67isPeerKey k = case k of { PeerKey {} -> True ; _ -> False } 68isPeerKey k = case k of { PeerKey {} -> True ; _ -> False }
@@ -239,23 +240,23 @@ chooseResourceName state k addr clientsNameForMe desired = do
239#endif 240#endif
240 cfs <- map Text.pack <$> listDirectory cdir `catchIOError` (\e -> return []) 241 cfs <- map Text.pack <$> listDirectory cdir `catchIOError` (\e -> return [])
241 let profiles = filter (\f -> Text.toLower f == Text.toLower wanted_profile0) cfs 242 let profiles = filter (\f -> Text.toLower f == Text.toLower wanted_profile0) cfs
242 -- hPutStrLn stderr $ "Toxmpp profile " ++ show (user,wanted_profile0,profiles,cfs) 243 -- dput XMisc $ "Toxmpp profile " ++ show (user,wanted_profile0,profiles,cfs)
243 let wanted_profile = head $ profiles ++ [wanted_profile0] 244 let wanted_profile = head $ profiles ++ [wanted_profile0]
244 secs <- configText ConfigFiles.getSecrets user wanted_profile 245 secs <- configText ConfigFiles.getSecrets user wanted_profile
245 case secs of 246 case secs of
246 sec:_ | Just s <- decodeSecret (Text.encodeUtf8 sec) 247 sec:_ | Just s <- decodeSecret (Text.encodeUtf8 sec)
247 , map toLower (show $ key2id $ toPublic s) == map toLower (Text.unpack pub) 248 , map toLower (show $ key2id $ toPublic s) == map toLower (Text.unpack pub)
248 -> do activateAccount toxman k wanted_profile s 249 -> do activateAccount toxman k wanted_profile s
249 hPutStrLn stderr $ "loaded tox secret " ++ show sec 250 dput XMisc $ "loaded tox secret " ++ show sec
250 return wanted_profile 251 return wanted_profile
251 _ -> do 252 _ -> do
252 -- XXX: We should probably fail to connect when an 253 -- XXX: We should probably fail to connect when an
253 -- invalid Tox profile is used. For now, we'll 254 -- invalid Tox profile is used. For now, we'll
254 -- fall back to the Unix account login. 255 -- fall back to the Unix account login.
255 hPutStrLn stderr "failed to find tox secret" 256 dput XMisc "failed to find tox secret"
256 return "." 257 return "."
257 ("*.tox","") -> do 258 ("*.tox","") -> do
258 hPutStrLn stderr $ "TODO: Match single tox key profile or generate first." 259 dput XMisc $ "TODO: Match single tox key profile or generate first."
259 -- TODO: Match single tox key profile or generate first. 260 -- TODO: Match single tox key profile or generate first.
260 _todo 261 _todo
261 _ -> return "." 262 _ -> return "."
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 936b2137..c73146fd 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -926,7 +926,7 @@ xmppInbound sv xmpp k laddr pingflag stanzas output donevar = doNestingXML $ do
926 when (begindoc==EventBeginDocument) $ do 926 when (begindoc==EventBeginDocument) $ do
927 whenJust nextElement $ \xml -> do 927 whenJust nextElement $ \xml -> do
928 withJust (elementAttrs "stream" xml) $ \stream_attrs -> do 928 withJust (elementAttrs "stream" xml) $ \stream_attrs -> do
929 -- liftIO $ hPutStrLn stderr $ "STREAM ATTRS "++show stream_attrs 929 -- liftIO $ dput XMisc $ "STREAM ATTRS "++show stream_attrs
930 let stream_name = lookupAttrib "to" stream_attrs 930 let stream_name = lookupAttrib "to" stream_attrs
931 -- xmpp_version = lookupAttrib "version" stream_attrs 931 -- xmpp_version = lookupAttrib "version" stream_attrs
932 fix $ \loop -> do 932 fix $ \loop -> do
@@ -1866,10 +1866,10 @@ xmppServer allocate xmpp = do
1866 forkIO $ do 1866 forkIO $ do
1867 myThreadId >>= flip labelThread ("XMPP.monitor") 1867 myThreadId >>= flip labelThread ("XMPP.monitor")
1868 monitor sv peer_params xmpp 1868 monitor sv peer_params xmpp
1869 hPutStrLn stderr $ "Starting peer listen" 1869 dput XMisc $ "Starting peer listen"
1870 peer_bind <- maybe (getBindAddress "5269" True) return $ xmppPeerBind xmpp 1870 peer_bind <- maybe (getBindAddress "5269" True) return $ xmppPeerBind xmpp
1871 control sv (Listen peer_bind peer_params) 1871 control sv (Listen peer_bind peer_params)
1872 hPutStrLn stderr $ "Starting client listen" 1872 dput XMisc $ "Starting client listen"
1873 client_bind <- maybe (getBindAddress "5222" True) return $ xmppClientBind xmpp 1873 client_bind <- maybe (getBindAddress "5222" True) return $ xmppClientBind xmpp
1874 control sv (Listen client_bind client_params) 1874 control sv (Listen client_bind client_params)
1875 return XMPPServer { _xmpp_sv = sv, _xmpp_peer_params = peer_params } 1875 return XMPPServer { _xmpp_sv = sv, _xmpp_peer_params = peer_params }