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

10 files changed, 77 insertions, 61 deletions

diff --git a/src/Network/Address.hs b/src/Network/Address.hs
index 3766d614..367f608b 100644
--- a/src/Network/Address.hs
+++ b/src/Network/Address.hs
@@ -131,6 +131,7 @@ import System.Locale    (defaultTimeLocale)
 #endif
 import System.Entropy
 import System.IO (stderr)
+import DPut
 
 -- import Paths_bittorrent (version)
 
@@ -1193,7 +1194,7 @@ getBindAddress bindspec enabled6 = do
                   then SockAddrInet6 (parsePort listenPortString) 0 iN6ADDR_ANY 0
                   else SockAddrInet (parsePort listenPortString) iNADDR_ANY
                     where parsePort s = fromMaybe 0 $ readMaybe s
-    hPutStrLn stderr $ BS8.pack $ "Listening on " ++ show listenAddr
+    dput XMisc $ "Listening on " ++ show listenAddr
     return listenAddr
 
 -- | True if the argument is an IPv4-mapped address with prefix ::FFFF:0:0/96
diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs
index 847d820b..626f980f 100644
--- a/src/Network/BitTorrent/MainlineDHT.hs
+++ b/src/Network/BitTorrent/MainlineDHT.hs
@@ -87,6 +87,7 @@ import qualified Data.Aeson as JSON
 import Text.Read
 import System.Global6
 import Control.TriadCommittee
+import DPut
 
 newtype NodeId = NodeId ByteString
  deriving (Eq,Ord,ByteArrayAccess, Bits, Hashable)
@@ -431,10 +432,10 @@ addVerbosity :: Transport err SockAddr ByteString -> Transport err SockAddr Byte
 addVerbosity tr =
     tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do
             forM_ m $ mapM_ $ \(msg,addr) -> do
-                hPutStrLn stderr (showPacket id addr " --> " msg)
+                dput XBitTorrent (showPacket id addr " --> " msg)
             kont m
        , sendMessage = \addr msg -> do
-            hPutStrLn stderr (showPacket id addr " <-- " msg)
+            dput XBitTorrent (showPacket id addr " <-- " msg)
             sendMessage tr addr msg
        }
 
@@ -642,18 +643,18 @@ newClient swarms addr = do
     fork $ fix $ \again -> do
         myThreadId >>= flip labelThread "addr4"
         (addr, ns) <- atomically $ readTChan addr4
-        hPutStrLn stderr $ "External IPv4: "++show (addr, length ns)
+        dput XBitTorrent $ "External IPv4: "++show (addr, length ns)
         forM_ ns $ \n -> do
-            hPutStrLn stderr $ "Change IP, ping: "++show n
+            dput XBitTorrent $ "Change IP, ping: "++show n
             ping outgoingClient n
         -- TODO: trigger bootstrap ipv4
         again
     fork $ fix $ \again -> do
         myThreadId >>= flip labelThread "addr6"
         (addr,ns) <- atomically $ readTChan addr6
-        hPutStrLn stderr $ "External IPv6: "++show (addr, length ns)
+        dput XBitTorrent $ "External IPv6: "++show (addr, length ns)
         forM_ ns $ \n -> do
-            hPutStrLn stderr $ "Change IP, ping: "++show n
+            dput XBitTorrent $ "Change IP, ping: "++show n
             ping outgoingClient n
         -- TODO: trigger bootstrap ipv6
         again
@@ -734,7 +735,7 @@ mainlineKademlia client committee refresher
                         return $ do
                             io1 >> io2
                             {-  noisy (timestamp updates are currently reported as transitions to Accepted)
-                            hPutStrLn stderr $ unwords
+                            dput XBitTorrent $ unwords
                                 [ show (transitionedTo tr)
                                 , show (transitioningNode tr)
                                 ] -}
@@ -753,7 +754,7 @@ transitionCommittee :: TriadCommittee NodeId SockAddr -> RoutingTransition NodeI
 transitionCommittee committee (RoutingTransition ni Stranger) = do
     delVote committee (nodeId ni)
     return $ do
