Detect a global ipv6 address via "ip" command.

1 files changed, 34 insertions, 16 deletions

diff --git a/Mainline.hs b/Mainline.hs
index deb75079..6aa1c517 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -77,6 +77,7 @@ import Control.Exception    (SomeException (..), handle)
 import qualified Data.Aeson as JSON
          ;import Data.Aeson (FromJSON, ToJSON, (.=))
 import Text.Read
+import Global6
 
 newtype NodeId = NodeId ByteString
  deriving (Eq,Ord,ByteArrayAccess, Bits, Hashable)
@@ -524,17 +525,24 @@ newClient :: SockAddr -> IO (MainlineClient, Routing, SwarmsDatabase)
 newClient addr = do
     udp <- udpTransport addr
     nid <- NodeId <$> getRandomBytes 20
-    let tenative_info = NodeInfo
+    let tentative_info = NodeInfo
                 { nodeId   = nid
                 , nodeIP   = fromMaybe (toEnum 0) $ fromSockAddr addr
                 , nodePort = fromMaybe 0 $ sockAddrPort addr
                 }
+    tentative_info6 <-
+        maybe tentative_info
+              (\ip6 -> tentative_info { nodeId = fromMaybe (nodeId tentative_info)
+                                                    $ bep42 (toSockAddr ip6) (nodeId tentative_info)
+                                      , nodeIP = IPv6 ip6
+                                      })
+            <$> global6
     addr4 <- atomically $ newTChan
     addr6 <- atomically $ newTChan
     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
+        tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info nobkts
+        tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info6 nobkts
         let updateIPVote tblvar addrvar a = do
                 bkts <- readTVar tblvar
                 case bep42 a (nodeId $ R.thisNode bkts) of
@@ -552,7 +560,7 @@ newClient addr = do
         committee6 <- newTriadCommittee $ updateIPVote tbl6 addr6
         sched4 <- newTVar Int.empty
         sched6 <- newTVar Int.empty
-        return $ Routing tenative_info sched4 tbl4 committee4 sched6 tbl6 committee6
+        return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6
     swarms <- newSwarmsDatabase
     map_var <- atomically $ newTVar (0, mempty)
     let net = onInbound (updateRouting outgoingClient routing)
@@ -619,11 +627,11 @@ newClient addr = do
     refresh_thread4 <- forkPollForRefresh
                             (15*60)
                             (sched4 routing)
-                            (refreshBucket (nodeSearch client) (routing4 routing) (nodeId tenative_info))
+                            (refreshBucket (nodeSearch client) (routing4 routing))
     refresh_thread6 <- forkPollForRefresh
                             (15*60)
                             (sched6 routing)
-                            (refreshBucket (nodeSearch client) (routing6 routing) (nodeId tenative_info))
+                            (refreshBucket (nodeSearch client) (routing6 routing))
 
     return (client, routing, swarms)
 
@@ -705,13 +713,15 @@ updateRouting client routing naddr msg = do
         Want_IP6 -> go (routing6 routing) (committee6 routing) (sched6 routing)
  where
     go tbl committee sched = do
-        case msg of
-            R { rspReflectedIP = Just sockaddr }
-                -> do
-                    -- hPutStrLn stderr $ "External: "++show (nodeId naddr,sockaddr)
-                    atomically $ addVote committee (nodeId naddr) sockaddr
-            _   -> return ()
-        insertNode (mainlineKademlia client committee tbl sched) naddr
+        self <- atomically $ R.thisNode <$> readTVar tbl
+        when (nodeIP self /= nodeIP naddr) $ do
+            case msg of
+                R { rspReflectedIP = Just sockaddr }
+                    -> do
+                        -- hPutStrLn stderr $ "External: "++show (nodeId naddr,sockaddr)
+                        atomically $ addVote committee (nodeId naddr) sockaddr
+                _   -> return ()
+            insertNode (mainlineKademlia client committee tbl sched) naddr
 
 data Ping = Ping deriving Show
 
@@ -809,11 +819,19 @@ ipFamily ip = case ip of
 findNodeH :: Routing -> NodeInfo -> FindNode -> IO NodeFound
 findNodeH routing addr (FindNode node iptyp) = do
     let preferred = prefer4or6 addr iptyp
-    ks  <- bool (return []) (go $ routing4 routing) (preferred /= Want_IP6)
-    ks6 <- bool (return []) (go $ routing6 routing) (preferred /= Want_IP4)
+
+    (append4,append6) <- atomically $ do
+        ni4 <- R.thisNode <$> readTVar (routing4 routing)
+        ni6 <- R.thisNode <$> readTVar (routing6 routing)
+        return $ case ipFamily (nodeIP addr) of
+            Want_IP4 -> (id, (++ [ni6]))
+            Want_IP6 -> ((++ [ni4]), id)
+    ks  <- bool (return []) (go append4 $ routing4 routing) (preferred /= Want_IP6)
+    ks6 <- bool (return []) (go append6 $ routing6 routing) (preferred /= Want_IP4)
     return $ NodeFound ks ks6
  where
-    go var = R.kclosest mainlineSpace k node <$> atomically (readTVar var)
+    go f var = f . R.kclosest mainlineSpace k node <$> atomically (readTVar var)
+
     k = R.defaultK