summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/Tox/Crypto/Handlers.hs7
-rw-r--r--src/Network/Tox/Onion/Handlers.hs5
-rw-r--r--src/Network/Tox/Onion/Transport.hs7
3 files changed, 11 insertions, 8 deletions
diff --git a/src/Network/Tox/Crypto/Handlers.hs b/src/Network/Tox/Crypto/Handlers.hs
index 5a52450b..95cb1bc8 100644
--- a/src/Network/Tox/Crypto/Handlers.hs
+++ b/src/Network/Tox/Crypto/Handlers.hs
@@ -45,6 +45,7 @@ import PingMachine
45import qualified Data.IntMap.Strict as IntMap 45import qualified Data.IntMap.Strict as IntMap
46import Control.Concurrent.Supply 46import Control.Concurrent.Supply
47import Data.InOrOut 47import Data.InOrOut
48import DPut
48 49
49-- util, todo: move to another module 50-- util, todo: move to another module
50maybeToEither :: Maybe b -> Either String b 51maybeToEither :: Maybe b -> Either String b
@@ -536,7 +537,7 @@ updateCryptoSession sessions addr hp session = do
536 537
537cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto)) 538cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto))
538cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do 539cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do
539 hPutStrLn stderr ("RECIEVED HANDSHAKE from " ++ show addr) 540 dput XNetCrypto ("RECIEVED HANDSHAKE from " ++ show addr)
540 -- Handle Handshake Message 541 -- Handle Handshake Message
541 let crypto = transportCrypto sessions 542 let crypto = transportCrypto sessions
542 allsessions = netCryptoSessions sessions 543 allsessions = netCryptoSessions sessions
@@ -545,7 +546,7 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
545 seckeys <- map fst <$> atomically (readTVar (userKeys crypto)) 546 seckeys <- map fst <$> atomically (readTVar (userKeys crypto))
546 symkey <- atomically $ transportSymmetric crypto 547 symkey <- atomically $ transportSymmetric crypto
547 now <- getPOSIXTime 548 now <- getPOSIXTime
548 hPutStrLn stderr ("Decrypt cookie with n24=" ++ show n24 ++ "\n symkey= " ++ show symkey) 549 dput XNetCrypto ("Decrypt cookie with n24=" ++ show n24 ++ "\n symkey= " ++ show symkey)
549 lr <- fmap join . sequence $ do -- Either Monad 550 lr <- fmap join . sequence $ do -- Either Monad
550 -- TODO: XXX: FIXME: 551 -- TODO: XXX: FIXME:
551 -- The following call to decryptSymmetric is failing every time, 552 -- The following call to decryptSymmetric is failing every time,
@@ -579,7 +580,7 @@ cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) non
579 , hpCookieRemoteDhtkey = remoteDhtkey 580 , hpCookieRemoteDhtkey = remoteDhtkey
580 } 581 }
581 case lr of 582 case lr of
582 Left s -> hPutStrLn stderr ("cryptoNetHandler: " ++ s) 583 Left s -> dput XNetCrypto ("cryptoNetHandler: " ++ s)
583 Right hp@(HParam 584 Right hp@(HParam
584 { hpTheirBaseNonce = Just theirBaseNonce 585 { hpTheirBaseNonce = Just theirBaseNonce
585 , hpOtherCookie = otherCookie 586 , hpOtherCookie = otherCookie
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 8c3a9a86..94ece8ab 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -43,6 +43,7 @@ import Data.Maybe
43import Data.Bits 43import Data.Bits
44import Data.Ord 44import Data.Ord
45import Data.Functor.Identity 45import Data.Functor.Identity
46import DPut
46 47
47type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message 48type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message
48type Message = OnionMessage Identity 49type Message = OnionMessage Identity
@@ -77,7 +78,7 @@ announceH routing toks keydb oaddr req = do
77 _ -> let Nonce32 bs = announcePingId req 78 _ -> let Nonce32 bs = announcePingId req
78 tok = fromPaddedByteString 32 bs 79 tok = fromPaddedByteString 32 bs
79 in checkToken toks (onionNodeInfo oaddr) tok >>= go 80 in checkToken toks (onionNodeInfo oaddr) tok >>= go
80 `catch` (\(SomeException e) -> hPutStrLn stderr ("announceH Exception! "++show e) >> throw e) 81 `catch` (\(SomeException e) -> dput XAnnounce ("announceH Exception! "++show e) >> throw e)
81 where 82 where
82 go withTok = do 83 go withTok = do
83 let naddr = onionNodeInfo oaddr 84 let naddr = onionNodeInfo oaddr
@@ -87,7 +88,7 @@ announceH routing toks keydb oaddr req = do
87 let storing = case oaddr of 88 let storing = case oaddr of
88 OnionToOwner _ pth -> guard (nodeId naddr == announceSeeking req) >> Just pth 89 OnionToOwner _ pth -> guard (nodeId naddr == announceSeeking req) >> Just pth
89 _ -> Nothing 90 _ -> Nothing
90 hPutStrLn stderr $ unlines [ "announceH: nodeId = " ++ show (nodeId naddr) 91 dput XAnnounce $ unlines [ "announceH: nodeId = " ++ show (nodeId naddr)
91 , " announceSeeking = " ++ show (announceSeeking req) 92 , " announceSeeking = " ++ show (announceSeeking req)
92 , " withTok = " ++ show withTok 93 , " withTok = " ++ show withTok
93 , " storing = " ++ maybe "False" (const "True") storing 94 , " storing = " ++ maybe "False" (const "True") storing
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 23fd369b..550a7730 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -79,6 +79,7 @@ import Network.Socket
79import System.IO 79import System.IO
80import qualified Text.ParserCombinators.ReadP as RP 80import qualified Text.ParserCombinators.ReadP as RP
81import Data.Hashable 81import Data.Hashable
82import DPut
82 83
83type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a 84type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
84 85
@@ -481,17 +482,17 @@ handleOnionRequest :: forall a proxy n.
481 ) => proxy n -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionRequest n -> IO a 482 ) => proxy n -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionRequest n -> IO a
482handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do 483handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do
483 let n = peanoVal rpath 484 let n = peanoVal rpath
484 hPutStrLn stderr $ "handleOnionRequest " ++ show n 485 dput XOnion $ "handleOnionRequest " ++ show n
485 (sym, snonce) <- atomically ( (,) <$> transportSymmetric crypto 486 (sym, snonce) <- atomically ( (,) <$> transportSymmetric crypto
486 <*> transportNewNonce crypto ) 487 <*> transportNewNonce crypto )
487 peeled <- peelOnion crypto nonce msg 488 peeled <- peelOnion crypto nonce msg
488 case peeled of 489 case peeled of
489 Left e -> do 490 Left e -> do
490 -- todo report encryption error 491 -- todo report encryption error
491 hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), e] 492 dput XOnion $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), e]
492 kont 493 kont
493 Right (Addressed dst msg') -> do 494 Right (Addressed dst msg') -> do
494 hPutStrLn stderr $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), "-->", either show show (either4or6 dst), "SUCCESS"] 495 dput XOnion $ unwords [ "peelOnion:", show n, either show show (either4or6 saddr), "-->", either show show (either4or6 dst), "SUCCESS"]
495 sendMessage udp dst (runPut $ putRequest $ OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath) 496 sendMessage udp dst (runPut $ putRequest $ OnionRequest nonce msg' $ wrapSymmetric sym snonce saddr rpath)
496 kont 497 kont
497 498