-        hPutStrLn stderr $ "delVote "++show (nodeId ni)
+        dput XBitTorrent $ "delVote "++show (nodeId ni)
 transitionCommittee committee _ = return $ return ()
 
 updateRouting :: MainlineClient -> Routing -> NodeInfo -> Message BValue -> IO ()
@@ -768,7 +769,7 @@ updateRouting client routing naddr msg = do
             case msg of
                 R { rspReflectedIP = Just sockaddr }
                     -> do
-                        -- hPutStrLn stderr $ "External: "++show (nodeId naddr,sockaddr)
+                        -- dput XBitTorrent $ "External: "++show (nodeId naddr,sockaddr)
                         atomically $ addVote committee (nodeId naddr) sockaddr
                 _   -> return ()
             insertNode (mainlineKademlia client committee refresher) naddr
diff --git a/src/Network/Kademlia/Bootstrap.hs b/src/Network/Kademlia/Bootstrap.hs
index d77f524c..4197e06e 100644
--- a/src/Network/Kademlia/Bootstrap.hs
+++ b/src/Network/Kademlia/Bootstrap.hs
@@ -143,7 +143,7 @@ forkPollForRefresh r@BucketRefresher{ refreshInterval
  where
     refresh :: Int -> IO Int
     refresh n = do
-        -- hPutStrLn stderr $ "Refresh time! "++ show n
+        -- dput XRefresh $ "Refresh time! "++ show n
         refreshBucket r n
 
     go again ( bktnum :-> refresh_time ) = do
@@ -162,7 +162,7 @@ forkPollForRefresh r@BucketRefresher{ refreshInterval
                                        return ()
                              return ()
             picoseconds -> do
-                -- hPutStrLn stderr $ show (picoseconds `div` 10^12) ++ " seconds until refresh " ++ show bktnum
+                -- dput XRefresh $ show (picoseconds `div` 10^12) ++ " seconds until refresh " ++ show bktnum
                 threadDelay ( picoseconds `div` 10^6 )
         again
 
@@ -202,13 +202,13 @@ onFinishedRefresh BucketRefresher { bootstrapCountdown
                                   , refreshQueue
                                   , refreshBuckets     } num now = do
     bootstrapping <- readTVar bootstrapMode
-    if not bootstrapping then return $ return () -- hPutStrLn stderr $ "Finished non-boostrapping refresh: "++show num
+    if not bootstrapping then return $ return () -- dput XRefresh $ "Finished non-boostrapping refresh: "++show num
                          else do
     tbl <- readTVar refreshBuckets
     action <-
       if num /= R.bktCount tbl - 1
         then do modifyTVar' bootstrapCountdown (fmap pred)
-                return $ return () -- hPutStrLn stderr $ "BOOTSTRAP decrement"
+                return $ return () -- dput XRefresh $ "BOOTSTRAP decrement"
         else do
             -- The last bucket finished.
             cnt <- readTVar bootstrapCountdown
@@ -225,17 +225,17 @@ onFinishedRefresh BucketRefresher { bootstrapCountdown
                         -- Schedule immediate refresh for unfull buckets (other than this one).
                         modifyTVar' refreshQueue $ Int.insert n (now - 1)
                     writeTVar bootstrapCountdown $! Just $! length unfull
-                    return $ return () -- hPutStrLn stderr $ "BOOTSTRAP scheduling: "++show unfull
+                    return $ return () -- dput XRefresh $ "BOOTSTRAP scheduling: "++show unfull
                 Just n  -> do writeTVar bootstrapCountdown $! Just $! pred n
-                              return $ return () -- hPutStrLn stderr "BOOTSTRAP decrement (last bucket)"
+                              return $ return () -- dput XRefresh "BOOTSTRAP decrement (last bucket)"
     cnt <- readTVar bootstrapCountdown
     if (cnt == Just 0)
     then do
         -- Boostrap finished!
         writeTVar bootstrapMode False
         writeTVar bootstrapCountdown Nothing
-        return $ do action ; hPutStrLn stderr $ "BOOTSTRAP complete (" ++ show (R.shape tbl) ++ ")."
-    else return $ do action ; hPutStrLn stderr $ "BOOTSTRAP progress " ++ show (num,R.shape tbl,cnt)
+        return $ do action ; dput XRefresh $ "BOOTSTRAP complete (" ++ show (R.shape tbl) ++ ")."
+    else return $ do action ; dput XRefresh $ "BOOTSTRAP progress " ++ show (num,R.shape tbl,cnt)
 
 refreshBucket :: (Show nid, Ord ni, Ord nid, Hashable nid, Hashable ni) =>
                  BucketRefresher nid ni -> Int -> IO Int
@@ -254,7 +254,7 @@ refreshBucket r@BucketRefresher{ refreshSearch  = sch
     fin <- atomically $ newTVar False
     resultCounter <- atomically $ newTVar Set.empty
 
-    hPutStrLn stderr $ "Start refresh " ++ show (n,sample)
+    dput XRefresh $ "Start refresh " ++ show (n,sample)
 
     -- Set 15 minute timeout in order to avoid overlapping refreshes.
     s <- search sch tbl sample $ if n+1 == R.defaultBucketCount
@@ -289,9 +289,9 @@ restartBootstrap r@BucketRefresher{ bootstrapMode, bootstrapCountdown } = do
     writeTVar bootstrapMode True
     writeTVar bootstrapCountdown Nothing
     if not unchanged then return $ do
-                            hPutStrLn stderr "BOOTSTRAP entered bootstrap mode"
+                            dput XRefresh "BOOTSTRAP entered bootstrap mode"
                             refreshLastBucket r
-                     else return $ hPutStrLn stderr "BOOTSTRAP already bootstrapping"
+                     else return $ dput XRefresh "BOOTSTRAP already bootstrapping"
 
 bootstrap :: (Ord ni, Ord nid, Hashable nid, Hashable ni, Foldable t, Foldable t1, Show nid) =>
              BucketRefresher nid ni
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 4e697109..3ee6d945 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -37,6 +37,7 @@ import System.Endian
 import System.IO
 import System.IO.Error
 import System.Timeout
+import DPut
 
 -- | Three methods are required to implement a datagram based query\/response protocol.
 data Transport err addr x = Transport
@@ -426,6 +427,16 @@ ignoreErrors = ErrorReporter
     , reportTimeout = \_ _ _ -> return ()
     }
 
+logErrors :: ( Show addr
+               , Show meth
+               ) => ErrorReporter addr x meth tid String
+logErrors = ErrorReporter
+    { reportParseError = \err -> dput XMisc err
+    , reportMissingHandler = \meth addr x -> dput XMisc $ show addr ++ " --> Missing handler ("++show meth++")"
+    , reportUnknown = \addr x err -> dput XMisc $ show addr ++ " --> " ++ err
+    , reportTimeout = \meth tid addr -> dput XMisc $ show addr ++ " --> Timeout ("++show meth++")"
+    }
+
 printErrors :: ( Show addr
                , Show meth
                ) => Handle -> ErrorReporter addr x meth tid String
@@ -550,9 +561,9 @@ udpTransport' bind_address = do
             (SockAddrInet6 port 0 (0,0,0x0000ffff,raw4) 0) -> \bs -> do
                 let host4 = toBE32 raw4
                 -- Change 4mapped6 to ordinary IPv4.
-                -- hPutStrLn stderr $ "4mapped6 -> "++show (SockAddrInet port host4)
+                -- dput XMisc $ "4mapped6 -> "++show (SockAddrInet port host4)
                 saferSendTo sock bs (SockAddrInet port host4)
-            addr@(SockAddrInet6 {}) -> \bs -> hPutStrLn stderr ("Discarding packet to "++show addr)
+            addr@(SockAddrInet6 {}) -> \bs -> dput XMisc ("Discarding packet to "++show addr)
             addr4 -> \bs -> saferSendTo sock bs addr4
         _ -> \addr bs -> saferSendTo sock bs addr
     , closeTransport = close sock
diff --git a/src/Network/StreamServer.hs b/src/Network/StreamServer.hs
index 6a36ed00..01680b77 100644
--- a/src/Network/StreamServer.hs
+++ b/src/Network/StreamServer.hs
@@ -57,6 +57,7 @@ import System.IO (Handle)
 import Control.Concurrent.MVar (newMVar)
 
 import Network.SocketLike
+import DPut
 
 data ServerHandle = ServerHandle Socket (Weak ThreadId)
 
@@ -89,7 +90,7 @@ bshow e = show e
 -- | Send a string to stderr.  Not exported.  Default 'serverWarn' when
 -- 'withSession' is used to configure the server.
 warnStderr :: String -> IO ()
-warnStderr str = hPutStrLn stderr str >> hFlush stderr
+warnStderr str = dput XMisc str >> hFlush stderr
 
 data ServerConfig = ServerConfig
     { serverWarn    :: String -> IO ()
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index a13a4f10..efddc2a0 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -141,9 +141,9 @@ newCrypto = do
     noncevar <- atomically $ newTVar $ fst $ withDRG drg drgNew
     cookieKeys <- atomically $ newTVar []
     cache <- newSecretsCache
-    hPutStrLn stderr $ "secret(tox) = " ++ DHT.showHex secret
-    hPutStrLn stderr $ "public(tox) = " ++ DHT.showHex pubkey
-    hPutStrLn stderr $ "symmetric(tox) = " ++ DHT.showHex symkey
+    dput XNetCrypto $ "secret(tox) = " ++ DHT.showHex secret
+    dput XNetCrypto $ "public(tox) = " ++ DHT.showHex pubkey
+    dput XNetCrypto $ "symmetric(tox) = " ++ DHT.showHex symkey
     return TransportCrypto
         { transportSecret = secret
         , transportPublic = pubkey
@@ -233,7 +233,7 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
                 , lookupHandler = handlers -- var
                 , tableMethods = modifytbl tbl
                 }
-        eprinter = printErrors stderr
+        eprinter = logErrors -- printErrors stderr
         mkclient (tbl,var) handlers =
             let client = Client
                     { clientNet           = addHandler (reportParseError eprinter) (handleMessage client) $ modifynet client net
@@ -277,7 +277,7 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
     mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox)))
     case mbContactsVar of
       Nothing -> do
-        hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") accounts lookup failed.")
+        dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") accounts lookup failed.")
         return []
 
       Just contactsVar -> do
