More DPut stuff

        * verbose/quiet without args shows report
        * verbose all - sets all tags verbose
        * quiet all - sets all tags quiet
        * XMisc defaults to verbose, everything else quiet
        * new XMan tag for ToxManager related stuff
        * s/hputStrLn stderr/dput XMisc/ in daemon code

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      ()
 import ControlMaybe  ( handleIO_ )
 import GetHostByAddr ( getHostByAddr )
 import InterruptibleDelay
+import DPut
 
 type TimeStamp = UTCTime
 
@@ -106,7 +107,7 @@ make6mapped4 addr@(SockAddrInet port a) = SockAddrInet6 port 0 (0,0,0xFFFF,fromB
 
 tryForkOS :: IO () -> IO ThreadId
 tryForkOS action = catchIOError (forkOS action) $ \e -> do
-    hPutStrLn stderr $ "DNSCache: Link with -threaded to avoid excessively long time-out."
+    dput XMisc $ "DNSCache: Link with -threaded to avoid excessively long time-out."
     forkIO action
 
 
@@ -152,7 +153,7 @@ strip_brackets s =
 
 reportTimeout :: forall a. Show a => a -> IO ()
 reportTimeout addrtext = do
-      hPutStrLn stderr $ "timeout resolving: "++show addrtext
+      dput XMisc $ "timeout resolving: "++show addrtext
       -- killThread rt
 
 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
 import qualified Connection
 import Network.Tox.NodeId (id2key,key2id)
 import Crypto.Tox (decodeSecret)
+import DPut
 
 isPeerKey :: ConnectionKey -> Bool
 isPeerKey k = case k of { PeerKey {} -> True ; _ -> False }
@@ -239,23 +240,23 @@ chooseResourceName state k addr clientsNameForMe desired = do
 #endif
                 cfs  <- map Text.pack <$> listDirectory cdir `catchIOError` (\e -> return [])
                 let profiles = filter (\f -> Text.toLower f == Text.toLower wanted_profile0) cfs
-                -- hPutStrLn stderr $ "Toxmpp profile " ++ show (user,wanted_profile0,profiles,cfs)
+                -- dput XMisc $ "Toxmpp profile " ++ show (user,wanted_profile0,profiles,cfs)
                 let wanted_profile = head $ profiles ++ [wanted_profile0]
                 secs <- configText ConfigFiles.getSecrets user wanted_profile
                 case secs of
                     sec:_ | Just s <- decodeSecret (Text.encodeUtf8 sec)
                           , map toLower (show $ key2id $ toPublic s) == map toLower (Text.unpack pub)
                           -> do activateAccount toxman k wanted_profile s
-                                hPutStrLn stderr $ "loaded tox secret " ++ show sec
+                                dput XMisc $ "loaded tox secret " ++ show sec
                                 return wanted_profile
                     _     -> do
                             -- XXX: We should probably fail to connect when an
                             -- invalid Tox profile is used.  For now, we'll
                             -- fall back to the Unix account login.
-                            hPutStrLn stderr "failed to find tox secret"
+                            dput XMisc "failed to find tox secret"
                             return "."
             ("*.tox","") -> do
-                hPutStrLn stderr $ "TODO: Match single tox key profile or generate first."
+                dput XMisc $ "TODO: Match single tox key profile or generate first."
                 -- TODO: Match single tox key profile or generate first.
                 _todo
             _ -> 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
     when (begindoc==EventBeginDocument) $ do
     whenJust nextElement $ \xml -> do
     withJust (elementAttrs "stream" xml) $ \stream_attrs -> do
-    -- liftIO $ hPutStrLn stderr $ "STREAM ATTRS "++show stream_attrs
+    -- liftIO $ dput XMisc $ "STREAM ATTRS "++show stream_attrs
     let stream_name  = lookupAttrib "to"      stream_attrs
      -- xmpp_version = lookupAttrib "version" stream_attrs
     fix $ \loop -> do
@@ -1866,10 +1866,10 @@ xmppServer allocate xmpp = do
         forkIO $ do
             myThreadId >>= flip labelThread ("XMPP.monitor")
             monitor sv peer_params xmpp
-        hPutStrLn stderr $ "Starting peer listen"
+        dput XMisc $ "Starting peer listen"
         peer_bind <- maybe (getBindAddress "5269" True) return $ xmppPeerBind xmpp
         control sv (Listen peer_bind peer_params)
-        hPutStrLn stderr $ "Starting client listen"
+        dput XMisc $ "Starting client listen"
         client_bind <- maybe (getBindAddress "5222" True) return $ xmppClientBind xmpp
         control sv (Listen client_bind client_params)
     return XMPPServer { _xmpp_sv = sv, _xmpp_peer_params = peer_params }