network-transport-tcp: conditionalie the peer host address check

Author: deepfire

infra/src/Pos/Infra/Diffusion/Transport/TCP.hs

@@ -21,26 +21,31 @@ import           Pos.Util.Trace (Trace, traceWith)
 --   - Given connection timeout in us
 --   - Given address (possibly unaddressable)
 --   - A fair QDisc
---   - Check the peer host against resolved host (prevents easy denial-of-service)
+--   - Optionally check the peer host against resolved host, which prevents easy
+--     denial-of-service attacks
 --   - Do not crash the server if 'accept' fails; instead, use the given
 --     'Trace' to log the reason and continue trying to accept new connections
 bracketTransportTCP
     :: Trace IO Text
     -> Microsecond
     -> TCP.TCPAddr
+    -> Bool
     -> (NT.Transport -> IO a)
     -> IO a
-bracketTransportTCP logTrace connectionTimeout tcpAddr k = bracket
-    (createTransportTCP logTrace connectionTimeout tcpAddr)
+bracketTransportTCP logTrace connectionTimeout tcpAddr checkPeerHost k = bracket
+    (createTransportTCP logTrace connectionTimeout tcpAddr checkPeerHost)
     NT.closeTransport
     k
 
 createTransportTCP
     :: Trace IO Text -- ^ Whenever there's an error accepting a new connection.
     -> Microsecond   -- ^ Connection timeout
     -> TCP.TCPAddr
+    -> Bool          -- ^ Whether to perform the TCP peer address consistency.
     -> IO NT.Transport
-createTransportTCP logTrace connectionTimeout addrInfo = do
+createTransportTCP logTrace connectionTimeout addrInfo checkPeerHost = do
+    unless checkPeerHost $ do
+      traceWith logTrace "DANGER: peer host address check disabled!  Node is vulnerable to DoS attacks."
     let tcpParams =
             (TCP.defaultTCPParameters
              { TCP.transportConnectTimeout =
@@ -49,7 +54,7 @@ createTransportTCP logTrace connectionTimeout addrInfo = do
              -- Will check the peer's claimed host against the observed host
              -- when new connections are made. This prevents an easy denial
              -- of service attack.
-             , TCP.tcpCheckPeerHost = True
+             , TCP.tcpCheckPeerHost = checkPeerHost
              , TCP.tcpServerExceptionHandler = \e ->
                    traceWith logTrace (sformat ("Exception in tcp server: " % shown) e)
              })

infra/src/Pos/Infra/Network/CLI.hs

@@ -78,6 +78,10 @@ data NetworkConfigOpts = NetworkConfigOpts
       -- address.
     , ncoExternalAddress :: !(Maybe NetworkAddress)
       -- ^ A node must be addressable on the network.
+    , ncoCheckPeerHost   :: !Bool
+      -- ^ Whether to perform the peer host address consistency check.
+      -- The check is necessary to avoid easy denial-of-service attacks,
+      -- but can be restrictive in certain scenarios.
     } deriving (Show)
 
 ----------------------------------------------------------------------------
@@ -123,6 +127,12 @@ networkConfigOption = do
             , Opt.metavar "FILEPATH"
             , Opt.help "Path to a YAML file containing the network policies"
             ]
+    ncoCheckPeerHost <- (not <$>) .
+        Opt.switch $
+        mconcat
+            [ Opt.long "disable-peer-host-check"
+            , Opt.help "DANGER: disable the peer host address consistency check. Makes your node vulnerable"
+            ]
     ncoExternalAddress <- optional $ externalNetworkAddressOption Nothing
     ncoBindAddress <- optional $ listenNetworkAddressOption Nothing
     pure $ NetworkConfigOpts {..}
@@ -375,6 +385,7 @@ intNetworkConfigOpts logTrace cfg@NetworkConfigOpts{..} = do
             , ncDequeuePolicy = dequeuePolicy
             , ncFailurePolicy = failurePolicy
             , ncTcpAddr       = tcpAddr
+            , ncCheckPeerHost = ncoCheckPeerHost
             }
 
     pure networkConfig

infra/src/Pos/Infra/Network/Types.hs

@@ -109,6 +109,10 @@ data NetworkConfig kademlia = NetworkConfig
     , ncTcpAddr       :: !TCP.TCPAddr
       -- ^ External TCP address of the node.
       -- It encapsulates both bind address and address visible to other nodes.
+    , ncCheckPeerHost :: !Bool
+      -- ^ Whether to perform the peer host address consistency check.
+      -- The check is necessary to avoid easy denial-of-service attacks,
+      -- but can be restrictive in certain scenarios.
     }
 
 instance Show kademlia => Show (NetworkConfig kademlia) where

lib/src/Pos/Diffusion/Full.hs

@@ -149,7 +149,7 @@ diffusionLayerFull fdconf networkConfig mEkgNodeMetrics mkLogic k = do
         logTrace :: Trace IO Text
         logTrace = contramap ((,) Error) $ named $
             appendName "transport" (fdcTrace fdconf)
-    bracketTransportTCP logTrace (fdcConvEstablishTimeout fdconf) (ncTcpAddr networkConfig) $ \transport -> do
+    bracketTransportTCP logTrace (fdcConvEstablishTimeout fdconf) (ncTcpAddr networkConfig) (ncCheckPeerHost networkConfig) $ \transport -> do
         rec (fullDiffusion, internals) <-
                 diffusionLayerFullExposeInternals fdconf
                                                   transport