@@ -292,13 +292,13 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
             return (kp,sa,fr,cp)
         case tup of
          (Nothing,Nothing,Nothing,Nothing) -> do
-            hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") friend not found (" ++ show theirkeyAsId ++ ").")
+            dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") friend not found (" ++ show theirkeyAsId ++ ").")
             return []
          (mbKeyPkt,Nothing,mbFR,mbPolicy) -> do
-            hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") no SockAddr for friend (" ++ show theirkeyAsId ++ "). TODO: search their node?")
+            dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") no SockAddr for friend (" ++ show theirkeyAsId ++ "). TODO: search their node?")
             return []
          (Nothing,_,_,_) -> do
-            hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") no DHT-key for friend (" ++ show theirkeyAsId ++ "). TODO: what?")
+            dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") no DHT-key for friend (" ++ show theirkeyAsId ++ "). TODO: what?")
             return []
          (Just (stamp_theirDhtKey,keyPkt),Just (stamp_saddr,saddr),mbFR,mbPolicy)
                                   | theirDhtKey <- DHT.dhtpk keyPkt -> do
@@ -310,7 +310,7 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
               Just sessions | matchedSessions <- filter (sessionUsesIdentity (toPublic myseckey)) sessions
                             , not (null matchedSessions)
                             -> do
