summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Mainline.hs50
1 files changed, 28 insertions, 22 deletions
diff --git a/Mainline.hs b/Mainline.hs
index 5180352a..ab74eebf 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -514,29 +514,25 @@ newClient addr = do
514 } 514 }
515 addr4 <- atomically $ newTChan 515 addr4 <- atomically $ newTChan
516 addr6 <- atomically $ newTChan 516 addr6 <- atomically $ newTChan
517 fork $ fix $ \again -> do
518 myThreadId >>= flip labelThread "addr6"
519 addr <- atomically $ readTChan addr6
520 hPutStrLn stderr $ "External IPv6: "++show addr
521 again
522 routing <- atomically $ do 517 routing <- atomically $ do
523 let nobkts = R.defaultBucketCount :: Int 518 let nobkts = R.defaultBucketCount :: Int
524 tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts 519 tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts
525 tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts 520 tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts
526 committee4 <- newTriadCommittee $ \a -> do 521 let updateIPVote tblvar addrvar a = do
527 t4 <- readTVar tbl4 522 bkts <- readTVar tblvar
528 case bep42 a (nodeId $ R.thisNode t4) of 523 case bep42 a (nodeId $ R.thisNode bkts) of
529 Just nid -> do 524 Just nid -> do
530 let tbl = R.nullTable (comparing nodeId) 525 let tbl = R.nullTable (comparing nodeId)
531 (\s -> hashWithSalt s . nodeId) 526 (\s -> hashWithSalt s . nodeId)
532 (NodeInfo nid 527 (NodeInfo nid
533 (fromMaybe (toEnum 0) $ fromSockAddr a) 528 (fromMaybe (toEnum 0) $ fromSockAddr a)
534 (fromMaybe 0 $ sockAddrPort a)) 529 (fromMaybe 0 $ sockAddrPort a))
535 nobkts 530 nobkts
536 writeTVar tbl4 tbl 531 writeTVar tblvar tbl
537 writeTChan addr4 (a,map fst $ concat $ R.toList t4) 532 writeTChan addrvar (a,map fst $ concat $ R.toList bkts)
538 Nothing -> return () 533 Nothing -> return ()
539 committee6 <- newTriadCommittee (writeTChan addr6) -- TODO: update tbl6 534 committee4 <- newTriadCommittee $ updateIPVote tbl4 addr4
535 committee6 <- newTriadCommittee $ updateIPVote tbl6 addr6
540 sched4 <- newTVar Int.empty 536 sched4 <- newTVar Int.empty
541 sched6 <- newTVar Int.empty 537 sched6 <- newTVar Int.empty
542 return $ Routing tenative_info sched4 tbl4 committee4 sched6 tbl6 committee6 538 return $ Routing tenative_info sched4 tbl4 committee4 sched6 tbl6 committee6
@@ -583,6 +579,8 @@ newClient addr = do
583 , clientResponseId = return 579 , clientResponseId = return
584 } 580 }
585 581
582 -- TODO: Provide some means of shutting down these four auxillary threads:
583
586 fork $ fix $ \again -> do 584 fork $ fix $ \again -> do
587 myThreadId >>= flip labelThread "addr4" 585 myThreadId >>= flip labelThread "addr4"
588 (addr, ns) <- atomically $ readTChan addr4 586 (addr, ns) <- atomically $ readTChan addr4
@@ -591,8 +589,15 @@ newClient addr = do
591 hPutStrLn stderr $ "Change IP, ping: "++show n 589 hPutStrLn stderr $ "Change IP, ping: "++show n
592 ping outgoingClient n 590 ping outgoingClient n
593 again 591 again
592 fork $ fix $ \again -> do
593 myThreadId >>= flip labelThread "addr6"
594 (addr,ns) <- atomically $ readTChan addr6
595 hPutStrLn stderr $ "External IPv6: "++show (addr, length ns)
596 forM_ ns $ \n -> do
597 hPutStrLn stderr $ "Change IP, ping: "++show n
598 ping outgoingClient n
599 again
594 600
595 -- TODO: Provide some means of shutting down these two auxillary threads:
596 refresh_thread4 <- forkPollForRefresh 601 refresh_thread4 <- forkPollForRefresh
597 (15*60) 602 (15*60)
598 (sched4 routing) 603 (sched4 routing)
@@ -617,8 +622,9 @@ newClient addr = do
617-- 84.124.73.14 65 1b0321 dd1bb1fe518101ceef99462b947a01ff 41 622-- 84.124.73.14 65 1b0321 dd1bb1fe518101ceef99462b947a01ff 41
618-- 43.213.53.83 90 e56f6c bf5b7c4be0237986d5243b87aa6d5130 5a 623-- 43.213.53.83 90 e56f6c bf5b7c4be0237986d5243b87aa6d5130 5a
619bep42 :: SockAddr -> NodeId -> Maybe NodeId 624bep42 :: SockAddr -> NodeId -> Maybe NodeId
620bep42 addr (NodeId r) 625bep42 addr0 (NodeId r)
621 | Just ip <- fmap S.encode (fromSockAddr addr :: Maybe IPv4) 626 | let addr = either id id $ either4or6 addr0 -- unmap 4mapped SockAddrs
627 , Just ip <- fmap S.encode (fromSockAddr addr :: Maybe IPv4)
622 <|> fmap S.encode (fromSockAddr addr :: Maybe IPv6) 628 <|> fmap S.encode (fromSockAddr addr :: Maybe IPv6)
623 = genBucketSample' retr (NodeId $ crc $ applyMask ip) (3,0x07,0) 629 = genBucketSample' retr (NodeId $ crc $ applyMask ip) (3,0x07,0)
624 | otherwise 630 | otherwise