diff options
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/DNSCache.hs | 5 | ||||
-rw-r--r-- | Presence/Presence.hs | 9 | ||||
-rw-r--r-- | Presence/XMPPServer.hs | 6 |
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 () | |||
50 | import ControlMaybe ( handleIO_ ) | 50 | import ControlMaybe ( handleIO_ ) |
51 | import GetHostByAddr ( getHostByAddr ) | 51 | import GetHostByAddr ( getHostByAddr ) |
52 | import InterruptibleDelay | 52 | import InterruptibleDelay |
53 | import DPut | ||
53 | 54 | ||
54 | type TimeStamp = UTCTime | 55 | type TimeStamp = UTCTime |
55 | 56 | ||
@@ -106,7 +107,7 @@ make6mapped4 addr@(SockAddrInet port a) = SockAddrInet6 port 0 (0,0,0xFFFF,fromB | |||
106 | 107 | ||
107 | tryForkOS :: IO () -> IO ThreadId | 108 | tryForkOS :: IO () -> IO ThreadId |
108 | tryForkOS action = catchIOError (forkOS action) $ \e -> do | 109 | tryForkOS 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 | ||
153 | reportTimeout :: forall a. Show a => a -> IO () | 154 | reportTimeout :: forall a. Show a => a -> IO () |
154 | reportTimeout addrtext = do | 155 | reportTimeout addrtext = do |
155 | hPutStrLn stderr $ "timeout resolving: "++show addrtext | 156 | dput XMisc $ "timeout resolving: "++show addrtext |
156 | -- killThread rt | 157 | -- killThread rt |
157 | 158 | ||
158 | unmap6mapped4 :: SockAddr -> SockAddr | 159 | unmap6mapped4 :: 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 | |||
62 | import qualified Connection | 62 | import qualified Connection |
63 | import Network.Tox.NodeId (id2key,key2id) | 63 | import Network.Tox.NodeId (id2key,key2id) |
64 | import Crypto.Tox (decodeSecret) | 64 | import Crypto.Tox (decodeSecret) |
65 | import DPut | ||
65 | 66 | ||
66 | isPeerKey :: ConnectionKey -> Bool | 67 | isPeerKey :: ConnectionKey -> Bool |
67 | isPeerKey k = case k of { PeerKey {} -> True ; _ -> False } | 68 | isPeerKey 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 } |