-                hPutStrLn stderr ("netCrypto: Already have a session for " ++ show mykeyAsId ++ "<-->" ++ show theirkeyAsId)
+                dput XNetCrypto ("netCrypto: Already have a session for " ++ show mykeyAsId ++ "<-->" ++ show theirkeyAsId)
                 return matchedSessions
             -- if not, send handshake, this is separate session
               _ -> do
@@ -319,16 +319,16 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
                 let crypto = toxCryptoKeys tox
                     client = toxDHT tox
                 case nodeInfo (key2id theirDhtKey) saddr of
-                   Left e   -> hPutStrLn stderr ("netCrypto: nodeInfo fail... " ++ e) >> return []
+                   Left e   -> dput XNetCrypto ("netCrypto: nodeInfo fail... " ++ e) >> return []
                    Right ni -> do
                     mbCookie <- DHT.cookieRequest crypto client (toPublic myseckey) ni
                     case mbCookie of
                       Nothing -> do
-                        hPutStrLn stderr ("netCrypto: (" ++ show mykeyAsId ++") <--> (" ++ show theirkeyAsId ++ ").")
-                        hPutStrLn stderr ("netCrypto: CookieRequest failed. TODO: dhtpkNodes thingy")
+                        dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") <--> (" ++ show theirkeyAsId ++ ").")
+                        dput XNetCrypto ("netCrypto: CookieRequest failed. TODO: dhtpkNodes thingy")
                         return []
                       Just cookie -> do
