From 825962518c6ad00279fc23e8e1dec746980e483f Mon Sep 17 00:00:00 2001 From: "jim@bo" Date: Wed, 20 Jun 2018 22:40:37 -0400 Subject: 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 --- src/Network/Tox.hs | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) (limited to 'src/Network/Tox.hs') 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 -- cgit v1.2.3