filter out spoofed requests for important operations like Join, Leave, Stabilise

src/Hash2Pub/DHTProtocol.hs

@@ -262,6 +262,7 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do
     case headMay . Set.elems $ msgSet of
       Nothing -> pure ()
       Just aPart -> do
+        let (SockAddrInet6 _ _ sourceIP _) = sourceAddr
         queueAddEntries (Identity $ RemoteCacheEntry (sender aPart) now) ns
         -- distinguish on whether and how to respond. If responding, pass message to response generating function and write responses to send queue
         maybe (pure ()) (
@@ -269,17 +270,36 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do
                         )
             =<< (case action aPart of
                 Ping -> Just <$> respondPing nsSTM msgSet
-                Join -> Just <$> respondJoin nsSTM msgSet
+                Join -> dropSpoofedIDs sourceIP nsSTM msgSet respondJoin
                 -- ToDo: figure out what happens if not joined
                 QueryID -> Just <$> respondQueryID nsSTM msgSet
                 -- only when joined
-                Leave -> if isJoined ns then Just <$> respondLeave nsSTM msgSet else pure Nothing
+                Leave -> if isJoined ns then dropSpoofedIDs sourceIP nsSTM msgSet respondLeave else pure Nothing
-                Stabilise -> if isJoined ns then Just <$> respondStabilise nsSTM msgSet else pure Nothing
+                Stabilise -> if isJoined ns then dropSpoofedIDs sourceIP nsSTM msgSet respondStabilise else pure Nothing
             )
       -- for single part request, response starts with part number 1. For multipart requests, response starts with part number n+1.
 
       -- TODO: determine request type only from first part, but catch RecSelError on each record access when folding, because otherwise different request type parts can make this crash
       -- TODO: test case: mixed message types of parts
+  where
+      -- | Filter out requests with spoofed node IDs by recomputing the ID using
+      -- the sender IP.
+      -- For valid (non-spoofed) sender IDs, the passed responder function is invoked.
+      dropSpoofedIDs :: HostAddress6        -- msg source address
+                     -> LocalNodeStateSTM s
+                     -> Set.Set FediChordMessage    -- message parts of the request
+                     -> (LocalNodeStateSTM s -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString))     -- reponder function to be invoked for valid requests
+                     -> IO (Maybe (Map.Map Integer BS.ByteString))
+      dropSpoofedIDs addr nsSTM' msgSet' responder =
+          let 
+            aRequestPart = Set.elemAt 0 msgSet
+            senderNs = sender aRequestPart
+            givenSenderID = getNid senderNs
+            recomputedID = genNodeID addr (getDomain senderNs) (fromInteger $ getVServerID senderNs)
+          in
+          if recomputedID == givenSenderID
+             then Just <$> responder nsSTM' msgSet'
+             else pure Nothing
 
 
 -- ....... response sending .......