-                        hPutStrLn stderr "Have cookie, creating handshake packet..."
+                        dput XNetCrypto "Have cookie, creating handshake packet..."
                         let hp = HParam { hpOtherCookie = cookie
                                         , hpMySecretKey = myseckey
                                         , hpCookieRemotePubkey = theirpubkey
@@ -349,12 +349,12 @@ netCryptoWithBackoff millisecs tox myseckey theirpubkey = do
                             delay = (millisecs * 5 `div` 4)
                         if secnum < 20000000
                           then do
-                            hPutStrLn stderr $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ "  second(s).."
+                            dput XNetCrypto $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ "  second(s).."
                             -- threadDelay delay
                             -- Commenting loop for simpler debugging
                             return [] -- netCryptoWithBackoff delay tox myseckey theirpubkey -- hopefully it will find an active session this time.
                           else do
-                            hPutStrLn stderr "Unable to establish session..."
+                            dput XNetCrypto "Unable to establish session..."
                             return []
 
 -- | Create a DHTPublicKey packet to send to a remote contact.
@@ -387,12 +387,12 @@ addVerbosity tr =
     tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do
             forM_ m $ mapM_ $ \(msg,addr) -> do
                 when (not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do
-                    mapM_ (\x -> hPutStrLn stderr ( (show addr) ++ " --> " ++ x))
+                    mapM_ (\x -> dput XMisc ( (show addr) ++ " --> " ++ x))
                           $ xxd 0 msg
             kont m
        , sendMessage = \addr msg -> do
             when (not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x8c,0x8d])) $ do
-                mapM_ (\x -> hPutStrLn stderr ( (show addr) ++ " <-- " ++ x))
+                mapM_ (\x -> dput XMisc ( (show addr) ++ " <-- " ++ x))
                       $ xxd 0 msg
             sendMessage tr addr msg
        }
@@ -437,15 +437,15 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
         -- patch in newly allocated roster state.
         crypto = crypto1 { userKeys = myKeyPairs roster }
     forM_ suppliedDHTKey $ \k -> do
-        maybe (hPutStrLn stderr "failed to encode suppliedDHTKey")
-              (C8.hPutStrLn stderr . C8.append "Using suppliedDHTKey: ")
+        maybe (dput XMisc "failed to encode suppliedDHTKey")
+              (dputB XMisc . C8.append "Using suppliedDHTKey: ")
               $ encodeSecret k
 
     drg <- drgNew
     let lookupClose _ = return Nothing
 
     mkrouting <- DHT.newRouting addr crypto updateIP updateIP
-    let ignoreErrors _ = return () -- Set this to (hPutStrLn stderr) to debug onion route building.
+    let ignoreErrors _ = return () -- Set this to (dput XMisc) to debug onion route building.
     orouter <- newOnionRouter ignoreErrors
     (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) <- toxTransport crypto orouter lookupClose udp
 
