diff options
Diffstat (limited to 'src/Network/Tox')
-rw-r--r-- | src/Network/Tox/Crypto/Handlers.hs | 7 | ||||
-rw-r--r-- | src/Network/Tox/Onion/Handlers.hs | 5 | ||||
-rw-r--r-- | src/Network/Tox/Onion/Transport.hs | 7 |
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 | |||
45 | import qualified Data.IntMap.Strict as IntMap | 45 | import qualified Data.IntMap.Strict as IntMap |
46 | import Control.Concurrent.Supply | 46 | import Control.Concurrent.Supply |
47 | import Data.InOrOut | 47 | import Data.InOrOut |
48 | import DPut | ||
48 | 49 | ||
49 | -- util, todo: move to another module | 50 | -- util, todo: move to another module |
50 | maybeToEither :: Maybe b -> Either String b | 51 | maybeToEither :: Maybe b -> Either String b |
@@ -536,7 +537,7 @@ updateCryptoSession sessions addr hp session = do | |||
536 | 537 | ||
537 | cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto)) | 538 | cryptoNetHandler :: NetCryptoSessions -> SockAddr -> NetCrypto -> IO (Maybe (NetCrypto -> NetCrypto)) |
538 | cryptoNetHandler sessions addr (NetHandshake (Handshake (Cookie n24 ecookie) nonce24 encrypted)) = do | 539 | cryptoNetHandler 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 | |||
43 | import Data.Bits | 43 | import Data.Bits |
44 | import Data.Ord | 44 | import Data.Ord |
45 | import Data.Functor.Identity | 45 | import Data.Functor.Identity |
46 | import DPut | ||
46 | 47 | ||
47 | type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message | 48 | type Client r = QR.Client String PacketKind TransactionId (OnionDestination r) Message |
48 | type Message = OnionMessage Identity | 49 | type 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 | |||
79 | import System.IO | 79 | import System.IO |
80 | import qualified Text.ParserCombinators.ReadP as RP | 80 | import qualified Text.ParserCombinators.ReadP as RP |
81 | import Data.Hashable | 81 | import Data.Hashable |
82 | import DPut | ||
82 | 83 | ||
83 | type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a | 84 | type 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 |
482 | handleOnionRequest proxy crypto saddr udp kont (OnionRequest nonce msg rpath) = do | 483 | handleOnionRequest 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 | ||