Quieter output and some bug fixes.

1 files changed, 9 insertions, 3 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index c06b69d1..dc99642d 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -413,6 +413,8 @@ clientSession0 :: Session -> t1 -> t -> Handle -> IO ()
 clientSession0 s sock cnum h = do
     hstate <- newMVar 1 -- ready for input
     clientSession s sock cnum (ClientHandle h hstate)
+  `catch` \e -> if isEOFError e then return ()
+                                else throwIO e
 
 clientSession :: Session -> t1 -> t -> ClientHandle -> IO ()
 clientSession s@Session{..} sock cnum h = do
@@ -801,7 +803,9 @@ clientSession s@Session{..} sock cnum h = do
                                                             (qresultAddr dta)
                                                             announceInterval)
                                             dta
-                                    hPutClient h $ "Announcing at " ++ show (qresultAddr dta) ++ "."
+                                    case op of
+                                        '+' -> hPutClient h $ "Announcing at " ++ show (qresultAddr dta) ++ "."
+                                        '-' -> hPutClient h $ "Canceling " ++ show (qresultAddr dta) ++ "."
                         let aerror = unlines
                                 [ "announce error."
                                 , "method = " ++ method
@@ -972,7 +976,8 @@ sensibleDefaults = Options
 -- -4
 parseArgs :: [String] -> Options -> Options
 parseArgs []          opts         = opts
-parseArgs ("--dhtkey":k:args) opts = opts { dhtkey       = decodeSecret $ B.pack k }
+parseArgs ("--dhtkey":k:args) opts = parseArgs args opts
+    { dhtkey = decodeSecret $ B.pack k }
 parseArgs ("-4":args) opts         = parseArgs args opts
     { ip6bt  = False
     , ip6tox = False }
@@ -1099,6 +1104,7 @@ main = do
         "" -> return (Nothing,return (), Map.empty, return [],[])
         toxport -> do
             addrTox <- getBindAddress toxport (ip6tox opts)
+            hPutStrLn stderr $ "Supplied key: " ++ show (fmap (Tox.key2id . toPublic) (dhtkey opts))
             tox <- Tox.newTox keysdb addrTox (Just netCryptoSessionsState) (dhtkey opts)
             quitTox <- Tox.forkTox tox
 
@@ -1274,7 +1280,7 @@ main = do
         let defaultToxData = do
                 toxids <- atomically $ newTVar []
                 rster <- newRoster
-                orouter <- newOnionRouter
+                orouter <- newOnionRouter (hPutStrLn stderr)
                 return (toxids, rster, orouter)
         (toxids,rstr,orouter) <- fromMaybe defaultToxData $ do
             tox <- mbtox