@@ -493,8 +493,8 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
         { toxDHT            = dhtclient
         , toxOnion          = onionclient
         , toxToRoute        = onInbound (updateContactInfo roster) dtacrypt
-        , toxCrypto         = addHandler (hPutStrLn stderr) (sessionPacketH sessionsState) cryptonet
-        , toxHandshakes     = addHandler (hPutStrLn stderr) (handshakeH     sessionsState) handshakes
+        , toxCrypto         = addHandler (dput XMisc) (sessionPacketH sessionsState) cryptonet
+        , toxHandshakes     = addHandler (dput XMisc) (handshakeH     sessionsState) handshakes
         , toxCryptoSessions = sessionsState
         , toxCryptoKeys     = crypto
         , toxRouting        = mkrouting dhtclient
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index 64ea861b..5135813a 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -18,6 +18,7 @@ import Network.Tox.DHT.Transport     as DHT
 import Network.Tox.NodeId            (id2key)
 import Network.Tox.Onion.Transport   as Onion
 import System.IO
+import DPut
 
 newtype ContactInfo extra = ContactInfo
       -- | Map our toxid public key to an Account record.
@@ -55,7 +56,7 @@ myKeyPairs (ContactInfo accounts) = do
 
 updateContactInfo :: ContactInfo extra -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO ()
 updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do
-    hPutStrLn stderr "updateContactInfo!!!"
+    dput XMisc "updateContactInfo!!!"
     now <- getPOSIXTime
     atomically $ do
         as <- readTVar (accounts roster)
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index 43169fa0..58a29c3e 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -404,9 +404,9 @@ unwrapNodes (SendNodes ns) = (ns,ns,Just ())
 
 getNodes :: Client -> TVar (HashMap NodeId [NodeInfoCallback]) -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],Maybe ()))
 getNodes client cbvar nid addr = do
-    -- hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid
+    -- dput XMisc $ show addr ++ " <-- getnodes " ++ show nid
     reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr
-    -- hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply
+    -- dput XMisc $ show addr ++ " -sendnodes-> " ++ show reply
     forM_ (join reply) $ \(SendNodes ns) -> 
         forM_ ns $ \n -> do
             now <- getPOSIXTime
@@ -430,13 +430,13 @@ updateRouting client routing orouter naddr msg
     case prefer4or6 naddr Nothing of
         Want_IP4 -> updateTable client naddr orouter (committee4 routing) (refresher4 routing)
         Want_IP6 -> updateTable client naddr orouter (committee6 routing) (refresher6 routing)
-        Want_Both -> do hPutStrLn stderr "BUG:unreachable"
+        Want_Both -> do dput XMisc "BUG:unreachable"
                         error $ "BUG:unreachable at " ++ __FILE__ ++ ":" ++ show __LINE__
 
 updateTable :: Client -> NodeInfo -> OnionRouter -> TriadCommittee NodeId SockAddr -> BucketRefresher NodeId NodeInfo -> IO ()
 updateTable client naddr orouter committee refresher = do
         self <- atomically $ R.thisNode <$> readTVar (refreshBuckets refresher)
-        -- hPutStrLn stderr $ "(tox)updateRouting: " ++ show (nodeIP self, nodeIP naddr)
+        -- dput XMisc $ "(tox)updateRouting: " ++ show (nodeIP self, nodeIP naddr)
         when (self /= naddr) $ do
             -- TODO: IP address vote?
             insertNode (toxKademlia client committee orouter refresher) naddr
