Merge pull request #603 from thehajime/feature-sockopt-df

sockopt: add IP_DONTFRAG/IP_MTU_DISCOVER option

Author: kazu-yamamoto

Network/Socket.hs

@@ -167,6 +167,7 @@ module Network.Socket (
         RecvIPv4TTL,
         RecvIPv4TOS,
         RecvIPv4PktInfo,
+        DontFragment,
         RecvIPv6HopLimit,
         RecvIPv6TClass,
         RecvIPv6PktInfo

Network/Socket/Options.hsc

@@ -16,7 +16,7 @@ module Network.Socket.Options (
                 ,OOBInline,TimeToLive,MaxSegment,NoDelay,Cork,Linger,ReusePort
                 ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
                 ,UseLoopBack,UserTimeout,IPv6Only
-                ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo
+                ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo,DontFragment
                 ,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo
                 ,CustomSockOpt)
   , isSupportedSocketOption
@@ -94,6 +94,7 @@ socketOptionBijection =
     , (RecvIPv4TTL, "RecvIPv4TTL")
     , (RecvIPv4TOS, "RecvIPv4TOS")
     , (RecvIPv4PktInfo, "RecvIPv4PktInfo")
+    , (DontFragment, "DontFragment")
     , (IPv6Only, "IPv6Only")
     , (RecvIPv6HopLimit, "RecvIPv6HopLimit")
     , (RecvIPv6TClass, "RecvIPv6TClass")
@@ -352,6 +353,15 @@ pattern RecvIPv4PktInfo  = SockOpt (#const IPPROTO_IP) (#const IP_PKTINFO)
 #else
 pattern RecvIPv4PktInfo  = SockOpt (-1) (-1)
 #endif
+-- | IP_DONTFRAG
+pattern DontFragment :: SocketOption
+#if HAVE_DECL_IP_DONTFRAG
+pattern DontFragment   = SockOpt (#const IPPROTO_IP) (#const IP_DONTFRAG)
+#elif HAVE_DECL_IP_MTU_DISCOVER
+pattern DontFragment   = SockOpt (#const IPPROTO_IP) (#const IP_MTU_DISCOVER)
+#else
+pattern DontFragment   = SockOpt (-1) (-1)
+#endif
 #endif // HAVE_DECL_IPPROTO_IP
 
 #if HAVE_DECL_IPPROTO_IPV6

Network/Socket/Syscall.hs

@@ -83,6 +83,7 @@ socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
     -- This socket is not managed by the IO manager yet.
     -- So, we don't have to call "close" which uses "closeFdWith".
     unsetIPv6Only s
+    setDontFragment s
     return s
   where
     create = do
@@ -120,6 +121,15 @@ socket family stype protocol = E.bracketOnError create c_close $ \fd -> do
     unsetIPv6Only _ = return ()
 #endif
 
+    setDontFragment s = when (family == AF_INET) $
+#if HAVE_DECL_IP_DONTFRAG || HAVE_DECL_IP_MTU_DISCOVER
+      setSocketOption s DontFragment 1
+#else
+      -- do nothing
+      return ()
+#endif
+
+
 -----------------------------------------------------------------------------
 -- Binding a socket
 

configure.ac

@@ -86,6 +86,8 @@ AC_CHECK_DECLS([AI_ADDRCONFIG, AI_ALL, AI_NUMERICSERV, AI_V4MAPPED])
 AC_CHECK_DECLS([IPV6_V6ONLY])
 AC_CHECK_DECLS([IPPROTO_IP, IPPROTO_TCP, IPPROTO_IPV6])
 AC_CHECK_DECLS([SO_PEERCRED])
+AC_CHECK_DECLS([IP_DONTFRAG])
+AC_CHECK_DECLS([IP_MTU_DISCOVER])
 
 AC_CHECK_MEMBERS([struct msghdr.msg_control, struct msghdr.msg_accrights])
 AC_CHECK_MEMBERS([struct sockaddr.sa_len])

tests/Network/SocketSpec.hs

@@ -460,7 +460,7 @@ sockoptPatterns = nub
     ,TimeToLive,MaxSegment,NoDelay,Cork,Linger,ReusePort
     ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut
     ,UseLoopBack,UserTimeout,IPv6Only
-    ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo
+    ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo,DontFragment
     ,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo]
 
 cmsgidPatterns :: [CmsgId]