diff options
-rw-r--r-- | Mainline.hs | 50 |
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 |
619 | bep42 :: SockAddr -> NodeId -> Maybe NodeId | 624 | bep42 :: SockAddr -> NodeId -> Maybe NodeId |
620 | bep42 addr (NodeId r) | 625 | bep42 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 |