@@ -455,7 +455,7 @@ toxKademlia client committee orouter refresher
                         return $ do
                             io1 >> io2
                             {-
-                            hPutStrLn stderr $ unwords
+                            dput XMisc $ unwords
                                 [ show (transitionedTo tr)
                                 , show (transitioningNode tr)
                                 ]
@@ -467,7 +467,7 @@ transitionCommittee :: TriadCommittee NodeId SockAddr -> RoutingTransition NodeI
 transitionCommittee committee (RoutingTransition ni Stranger) = do
     delVote committee (nodeId ni)
     return $ do
-        -- hPutStrLn stderr $ "delVote "++show (nodeId ni)
+        -- dput XMisc $ "delVote "++show (nodeId ni)
         return ()
 transitionCommittee committee _ = return $ return ()
 
@@ -500,7 +500,7 @@ isDHTRequest _      _                        = Left "Bad dht relay request"
 
 dhtRequestH :: NodeInfo -> DHTRequest -> IO ()
 dhtRequestH ni req = do
-    hPutStrLn stderr $ "Unhandled DHT Request: " ++ show req
+    dput XMisc $ "Unhandled DHT Request: " ++ show req
 
 handlers :: TransportCrypto -> Routing -> PacketKind -> Maybe Handler
 handlers _      routing PingType          = Just $ MethodHandler (isPing snd) mkPong            $ pingH
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 8a66f2b2..70714465 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -246,7 +246,7 @@ encodeOnionAddr crypto _ (msg,OnionToOwner ni p) =
                   , nodeAddr ni )
 encodeOnionAddr crypto getRoute (msg,OnionDestination x ni Nothing) = do
     encodeOnionAddr crypto getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
-    -- hPutStrLn stderr $ "ONION encode missing routeid"
+    -- dput XMisc $ "ONION encode missing routeid"
     -- return Nothing
 encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
@@ -255,8 +255,8 @@ encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
                    , nodeAddr $ routeNodeA route)
         mapM' f x = do
             let _ = x :: Maybe OnionRoute
-            -- hPutStrLn stderr $ "ONION encode sending to  " ++ show ni
-            -- hPutStrLn stderr $ "ONION encode getRoute -> " ++ show (fmap (\y -> map ($ y) [routeNodeA,routeNodeB,routeNodeC]) x)
+            -- dput XMisc $ "ONION encode sending to  " ++ show ni
+            -- dput XMisc $ "ONION encode getRoute -> " ++ show (fmap (\y -> map ($ y) [routeNodeA,routeNodeB,routeNodeC]) x)
             mapM f x         -- ONION encode getRoute -> Nothing
     getRoute ni rid >>= mapM' go
 
@@ -525,7 +525,7 @@ handleOnionResponse proxy crypto saddr udp kont (OnionResponse path msg) = do
         Left e -> do
             -- todo report encryption error
             let n = peanoVal path
-            hPutStrLn stderr $ unwords [ "peelSymmetric:", show n, either show show (either4or6 saddr), e]
+            dput XMisc $ unwords [ "peelSymmetric:", show n, either show show (either4or6 saddr), e]
             kont
         Right (Addressed dst path') -> do
             sendMessage udp dst (runPut $ putResponse $ OnionResponse path' msg)
@@ -897,9 +897,9 @@ parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
       r = either (const $ Right (OnionToRouteResponse dta,od)) Left e
   -- parseDataToRoute OnionToRouteResponse decipherAndAuth: auth fail
   case e of
-    Left _  -> hPutStrLn stderr $ "Failed keys: " ++ show (map (key2id . snd) ks)
+    Left _  -> dput XMisc $ "Failed keys: " ++ show (map (key2id . snd) ks)
     Right _ -> return ()
-  hPutStrLn stderr $ unlines
+  dput XMisc $ unlines
         [ "parseDataToRoute " ++ either id (const "Right") e
         , "       crypto inner.me   = " ++ either id (\(pk,_,_) -> show $ key2id pk) eInner
         , "              inner.them = " ++ either id (show . key2id . dataFromKey) eOuter
diff --git a/src/Network/UPNP.hs b/src/Network/UPNP.hs
index ed6b4777..f053369f 100644
--- a/src/Network/UPNP.hs
+++ b/src/Network/UPNP.hs
@@ -6,6 +6,7 @@ import Network.Socket
 import System.Directory
 import System.IO
 import System.Process  as Process
+import DPut
 
 protocols :: SocketType -> [String]
 protocols Stream   = ["tcp"]
@@ -35,5 +36,5 @@ requestPorts description binds = do
                 phandle <- spawnProcess upnpc $ "-e": description : "-r" : requests
                 return $ Just phandle
             else do
-                hPutStrLn stderr $ "Warning: unable to find miniupnpc client at "++upnpc++"."
+                dput XMisc $ "Warning: unable to find miniupnpc client at "++upnpc++"."
                 bail