diff --git a/Network/Socket.hs b/Network/Socket.hs index 0c727fb2..71b23f28 100644 --- a/Network/Socket.hs +++ b/Network/Socket.hs @@ -167,6 +167,7 @@ module Network.Socket ( RecvIPv4TTL, RecvIPv4TOS, RecvIPv4PktInfo, + DontFragment, RecvIPv6HopLimit, RecvIPv6TClass, RecvIPv6PktInfo diff --git a/Network/Socket/Options.hsc b/Network/Socket/Options.hsc index cdc45474..44288e6b 100644 --- a/Network/Socket/Options.hsc +++ b/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 diff --git a/Network/Socket/Syscall.hs b/Network/Socket/Syscall.hs index fa6bb971..c7494b49 100644 --- a/Network/Socket/Syscall.hs +++ b/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 diff --git a/configure.ac b/configure.ac index c8e45cfc..2aa071d3 100644 --- a/configure.ac +++ b/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]) diff --git a/tests/Network/SocketSpec.hs b/tests/Network/SocketSpec.hs index f62e751e..b4491617 100644 --- a/tests/Network/SocketSpec.hs +++ b/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]