Detect IPv6 change. Bep42: robustly handle 4-mapped addresses.

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
                 }
     addr4 <- atomically $ newTChan
     addr6 <- atomically $ newTChan
-    fork $ fix $ \again -> do
-        myThreadId >>= flip labelThread "addr6"
-        addr <- atomically $ readTChan addr6
-        hPutStrLn stderr $ "External IPv6: "++show addr
-        again
     routing <- atomically $ do
         let nobkts = R.defaultBucketCount :: Int
         tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts
         tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tenative_info nobkts
-        committee4 <- newTriadCommittee $ \a -> do
-            t4 <- readTVar tbl4
-            case bep42 a (nodeId $ R.thisNode t4) of
-                Just nid -> do
-                    let tbl = R.nullTable (comparing nodeId)
-                                          (\s -> hashWithSalt s . nodeId)
-                                          (NodeInfo nid
-                                                    (fromMaybe (toEnum 0) $ fromSockAddr a)
-                                                    (fromMaybe 0 $ sockAddrPort a))
-                                          nobkts
-                    writeTVar tbl4 tbl
-                    writeTChan addr4 (a,map fst $ concat $ R.toList t4)
-                Nothing -> return ()
-        committee6 <- newTriadCommittee (writeTChan addr6) -- TODO: update tbl6
+        let updateIPVote tblvar addrvar a = do
+                bkts <- readTVar tblvar
+                case bep42 a (nodeId $ R.thisNode bkts) of
+                    Just nid -> do
+                        let tbl = R.nullTable (comparing nodeId)
+                                              (\s -> hashWithSalt s . nodeId)
+                                              (NodeInfo nid
+                                                        (fromMaybe (toEnum 0) $ fromSockAddr a)
+                                                        (fromMaybe 0 $ sockAddrPort a))
+                                              nobkts
+                        writeTVar tblvar tbl
+                        writeTChan addrvar (a,map fst $ concat $ R.toList bkts)
+                    Nothing -> return ()
+        committee4 <- newTriadCommittee $ updateIPVote tbl4 addr4
+        committee6 <- newTriadCommittee $ updateIPVote tbl6 addr6
         sched4 <- newTVar Int.empty
         sched6 <- newTVar Int.empty
         return $ Routing tenative_info sched4 tbl4 committee4 sched6 tbl6 committee6
@@ -583,6 +579,8 @@ newClient addr = do
             , clientResponseId    = return
             }
 
+    -- TODO: Provide some means of shutting down these four auxillary threads:
+
     fork $ fix $ \again -> do
         myThreadId >>= flip labelThread "addr4"
         (addr, ns) <- atomically $ readTChan addr4
@@ -591,8 +589,15 @@ newClient addr = do
             hPutStrLn stderr $ "Change IP, ping: "++show n
             ping outgoingClient n
         again
+    fork $ fix $ \again -> do
+        myThreadId >>= flip labelThread "addr6"
+        (addr,ns) <- atomically $ readTChan addr6
+        hPutStrLn stderr $ "External IPv6: "++show (addr, length ns)
+        forM_ ns $ \n -> do
+            hPutStrLn stderr $ "Change IP, ping: "++show n
+            ping outgoingClient n
+        again
 
-    -- TODO: Provide some means of shutting down these two auxillary threads:
     refresh_thread4 <- forkPollForRefresh
                             (15*60)
                             (sched4 routing)
@@ -617,8 +622,9 @@ newClient addr = do
 -- 84.124.73.14  65   1b0321 dd1bb1fe518101ceef99462b947a01ff 41
 -- 43.213.53.83  90   e56f6c bf5b7c4be0237986d5243b87aa6d5130 5a
 bep42 :: SockAddr -> NodeId -> Maybe NodeId
-bep42 addr (NodeId r)
- | Just ip <- fmap S.encode (fromSockAddr addr :: Maybe IPv4)
+bep42 addr0 (NodeId r)
+ | let addr = either id id $ either4or6 addr0 -- unmap 4mapped SockAddrs
+ , Just ip <- fmap S.encode (fromSockAddr addr :: Maybe IPv4)
               <|> fmap S.encode (fromSockAddr addr :: Maybe IPv6)
     = genBucketSample' retr (NodeId $ crc $ applyMask ip) (3,0x07,0)
  | otherwise