From aebcf4e527063a10f4b22ed476766926a45d4f50 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Fri, 24 Jan 2020 10:27:14 +0000 Subject: Catch exceptions on no avahi dbus service. --- dht/dht-client.cabal | 1 + dht/src/DebugTag.hs | 1 + dht/src/Network/Tox.hs | 14 ++++++++++++-- 3 files changed, 14 insertions(+), 2 deletions(-) diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal index 79a72c05..e56d67f4 100644 --- a/dht/dht-client.cabal +++ b/dht/dht-client.cabal @@ -158,6 +158,7 @@ library build-depends: base , containers , constraints + , dbus , dependent-map , array , hashable diff --git a/dht/src/DebugTag.hs b/dht/src/DebugTag.hs index 93b5b74f..37593e63 100644 --- a/dht/src/DebugTag.hs +++ b/dht/src/DebugTag.hs @@ -7,6 +7,7 @@ data DebugTag = XAnnounce | XAnnounceResponse | XBitTorrent + | XDBus | XLan | XMan | XNetCrypto diff --git a/dht/src/Network/Tox.hs b/dht/src/Network/Tox.hs index 1628b435..e0704f6f 100644 --- a/dht/src/Network/Tox.hs +++ b/dht/src/Network/Tox.hs @@ -88,6 +88,8 @@ import Network.SessionTransports import Network.Kademlia.Search import HandshakeCache import Data.ByteString.Base16 as Base16 +import qualified DBus.Client as DBus +import Control.Exception updateIP :: TVar (R.BucketList NodeInfo) -> SockAddr -> STM () updateIP tblvar a = do @@ -446,6 +448,12 @@ dnssdDiscover tox ni toxid = do void $ DHT.pingUDP (toxDHT tox) ni +-- | Log a dbus error +putDBusError bFatal msg = do + let fatality = if bFatal then "Fatal" else "Non-Fatal" + prefix = fatality <> " DBus Exception: " + dput XDBus (prefix <> msg) + -- | Returns: -- -- * action to shutdown this node, terminating all threads. @@ -469,8 +477,10 @@ forkTox tox with_avahi with_tcp = do refresher4 <- forkPollForRefresh (DHT.refresher4 $ toxRouting tox) refresher6 <- forkPollForRefresh (DHT.refresher6 $ toxRouting tox) quitAvahi <- if with_avahi then do - dnssdIn <- forkIO $ queryToxService (dnssdDiscover tox) - dnssdOut <- forkIO $ dnssdAnnounce tox + dnssdIn <- forkIO (queryToxService (dnssdDiscover tox) + `catch` \(e::DBus.ClientError) -> putDBusError (DBus.clientErrorFatal e) (DBus.clientErrorMessage e)) + dnssdOut <- forkIO ( dnssdAnnounce tox + `catch` \(e::DBus.ClientError) -> putDBusError (DBus.clientErrorFatal e) (DBus.clientErrorMessage e)) labelThread dnssdIn "tox-avahi-monitor" labelThread dnssdOut "tox-avahi-publish" return $ forM_ [dnssdIn,dnssdOut] killThread -- cgit v1.2.3