From 8903c7e0b9eea11dbf229747e7f9729bfe5d2f7b Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Sat, 4 Nov 2017 22:21:24 -0400
Subject: Quieter output and some bug fixes.

---
 OnionRouter.hs | 24 +++++++++++++-----------
 1 file changed, 13 insertions(+), 11 deletions(-)

(limited to 'OnionRouter.hs')

diff --git a/OnionRouter.hs b/OnionRouter.hs
index 757214cd..20279c5d 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -31,7 +31,6 @@ import qualified Data.Word64Map      as W64
          ;import Data.Word64Map      (Word64Map, fitsInInt)
 import Network.Socket
 import System.Endian
-import System.IO
 import System.Timeout
 
 -- Toxcore saves a maximum of 12 paths: 6 paths are reserved for announcing
@@ -76,8 +75,10 @@ data OnionRouter = OnionRouter
       -- route should be discarded and replaced with a fresh one.
     , pendingRoutes   :: IntMap (TVar Bool)
       -- | Debug prints are written to this channel which is then flushed to
-      -- stderr from within the 'routeThread'.
+      -- 'routeLogger'.
     , routeLog        :: TChan String
+      -- | User supplied log function.
+    , routeLogger     :: String -> IO ()
     }
 
 data RouteRecord = RouteRecord
@@ -120,8 +121,8 @@ gotTimeout rr = rr
 
 data RouteEvent = BuildRoute RouteId
 
-newOnionRouter :: IO OnionRouter
-newOnionRouter = do
+newOnionRouter :: (String -> IO ()) -> IO OnionRouter
+newOnionRouter perror = do
     drg0 <- drgNew
     or <- atomically $ do
         chan <- newTChan
@@ -144,6 +145,7 @@ newOnionRouter = do
             , trampolineCount = tc
             , routeLog = rlog
             , routeThread = error "Failed to invoke forkRouteBuilder"
+            , routeLogger = perror
             }
     return or
 
@@ -159,7 +161,7 @@ forkRouteBuilder or getnodes = do
                     -- writeTVar want_build False -- Prevent redundant BuildRoute events.
                     return $ BuildRoute $ RouteId rid
             io <- atomically $
-                   (readTChan (routeLog or) >>= return . hPutStrLn stderr)
+                   (readTChan (routeLog or) >>= return . routeLogger or)
                 `orElse`
                    (IntMap.foldrWithKey checkRebuild retry (pendingRoutes or)
                         >>= return . handleEvent getnodes or { routeThread = me })
@@ -214,7 +216,7 @@ selectTrampolines or = do
     atomically (selectTrampolines' or) >>= \case
         Left ns -> do
             -- atomically $ writeTChan (routeLog or)
-            hPutStrLn stderr $ unwords
+            routeLogger or $ unwords
                 ( "ONION Discarding insecure trampolines:" : (map (show . nodeAddr) ns) )
             myThreadId >>= flip labelThread ("OnionRouter.selectTrampolines.sleep")
             threadDelay 1000000
@@ -248,7 +250,7 @@ selectTrampolines' or = do
 
 handleEvent :: (NodeId -> NodeInfo -> IO (Maybe [NodeInfo])) -> OnionRouter -> RouteEvent -> IO ()
 handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
-    hPutStrLn stderr $ "ONION Rebuilding RouteId " ++ show rid
+    routeLogger or $ "ONION Rebuilding RouteId " ++ show rid
     mb <- do
         ts <- selectTrampolines or
         join . atomically $ do
@@ -279,7 +281,7 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                                                     -- self <- IntMap.lookup (-1) <$> readTVar (trampolineNodes or)
                                                     -- return $ maybe (catMaybes rs) (\x -> [x,x,x]) self
                                        _       -> retry
-                        maybe (hPutStrLn stderr "ONION: Unexpected sendq timeout!" >> return [])
+                        maybe (routeLogger or "ONION: Unexpected sendq timeout!" >> return [])
                               return
                               tm
                 return $ do
@@ -288,7 +290,7 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                         [_,_,_] -> sendqs
                         _       -> return []
                     myThreadId >>= flip labelThread ("OnionRouter")
-                    hPutStr stderr $ unlines
+                    routeLogger or $ unlines
                         [ "ONION trampolines:   " ++ show ts
                         , "ONION query results: " ++ show nodes ]
                     case nodes of
@@ -319,8 +321,8 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                                  )
                        mb
     case mb of
-        Just _  -> hPutStrLn stderr $ "ONION Finished RouteId " ++ show rid
-        Nothing -> hPutStrLn stderr $ "ONION Failed RouteId " ++ show rid
+        Just _  -> routeLogger or $ "ONION Finished RouteId " ++ show rid
+        Nothing -> routeLogger or $ "ONION Failed RouteId " ++ show rid
 
 lookupSender :: OnionRouter -> SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))
 lookupSender or saddr (Nonce8 w8) = do
-- 
cgit v1.2.3