Skip to content

Safer socket #336

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 3 commits into from
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
35 changes: 22 additions & 13 deletions Network/Socket/Syscall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,15 +6,14 @@
module Network.Socket.Syscall where

import Foreign.Marshal.Utils (with)
import qualified Control.Exception as E

#if defined(mingw32_HOST_OS)
import qualified Control.Exception as E
import Foreign (FunPtr)
import GHC.Conc (asyncDoProc)
#else
import Foreign.C.Error (getErrno, eINTR, eINPROGRESS)
import GHC.Conc (threadWaitWrite)
import GHC.IO (onException)
#endif

#ifdef HAVE_ADVANCED_SOCKET_FLAGS
Expand Down Expand Up @@ -73,20 +72,29 @@ socket :: Family -- Family Name (usually AF_INET)
-> ProtocolNumber -- Protocol Number (getProtocolByName to find value)
-> IO Socket -- Unconnected Socket
socket family stype protocol = do
c_stype <- packSocketTypeOrThrow "socket" stype
c_stype <- modifyFlag <$> packSocketTypeOrThrow "socket" stype
fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
c_socket (packFamily family) c_stype protocol
setNonBlock fd `E.onException` c_close fd
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Won't this result in a Socket with a closed file descriptor within its IORef?

s <- mkSocket fd
unsetIPv6Only s `E.onException` close s
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should these be closing and throwing? Otherwise socket will return a Socket that has already been closed and file descriptor re-use by the OS could lead to us accidentally sending to an unknown socket.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actually reuse is not an issue here since close changes it to -1, but is above with using vanilla c_close.

return s
where
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I like the improvement in readability of moving the ifdefs to where.


#ifdef HAVE_ADVANCED_SOCKET_FLAGS
let c_stype' = c_stype .|. sockNonBlock
modifyFlag c_stype = c_stype .|. sockNonBlock
#else
let c_stype' = c_stype
modifyFlag c_stype = c_stype
#endif
fd <- throwSocketErrorIfMinus1Retry "Network.Socket.socket" $
c_socket (packFamily family) c_stype' protocol
#ifndef HAVE_ADVANCED_SOCKET_FLAGS
setNonBlockIfNeeded fd

#ifdef HAVE_ADVANCED_SOCKET_FLAGS
setNonBlock _ = return ()
#else
setNonBlock fd = setNonBlockIfNeeded fd
#endif
s <- mkSocket fd

#if HAVE_DECL_IPV6_V6ONLY
when (family == AF_INET6 && stype `elem` [Stream, Datagram]) $
unsetIPv6Only s = when (family == AF_INET6 && stype `elem` [Stream, Datagram]) $
# if defined(mingw32_HOST_OS)
-- The IPv6Only option is only supported on Windows Vista and later,
-- so trying to change it might throw an error.
Expand All @@ -97,10 +105,11 @@ socket family stype protocol = do
# else
-- The default value of the IPv6Only option is platform specific,
-- so we explicitly set it to 0 to provide a common default.
setSocketOption s IPv6Only 0 `onException` close s
setSocketOption s IPv6Only 0
# endif
#else
unsetIPv6Only _ = return ()
#endif
return s

-----------------------------------------------------------------------------
-- Binding a socket
Expand Down
1 change: 1 addition & 0 deletions Network/Socket/Types.hsc
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,7 @@ module Network.Socket.Types (
, mkSocket
, invalidateSocket
, close
, c_close
-- * Types of socket
, SocketType(..)
, isSupportedSocketType
Expand Down