Ticket #1212: ipv6.patch

File ipv6.patch, 32.5 KB (added by bos@…, 8 years ago)
  • cbits/winSockAddr.c

    diff -urN --exclude=_darcs n/cbits/winSockAddr.c n6/cbits/winSockAddr.c
    n n6  
     1#include "HsNet.h"
     2#include "HsFFI.h"
     3
     4#if defined(HAVE_WINSOCK_H) && defined(IPV6_SOCKET_SUPPORT) && !defined(__CYGWIN__)
     5
     6#include <stdio.h>
     7#include <string.h>
     8#include <sys/types.h>
     9#include <sys/socket.h>
     10#include <netdb.h>
     11
     12const char *inet_ntop(int af, const void *src, char *dst, socklen_t cnt)
     13{
     14  if (af == AF_INET) {
     15    struct sockaddr_in in;
     16    memset(&in, 0, sizeof(in));
     17    in.sin_family = AF_INET;
     18    memcpy(&in.sin_addr, src, sizeof(struct in_addr));
     19    getnameinfo((struct sockaddr *) &in, sizeof(struct sockaddr_in), dst, cnt,
     20                NULL, 0, NI_NUMERICHOST);
     21    return dst;
     22  }
     23  else if (af == AF_INET6) {
     24    struct sockaddr_in6 in;
     25    memset(&in, 0, sizeof(in));
     26    in.sin6_family = AF_INET6;
     27    memcpy(&in.sin6_addr, src, sizeof(struct in_addr6));
     28    getnameinfo((struct sockaddr *) &in, sizeof(struct sockaddr_in6),
     29                dst, cnt, NULL, 0, NI_NUMERICHOST);
     30    return dst;
     31  }
     32  return NULL;
     33}
     34
     35int inet_pton(int af, const char *src, void *dst)
     36{
     37  struct addrinfo hints, *res, *ressave;
     38
     39  memset(&hints, 0, sizeof(struct addrinfo));
     40  hints.ai_family = af;
     41
     42  if (getaddrinfo(src, NULL, &hints, &res) != 0) {
     43    return -1;
     44  }
     45
     46  ressave = res;
     47
     48  while (res) {
     49    memcpy(dst, res->ai_addr, res->ai_addrlen);
     50    res = res->ai_next;
     51  }
     52
     53  freeaddrinfo(ressave);
     54  return 0;
     55}
     56
     57#endif
  • configure.ac

    diff -urN --exclude=_darcs n/configure.ac n6/configure.ac
    n n6  
    3535 AC_MSG_RESULT(no))
    3636
    3737dnl --------------------------------------------------
     38dnl * test for in6_addr as proxy for IPv6 support
     39dnl --------------------------------------------------
     40AC_MSG_CHECKING(for in6_addr in netinet/in.h)
     41AC_EGREP_HEADER(in6_addr, netinet/in.h,
     42 [ AC_DEFINE([HAVE_IN6_ADDR], [1], [Define to 1 if in6_addr is available.]) AC_MSG_RESULT(yes) ],
     43 AC_MSG_RESULT(no))
     44
     45dnl --------------------------------------------------
    3846dnl * test for Linux sendfile(2)
    3947dnl --------------------------------------------------
    4048AC_MSG_CHECKING(for sendfile in sys/sendfile.h)
  • include/HsNet.h

    diff -urN --exclude=_darcs n/include/HsNet.h n6/include/HsNet.h
    n n6  
    2626# endif
    2727#endif
    2828
     29#ifdef HAVE_IN6_ADDR
     30# define IPV6_SOCKET_SUPPORT 1
     31#else
     32# undef IPV6_SOCKET_SUPPORT
     33#endif
     34
    2935#if defined(HAVE_WINSOCK_H) && !defined(__CYGWIN__)
    3036#include <winsock.h>
    3137
  • Makefile

    diff -urN --exclude=_darcs n/Makefile n6/Makefile
    n n6  
    2323
    2424# Only bother with cbits/initWinSock.c when it's really needed.
    2525ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32"
    26 EXTRA_SRCS += cbits/initWinSock.c cbits/winSockErr.c cbits/asyncAccept.c
     26EXTRA_SRCS += cbits/initWinSock.c cbits/winSockAddr.c cbits/winSockErr.c cbits/asyncAccept.c
    2727Network/Socket_HC_OPTS += -DCALLCONV=stdcall
    2828else
    2929EXTRA_SRCS += cbits/ancilData.c
  • Network/BSD.hsc

    diff -urN --exclude=_darcs n/Network/BSD.hsc n6/Network/BSD.hsc
    n n6  
    2525    HostName,
    2626    getHostName,            -- :: IO HostName
    2727
     28#if defined(IPV6_SOCKET_SUPPORT)
     29    AddrInfo(..),
     30
     31    AddrInfoFlags,
     32    aI_PASSIVE,
     33    aI_CANONNAME,
     34    aI_NUMERICHOST,
     35    aI_ADDRCONFIG,
     36
     37    #ifdef AI_ALL
     38    aI_ALL,
     39    #endif
     40    #ifdef AI_V4MAPPED
     41    aI_V4MAPPED,
     42    #endif
     43    #ifdef AI_NUMERICSERV
     44    aI_NUMERICSERV,
     45    #endif
     46    #ifdef AI_IDN
     47    aI_IDN,
     48    #endif
     49    #ifdef AI_CANONIDN
     50    aI_CANONIDN,
     51    #endif
     52    #ifdef AI_IDN_ALLOW_UNASSIGNED
     53    aI_IDN_ALLOW_UNASSIGNED,
     54    #endif
     55    #ifdef AI_IDN_USE_STD3_ASCII_RULES
     56    aI_IDN_USE_STD3_ASCII_RULES,
     57    #endif
     58
     59    #ifdef AI_NON_AUTHORITATIVE
     60    aI_NON_AUTHORITATIVE,
     61    #endif
     62    #ifdef AI_SECURE
     63    aI_SECURE,
     64    #endif
     65    #ifdef AI_RETURN_PREFERRED_NAMES
     66    aI_RETURN_PREFERRED_NAMES,
     67    #endif
     68
     69    defaultHints,           -- :: AddrInfo
     70    getAddrInfo,            -- :: Maybe AddrInfo -> Maybe HostName -> Maybe ServiceName -> IO [AddrInfo]
     71
     72    NameInfoFlags,
     73    nI_NOFQDN,
     74    nI_NUMERICHOST,
     75    nI_NAMEREQD,
     76    nI_NUMERICSERV,
     77    nI_DGRAM,
     78
     79    getNameInfo,            -- :: NameInfoFlags -> Bool -> Bool -> SockAddr -> IO (Maybe HostName, Maybe ServiceName)
     80#endif
     81
     82    -- ** Deprecated host name information
     83
     84    -- | These types and functions can only handle IPv4 protocols.
     85    -- For cleaner, protocol-independent interfaces to this
     86    -- information, use 'getAddrInfo' and 'getNameInfo'.
     87
    2888    HostEntry(..),
    2989    getHostByName,          -- :: HostName -> IO HostEntry
    3090    getHostByAddr,          -- :: HostAddress -> Family -> IO HostEntry
     
    3999#endif
    40100
    41101    -- * Service names
    42     ServiceEntry(..),
    43102    ServiceName,
     103
     104    -- ** Deprecated service-related information
     105
     106    -- | For cleaner, protocol-independent interfaces to this
     107    -- information, use 'getAddrInfo' and 'getNameInfo'.
     108
     109    ServiceEntry(..),
    44110    getServiceByName,       -- :: ServiceName -> ProtocolName -> IO ServiceEntry
    45111    getServiceByPort,       -- :: PortNumber  -> ProtocolName -> IO ServiceEntry
    46112    getServicePortNumber,   -- :: ServiceName -> IO PortNumber
    47113
    48114#if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32)
    49115    getServiceEntries,      -- :: Bool -> IO [ServiceEntry]
    50     -- ** Low level functionality
     116    -- *** Low level functionality
     117    -- | /Note/: Use 'getAddrInfo' instead of these functions in new code.
    51118    getServiceEntry,        -- :: IO ServiceEntry
    52119    setServiceEntry,        -- :: Bool -> IO ()
    53120    endServiceEntry,        -- :: IO ()
     
    56123    -- * Protocol names
    57124    ProtocolName,
    58125    ProtocolNumber,
     126
    59127    ProtocolEntry(..),
    60128    getProtocolByName,      -- :: ProtocolName   -> IO ProtocolEntry
    61129    getProtocolByNumber,    -- :: ProtocolNumber -> IO ProtcolEntry
     
    64132
    65133#if !defined(cygwin32_HOST_OS) && !defined(mingw32_HOST_OS) && !defined(_WIN32)
    66134    getProtocolEntries,     -- :: Bool -> IO [ProtocolEntry]
    67     -- ** Low level functionality
     135    -- *** Low level functionality
    68136    setProtocolEntry,       -- :: Bool -> IO ()
    69137    getProtocolEntry,       -- :: IO ProtocolEntry
    70138    endProtocolEntry,       -- :: IO ()
     
    73141    -- * Port numbers
    74142    PortNumber,
    75143
    76     -- * Network names
     144    -- * Network names (deprecated)
     145
     146    -- | These types and functions can only handle IPv4 protocols.
     147
    77148    NetworkName,
    78149    NetworkAddr,
    79150    NetworkEntry(..)
     
    100171import Foreign.C.Types ( CInt, CULong, CChar, CSize, CShort )
    101172import Foreign.Ptr ( Ptr, nullPtr )
    102173import Foreign.Storable ( Storable(..) )
     174import Foreign.Marshal.Alloc ( alloca, allocaBytes )
    103175import Foreign.Marshal.Array ( allocaArray0, peekArray0 )
    104176import Foreign.Marshal.Utils ( with, fromBool )
    105177import Data.Typeable
     
    169241   poke p = error "Storable.poke(BSD.ServiceEntry) not implemented"
    170242
    171243
    172 -- | Get service by name.
     244-- | Get service by name.  /Note/: Use 'getAddrInfo' instead in new
     245-- code.
    173246getServiceByName :: ServiceName         -- Service Name
    174247                 -> ProtocolName        -- Protocol Name
    175248                 -> IO ServiceEntry     -- Service Entry
     
    183256foreign import ccall unsafe "getservbyname"
    184257  c_getservbyname :: CString -> CString -> IO (Ptr ServiceEntry)
    185258
    186 -- | Get the service given a 'PortNumber' and 'ProtocolName'.
     259-- | Get the service given a 'PortNumber' and 'ProtocolName'.  /Note/:
     260-- Use 'getAddrInfo' or 'getNameInfo' instead in new code.
    187261getServiceByPort :: PortNumber -> ProtocolName -> IO ServiceEntry
    188262getServiceByPort (PortNum port) proto = withLock $ do
    189263 withCString proto $ \ cstr_proto -> do
     
    194268foreign import ccall unsafe "getservbyport"
    195269  c_getservbyport :: CInt -> CString -> IO (Ptr ServiceEntry)
    196270
    197 -- | Get the 'PortNumber' corresponding to the 'ServiceName'.
     271-- | Get the 'PortNumber' corresponding to the 'ServiceName'.  /Note/:
     272-- Use 'getAddrInfo' instead in new code.
    198273getServicePortNumber :: ServiceName -> IO PortNumber
    199274getServicePortNumber name = do
    200275    (ServiceEntry _ _ port _) <- getServiceByName name "tcp"
     
    328403#endif
    329404
    330405-- ---------------------------------------------------------------------------
     406-- IPv6 host info
     407
     408#if defined(IPV6_SOCKET_SUPPORT)
     409
     410-- | Flags that control the querying behaviour of 'getAddrInfo'.  You
     411-- can logical-/or/ or add these together to control several
     412-- behaviours at once.
     413
     414type AddrInfoFlags = CInt
     415
     416-- Portable flags.
     417
     418-- | Portable.  Affects behaviour if the hostname provided to
     419-- 'getAddrInfo' is 'Nothing'.  If set, the network address in each
     420-- returned 'SockAddr' will be a "wild card", i.e. either 'iNADDR_ANY'
     421-- (for IPv4) or 'iN6ADDR_ANY' (for IPv6).  Otherwise, the address
     422-- used will be the loopback interface.
     423
     424aI_PASSIVE :: AddrInfoFlags
     425aI_PASSIVE                  = (#const AI_PASSIVE)
     426
     427-- | Portable.  If the hostname value provided to 'getAddrInfo' is not
     428-- 'Nothing', the 'addrCanonName' field of the first 'AddrInfo'
     429-- returned will contain the "canonical name" of the host.
     430
     431aI_CANONNAME :: AddrInfoFlags
     432aI_CANONNAME                = (#const AI_CANONNAME)
     433
     434-- | Portable.  Ensures that potentially slow network name lookups
     435-- will not be attempted by 'getAddrInfo'.  Requires that if the
     436-- hostname argument is not 'Nothing', it must be a numeric address in
     437-- string form (dotted quad for IPv4, colon-separated hex for IPv6).
     438
     439aI_NUMERICHOST :: AddrInfoFlags
     440aI_NUMERICHOST              = (#const AI_NUMERICHOST)
     441
     442-- | Portable.  The list of returned 'AddrInfo' values will contain
     443-- IPv4 addresses only if the local system has at least one IPv4
     444-- interface configured, and will contain IPv6 addresses only if the
     445-- local system has at least one IPv6 interface configured.
     446
     447aI_ADDRCONFIG :: AddrInfoFlags
     448aI_ADDRCONFIG               = (#const AI_ADDRCONFIG)
     449
     450-- Linux-specific flags.
     451
     452#ifdef AI_V4MAPPED
     453-- | Linux only.  If the 'aI_V4MAPPED' flag is set, and the
     454-- 'addrFamily' field is specified as 'AF_INET6', and no matching IPv6
     455-- addresses could be found, then 'getAddrInfo' will return
     456-- IPv4-mapped IPv6 addresses.
     457
     458aI_V4MAPPED :: AddrInfoFlags
     459aI_V4MAPPED                 = (#const AI_V4MAPPED)
     460#endif
     461
     462#ifdef AI_ALL
     463-- | Linux only.  If the 'aI_V4MAPPED' flag is set, then 'getAddrInfo'
     464-- will return both IPv6 and IPv4-mapped IPv6 addresses.
     465
     466aI_ALL :: AddrInfoFlags
     467aI_ALL                      = (#const AI_ALL)
     468#endif
     469
     470#ifdef AI_NUMERICSERV
     471
     472-- | If the 'Maybe' 'ServiceName' argument to 'getAddrInfo' is not
     473-- 'Nothing', then it must contain a numeric port number.  This flag
     474-- ensures that a name resolution service will not be used.
     475
     476aI_NUMERICSERV :: AddrInfoFlags
     477aI_NUMERICSERV              = (#const AI_NUMERICSERV)
     478#endif
     479#ifdef AI_IDN
     480aI_IDN :: AddrInfoFlags
     481aI_IDN                      = (#const AI_IDN)
     482#endif
     483#ifdef AI_CANONIDN
     484aI_CANONIDN :: AddrInfoFlags
     485aI_CANONIDN                 = (#const AI_CANONIDN)
     486#endif
     487#ifdef AI_IDN_ALLOW_UNASSIGNED
     488aI_IDN_ALLOW_UNASSIGNED :: AddrInfoFlags
     489aI_IDN_ALLOW_UNASSIGNED     = (#const AI_IDN_ALLOW_UNASSIGNED)
     490#endif
     491#ifdef AI_IDN_USE_STD3_ASCII_RULES
     492aI_IDN_USE_STD3_ASCII_RULES :: AddrInfoFlags
     493aI_IDN_USE_STD3_ASCII_RULES = (#const AI_IDN_USE_STD3_ASCII_RULES)
     494#endif
     495                   
     496-- Windows-specific flags.
     497
     498#ifdef AI_NON_AUTHORITATIVE
     499aI_NON_AUTHORITATIVE :: AddrInfoFlags
     500aI_NON_AUTHORITATIVE        = (#const AI_NON_AUTHORITATIVE)
     501#endif
     502#ifdef AI_SECURE
     503aI_SECURE :: AddrInfoFlags
     504aI_SECURE                   = (#const AI_SECURE)
     505#endif
     506#ifdef AI_RETURN_PREFERRED_NAMES
     507aI_RETURN_PREFERRED_NAMES :: AddrInfoFlags
     508aI_RETURN_PREFERRED_NAMES   = (#const AI_RETURN_PREFERRED_NAMES)
     509#endif
     510
     511data AddrInfo =
     512    AddrInfo {
     513        addrFlags :: AddrInfoFlags,
     514        addrFamily :: Family,
     515        addrSocketType :: SocketType,
     516        addrProtocol :: ProtocolNumber,
     517        addrAddress :: SockAddr,
     518        addrCanonName :: Maybe String
     519        }
     520    deriving (Show)
     521
     522INSTANCE_TYPEABLE0(AddrInfo,addrInfoTc,"AddrInfo")
     523
     524instance Storable AddrInfo where
     525    sizeOf    _ = #const sizeof(struct addrinfo)
     526    alignment _ = alignment (undefined :: CInt)
     527
     528    peek p = do
     529        ai_flags <- (#peek struct addrinfo, ai_flags) p
     530        ai_family <- (#peek struct addrinfo, ai_family) p
     531        ai_socktype <- (#peek struct addrinfo, ai_socktype) p
     532        ai_protocol <- (#peek struct addrinfo, ai_protocol) p
     533        ai_addr <- (#peek struct addrinfo, ai_addr) p >>= peekSockAddr
     534        ai_canonname_ptr <- (#peek struct addrinfo, ai_canonname) p
     535
     536        ai_canonname <- if ai_canonname_ptr == nullPtr
     537                        then return Nothing
     538                        else liftM Just $ peekCString ai_canonname_ptr
     539                             
     540        return (AddrInfo
     541                {
     542                 addrFlags = ai_flags,
     543                 addrFamily = unpackFamily ai_family,
     544                 addrSocketType = unpackSocketType ai_socktype,
     545                 addrProtocol = ai_protocol,
     546                 addrAddress = ai_addr,
     547                 addrCanonName = ai_canonname
     548                })
     549
     550    poke p (AddrInfo flags family socketType protocol _ _) = do
     551        (#poke struct addrinfo, ai_flags) p flags
     552        (#poke struct addrinfo, ai_family) p (packFamily family)
     553        (#poke struct addrinfo, ai_socktype) p (packSocketType socketType)
     554        (#poke struct addrinfo, ai_protocol) p protocol
     555
     556        -- stuff below is probably not needed, but let's zero it for safety
     557
     558        (#poke struct addrinfo, ai_addrlen) p (0::CSize)
     559        (#poke struct addrinfo, ai_addr) p nullPtr
     560        (#poke struct addrinfo, ai_canonname) p nullPtr
     561        (#poke struct addrinfo, ai_next) p nullPtr
     562
     563-- | Flags that control the querying behaviour of 'getNameInfo'.  You
     564-- can logical-/or/ or add these together to control several
     565-- behaviours at once.
     566
     567type NameInfoFlags = CInt
     568
     569-- | Tell 'getNameInfo' to return only the node name part of the FQDN
     570-- for local hosts.
     571
     572nI_NOFQDN :: NameInfoFlags
     573nI_NOFQDN = (#const NI_NOFQDN)
     574
     575-- | Cause 'getNameInfo' to return the numeric form of a node name,
     576-- and to not perform a name service query.  (The numeric form of an
     577-- address may be returned even if this flag is not set, but only if
     578-- the node's name cannot be looked up.)
     579
     580nI_NUMERICHOST :: NameInfoFlags
     581nI_NUMERICHOST = (#const NI_NUMERICHOST)
     582
     583-- | Make 'getNameInfo' throw an IO exception, instead of returning a
     584-- numeric address, if the node's name cannot be looked up.
     585
     586nI_NAMEREQD :: NameInfoFlags
     587nI_NAMEREQD = (#const NI_NAMEREQD)
     588
     589-- | Tell 'getNameInfo' to return a service address in numeric form,
     590-- so that it will not perform a name service lookup.
     591
     592nI_NUMERICSERV :: NameInfoFlags
     593nI_NUMERICSERV = (#const NI_NUMERICSERV)
     594
     595-- | Indicate to 'getNameInfo' that the service being looked up is
     596-- datagram based.  This only affects a few port numbers (512 to 514)
     597-- for which the stream protocol is different from the datagram
     598-- protocol.
     599
     600nI_DGRAM :: NameInfoFlags
     601nI_DGRAM = (#const NI_DGRAM)
     602#endif
     603
     604-- ---------------------------------------------------------------------------
    331605-- Host lookups
    332606
    333607data HostEntry =
     
    371645   []    -> error ("BSD.hostAddress: empty network address list for " ++ nm)
    372646   (x:_) -> x
    373647
     648#if defined(IPV6_SOCKET_SUPPORT)
     649
     650withMaybeString :: Maybe String -> (CString -> IO a) -> IO a
     651withMaybeString Nothing f = f nullPtr
     652withMaybeString (Just s) f = withCString s f
     653
     654withMaybeAddrInfo :: Maybe AddrInfo -> (Ptr AddrInfo -> IO a) -> IO a
     655withMaybeAddrInfo Nothing f = f nullPtr
     656withMaybeAddrInfo (Just a) f = allocaBytes (sizeOf a) $ \b -> poke b a >> f b
     657
     658-- | Default hints for address lookup with 'getAddrInfo'.
     659--
     660--   [@'addrFlags'@] No flags set.
     661--
     662--   [@'addrFamily'@] Set to 'AF_UNSPEC'.
     663--
     664--   [@'addrSocketType'@] Set to 'NoSocketType'.
     665--
     666--   [@'addrProtocol'@] Set to 'defaultProtocol'.
     667--
     668--   [@'addrAddress'@] Set to 'undefined'.  Never used by 'getAddrInfo'.
     669--
     670--   [@'addrCanonName'@] Set to 'undefined'.  Never used by 'getAddrInfo'.
     671
     672defaultHints :: AddrInfo
     673
     674defaultHints = AddrInfo {
     675                         addrFlags = 0,
     676                         addrFamily = AF_UNSPEC,
     677                         addrSocketType = NoSocketType,
     678                         addrProtocol = defaultProtocol,
     679                         addrAddress = undefined,
     680                         addrCanonName = undefined
     681                        }
     682
     683-- | Protocol-independent translation of a node or service name query to one or more addresses.
     684-- The 'AddrInfo' values that this function returns contain 'SockAddr'
     685-- values that you can pass directly to 'connect' or
     686-- 'bindSocket'.
     687--
     688-- The 'Maybe' 'AddrInfo' argument, if not 'Nothing', specifies one or
     689-- more of the preferred query behaviour, socket family or type, or
     690-- protocol.  If you provide 'Nothing', the defaults are as for
     691-- 'defaultHints'.  Please see 'AddrInfoFlags' for important flags
     692-- that control the behaviour of this function.
     693--
     694-- (Note: This function will not use the 'addrAddress' or
     695-- 'addrCanonName' fields, so it is safe to use 'undefined' for those
     696-- values.)
     697--
     698-- You can conveniently override the default behaviour of this
     699-- function using Haskell's record update syntax on 'defaultHints',
     700-- for example as follows:
     701--
     702-- > myHints = defaultHints { addrFlags = aI_ADDRCONFIG + aI_CANONNAME }
     703--
     704-- You may provide 'Nothing' for either the 'Maybe' 'HostName' or
     705-- 'Maybe' 'ServiceName' argument, but at least one must /not/ be
     706-- 'Nothing'.
     707--
     708-- The 'Maybe' 'HostName' argument causes the network address in the
     709-- embedded 'SockAddr' of each returned 'AddrInfo' to be filled out.
     710-- The 'HostName' can be either a numeric network address (dotted quad
     711-- for IPv4, colon-separated hex for IPv6) or a node name.
     712--
     713-- The 'Maybe' 'ServiceName' argument causes the port number in the
     714-- embedded 'SockAddr' of each returned 'AddrInfo' to be filled out.
     715--
     716-- If the query fails, this function throws an IO exception instead of
     717-- returning an empty list.  Otherwise, it returns a non-empty list
     718-- of 'AddrInfo' values.
     719--
     720-- There are several reasons why a query might result in more than one
     721-- value.  For example, the queried-for node could be multihomed, or
     722-- the service might be available via several protocols.
     723--
     724-- Here is a simple example of a network client.  It will
     725-- automatically use either IPv6 or IPv4 sockets to connect to the
     726-- remote node, depending on the configurations of both the local and
     727-- remote nodes.
     728--
     729-- > httpConnect :: HostName -> IO Socket
     730-- > httpConnect nodeName = do
     731-- >   let hints = defaultHints { addrFlags = aI_ADDRCONFIG,
     732-- >                              addrSocketType = Stream }
     733-- >   addrs <- getAddrInfo (Just hints) (Just nodeName) (Just "http")
     734-- >   let addr = head addrs
     735-- >   sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)
     736-- >   connect sock (addrAddress addr)
     737-- >   return sock
     738
     739getAddrInfo :: Maybe AddrInfo -- ^ preferred query behaviour
     740            -> Maybe HostName -- ^ host name to look up
     741            -> Maybe ServiceName -- ^ service name to look up
     742            -> IO [AddrInfo] -- ^ resolved addresses, with "best" first
     743
     744getAddrInfo hints node service =
     745  withMaybeString node $ \c_node ->
     746    withMaybeString service $ \c_service ->
     747      withMaybeAddrInfo hints $ \c_hints ->
     748        alloca $ \ptr_ptr_addrs -> do
     749          ret <- c_getaddrinfo c_node c_service c_hints ptr_ptr_addrs
     750          case ret of
     751            0 -> do
     752              ptr_addrs <- peek ptr_ptr_addrs
     753              ais <- unwindAddrInfo ptr_addrs
     754              c_freeaddrinfo ptr_addrs
     755              return ais
     756            _ -> do err <- gai_strerror ret
     757                    ioError (IOError Nothing NoSuchThing "getAddrInfo" err
     758                             Nothing)
     759
     760unwindAddrInfo :: Ptr AddrInfo -> IO [AddrInfo]
     761
     762unwindAddrInfo ptr_ai | ptr_ai == nullPtr = return []
     763                      | otherwise = do
     764    a <- peek ptr_ai
     765    as <- (#peek struct addrinfo, ai_next) ptr_ai >>= unwindAddrInfo
     766    return (a:as)
     767
     768foreign import ccall safe "getaddrinfo"
     769    c_getaddrinfo :: CString -> CString -> Ptr AddrInfo -> Ptr (Ptr AddrInfo)
     770                  -> IO CInt
     771
     772foreign import ccall safe "freeaddrinfo"
     773    c_freeaddrinfo :: Ptr AddrInfo -> IO ()
     774
     775gai_strerror :: CInt -> IO String
     776
     777gai_strerror n = c_gai_strerror n >>= peekCString
     778
     779foreign import ccall safe "gai_strerror"
     780    c_gai_strerror :: CInt -> IO CString
     781
     782maybeWithCString :: Bool -> Int -> (CSize -> CString -> IO a) -> IO a
     783maybeWithCString False _ f = f 0 nullPtr
     784maybeWithCString True n f = allocaBytes n (f (fromIntegral n))
     785                   
     786-- | Protocol-independent translation of an address to a node name and
     787-- service name.
     788--
     789-- The 'NameInfoFlags' argument provides control over aspects of the
     790-- querying behaviour.
     791--
     792-- The first 'Bool' argument determines whether a node name lookup
     793-- will be performed.  If this is 'False', the 'Maybe' 'HostName' in
     794-- the result will be 'Nothing'.
     795--
     796-- The second 'Bool' argument determines whether a service name lookup
     797-- will be performed.  If this is 'False', the 'Maybe' 'ServiceName' in
     798-- the result will be 'Nothing'.
     799--
     800-- At least one of these 'Bool' arguments must be 'True'.
     801
     802getNameInfo :: NameInfoFlags    -- ^ control query behaviours
     803            -> Bool             -- ^ look up host name
     804            -> Bool             -- ^ look up service name
     805            -> SockAddr         -- ^ address to look up
     806            -> IO (Maybe HostName, Maybe ServiceName)
     807
     808getNameInfo flags doHost doService addr =
     809  maybeWithCString doHost (#const NI_MAXHOST) $ \c_hostlen c_host ->
     810    maybeWithCString doService (#const NI_MAXSERV) $ \c_servlen c_serv -> do
     811      withSockAddr addr $ \ptr_addr sz -> do
     812        ret <- c_getnameinfo ptr_addr (fromIntegral sz) c_host c_hostlen
     813                             c_serv c_servlen flags
     814        case ret of
     815          0 -> do
     816            let slurp doIf c_val = if doIf
     817                                     then liftM Just $ peekCString c_val
     818                                     else return Nothing
     819            host <- slurp doHost c_host
     820            serv <- slurp doService c_serv
     821            return (host, serv)
     822          _ -> do err <- gai_strerror ret
     823                  ioError (IOError Nothing NoSuchThing "getNameInfo" err
     824                           Nothing)
     825
     826foreign import ccall safe "getnameinfo"
     827    c_getnameinfo :: Ptr SockAddr -> CInt{-CSockLen???-} -> CString -> CSize -> CString
     828                  -> CSize -> NameInfoFlags -> IO CInt
     829#endif
     830
    374831-- getHostByName must use the same lock as the *hostent functions
    375832-- may cause problems if called concurrently.
    376833
    377 -- | Resolve a 'HostName' to IPv4 address.
     834-- | Resolve a 'HostName' to an IPv4 address.  /Note/: you should not use
     835-- this function if you are writing new code, as it only works with
     836-- IPv4 addresses.  Instead, use 'getAddrInfo', which works with both
     837-- IPv4 and IPv6 addresses.
    378838getHostByName :: HostName -> IO HostEntry
    379839getHostByName name = withLock $ do
    380840  withCString name $ \ name_cstr -> do
     
    387847
    388848
    389849-- The locking of gethostbyaddr is similar to gethostbyname.
     850
    390851-- | Get a 'HostEntry' corresponding to the given address and family.
    391 -- Note that only IPv4 is currently supported.
     852-- /Note/: you should not use this function if you are writing new
     853-- code, as it only works with IPv4 addresses.  Instead, use
     854-- 'getNameInfo', which works with both IPv4 and IPv6 addresses.
    392855getHostByAddr :: Family -> HostAddress -> IO HostEntry
    393856getHostByAddr family addr = do
    394857 with addr $ \ ptr_addr -> withLock $ do
  • Network/Socket.hsc

    diff -urN --exclude=_darcs n/Network/Socket.hsc n6/Network/Socket.hsc
    n n6  
    5151    SockAddr(..),
    5252    SocketStatus(..),
    5353    HostAddress,
     54#if defined(IPV6_SOCKET_SUPPORT)
     55    HostAddress6,
     56    FlowInfo,
     57    ScopeID,
     58#endif
    5459    ShutdownCmd(..),
    5560    ProtocolNumber,
    5661    PortNumber(..),
     
    120125    -- * Special Constants
    121126    aNY_PORT,           -- :: PortNumber
    122127    iNADDR_ANY,         -- :: HostAddress
     128#if defined(IPV6_SOCKET_SUPPORT)
     129    iN6ADDR_ANY,        -- :: HostAddress6
     130#endif
    123131    sOMAXCONN,          -- :: Int
    124132    sOL_SOCKET,         -- :: Int
    125133#ifdef SCM_RIGHTS
     
    145153    -- should not be used anywhere else.
    146154
    147155    packFamily, unpackFamily,
    148     packSocketType,
     156    packSocketType, unpackSocketType,
     157    peekSockAddr, withSockAddr,
    149158    throwSocketErrorIfMinus1_
    150159
    151160) where
     
    164173#endif
    165174
    166175import Data.Word ( Word8, Word16, Word32 )
    167 import Foreign.Ptr ( Ptr, castPtr, plusPtr )
     176import Foreign.Ptr ( Ptr, castPtr, nullPtr, plusPtr )
    168177import Foreign.Storable ( Storable(..) )
    169178import Foreign.C.Error
    170179import Foreign.C.String ( withCString, peekCString, peekCStringLen, castCharToCChar )
     
    260269--       will have to perform the necessary translation.
    261270type HostAddress = Word32
    262271
     272#if defined(IPV6_SOCKET_SUPPORT)
     273type HostAddress6 = (Word32, Word32, Word32, Word32)
     274#endif
     275
    263276----------------------------------------------------------------------------
    264277-- Port Numbers
    265278--
     
    330343
    331344-- To represent these socket addresses in Haskell-land, we do what BSD
    332345-- didn't do, and use a union/algebraic type for the different
    333 -- families. Currently only Unix domain sockets and the Internet family
    334 -- are supported.
     346-- families. Currently only Unix domain sockets and the Internet
     347-- families are supported.
     348
     349#if defined(IPV6_SOCKET_SUPPORT)
     350type FlowInfo = Word32
     351type ScopeID = Word32
     352#endif
    335353
    336354data SockAddr           -- C Names                             
    337355  = SockAddrInet
    338356        PortNumber      -- sin_port  (network byte order)
    339357        HostAddress     -- sin_addr  (ditto)
     358#if defined(IPV6_SOCKET_SUPPORT)
     359  | SockAddrInet6
     360        PortNumber      -- sin6_port (network byte order)
     361        FlowInfo        -- sin6_flowinfo (ditto)
     362        HostAddress6    -- sin6_addr (ditto)
     363        ScopeID         -- sin6_scope_id (ditto)
     364#endif
    340365#if defined(DOMAIN_SOCKET_SUPPORT)
    341366  | SockAddrUnix
    342367        String          -- sun_path
     
    361386   = showString (unsafePerformIO (inet_ntoa ha))
    362387   . showString ":"
    363388   . shows port
     389#if defined(IPV6_SOCKET_SUPPORT)
     390  showsPrec _ (SockAddrInet6 port flow host scope)
     391   = showChar '['
     392   . showString (unsafePerformIO (inet_ntop host))
     393   . showString "]:"
     394   . shows port
     395
     396instance Storable HostAddress6 where
     397    sizeOf _    = (#const sizeof(struct in6_addr))
     398    alignment _ = alignment (undefined :: CInt)
     399
     400    peek p = do
     401        a <- (#peek struct in6_addr, s6_addr32[0]) p
     402        b <- (#peek struct in6_addr, s6_addr32[1]) p
     403        c <- (#peek struct in6_addr, s6_addr32[2]) p
     404        d <- (#peek struct in6_addr, s6_addr32[3]) p
     405        return (a, b, c, d)
     406
     407    poke p (a, b, c, d) = do
     408        (#poke struct in6_addr, s6_addr32[0]) p a
     409        (#poke struct in6_addr, s6_addr32[1]) p b
     410        (#poke struct in6_addr, s6_addr32[2]) p c
     411        (#poke struct in6_addr, s6_addr32[3]) p d
     412#endif
    364413
    365414-- we can't write an instance of Storable for SockAddr, because the Storable
    366415-- class can't easily handle alternatives. Also note that on Darwin, the
     
    382431        (#poke struct sockaddr_in, sin_family) p ((#const AF_INET) :: CSaFamily)
    383432        (#poke struct sockaddr_in, sin_port) p port
    384433        (#poke struct sockaddr_in, sin_addr) p addr     
     434#if defined(IPV6_SOCKET_SUPPORT)
     435pokeSockAddr p (SockAddrInet6 (PortNum port) flow addr scope) = do
     436#if defined(darwin_TARGET_OS)
     437        zeroMemory p (#const sizeof(struct sockaddr_in6))
     438#endif
     439        (#poke struct sockaddr_in6, sin6_family) p ((#const AF_INET6) :: CSaFamily)
     440        (#poke struct sockaddr_in6, sin6_port) p port
     441        (#poke struct sockaddr_in6, sin6_flowinfo) p flow
     442        (#poke struct sockaddr_in6, sin6_addr) p addr   
     443        (#poke struct sockaddr_in6, sin6_scope_id) p scope
     444#endif
     445
     446peekSockAddr :: Ptr SockAddr -> IO SockAddr
    385447
    386448peekSockAddr p = do
    387449  family <- (#peek struct sockaddr, sa_family) p
     
    395457                addr <- (#peek struct sockaddr_in, sin_addr) p
    396458                port <- (#peek struct sockaddr_in, sin_port) p
    397459                return (SockAddrInet (PortNum port) addr)
     460#if defined(IPV6_SOCKET_SUPPORT)
     461        (#const AF_INET6) -> do
     462                port <- (#peek struct sockaddr_in6, sin6_port) p
     463                flow <- (#peek struct sockaddr_in6, sin6_flowinfo) p
     464                addr <- (#peek struct sockaddr_in6, sin6_addr) p
     465                scope <- (#peek struct sockaddr_in6, sin6_scope_id) p
     466                return (SockAddrInet6 (PortNum port) flow addr scope)
     467#endif
    398468
    399469-- helper function used to zero a structure
    400470zeroMemory :: Ptr a -> CSize -> IO ()
     
    412482sizeOfSockAddr (SockAddrUnix _)   = #const sizeof(struct sockaddr_un)
    413483#endif
    414484sizeOfSockAddr (SockAddrInet _ _) = #const sizeof(struct sockaddr_in)
     485#if defined(IPV6_SOCKET_SUPPORT)
     486sizeOfSockAddr (SockAddrInet6 _ _ _ _) = #const sizeof(struct sockaddr_in6)
     487#endif
    415488
    416489withSockAddr :: SockAddr -> (Ptr SockAddr -> Int -> IO a) -> IO a
    417490withSockAddr addr f = do
     
    795868socketPort sock@(MkSocket _ AF_INET _ _ _) = do
    796869    (SockAddrInet port _) <- getSocketName sock
    797870    return port
     871#if defined(IPV6_SOCKET_SUPPORT)
     872socketPort sock@(MkSocket _ AF_INET6 _ _ _) = do
     873    (SockAddrInet6 port _ _ _) <- getSocketName sock
     874    return port
     875#endif
    798876socketPort (MkSocket _ family _ _ _) =
    799877    ioError (userError ("socketPort: not supported for Family " ++ show family))
    800878
     
    11321210packFamily      :: Family -> CInt
    11331211
    11341212packSocketType  :: SocketType -> CInt
     1213unpackSocketType:: CInt -> SocketType
    11351214
    11361215-- | Address Families.
    11371216--
     
    17741853        SeqPacket -> #const SOCK_SEQPACKET
    17751854#endif
    17761855
     1856unpackSocketType t = case t of
     1857        0 -> NoSocketType
     1858#ifdef SOCK_STREAM
     1859        (#const SOCK_STREAM) -> Stream
     1860#endif
     1861#ifdef SOCK_DGRAM
     1862        (#const SOCK_DGRAM) -> Datagram
     1863#endif
     1864#ifdef SOCK_RAW
     1865        (#const SOCK_RAW) -> Raw
     1866#endif
     1867#ifdef SOCK_RDM
     1868        (#const SOCK_RDM) -> RDM
     1869#endif
     1870#ifdef SOCK_SEQPACKET
     1871        (#const SOCK_SEQPACKET) -> SeqPacket
     1872#endif
     1873
    17771874-- ---------------------------------------------------------------------------
    17781875-- Utility Functions
    17791876
     
    17831880iNADDR_ANY :: HostAddress
    17841881iNADDR_ANY = htonl (#const INADDR_ANY)
    17851882
     1883#if defined(IPV6_SOCKET_SUPPORT)
     1884iN6ADDR_ANY :: HostAddress6
     1885iN6ADDR_ANY = (0, 0, 0, 0)
     1886#endif
     1887
    17861888sOMAXCONN :: Int
    17871889sOMAXCONN = #const SOMAXCONN
    17881890
     
    18761978    then ioError (userError ("inet_addr: Malformed address: " ++ ipstr))
    18771979    else return had  -- network byte order
    18781980
     1981-- This typeclass is internal.  "Real code" should be using
     1982-- getAddrInfo and getNameInfo instead of inet_ntop and inet_pton.
     1983
     1984class HostAddr a where
     1985    inet_ntop :: a -> IO String
     1986
     1987instance HostAddr HostAddress where
     1988    inet_ntop = inet_ntoa
     1989
     1990#if defined(IPV6_SOCKET_SUPPORT)
     1991instance HostAddr HostAddress6 where
     1992    inet_ntop = inet_ntop6
     1993
     1994inet_ntop6 :: HostAddress6 -> IO String
     1995inet_ntop6 src =
     1996   allocaBytes (sizeOf src) $ \c_src -> do
     1997     poke c_src src
     1998     let sz = (#const INET6_ADDRSTRLEN)
     1999     allocaBytes (fromIntegral sz) $ \c_dst -> do
     2000       ret <- c_inet_ntop (#const AF_INET6) c_src c_dst sz
     2001       if ret == nullPtr
     2002         then throwErrno "inet_ntop"
     2003         else peekCString c_dst
     2004#endif
     2005
    18792006inet_ntoa :: HostAddress -> IO String
    18802007inet_ntoa haddr = do
    18812008  pstr <- c_inet_ntoa haddr
     
    19532080-- ---------------------------------------------------------------------------
    19542081-- foreign imports from the C library
    19552082
     2083#if defined(IPV6_SOCKET_SUPPORT)
     2084foreign import ccall safe "inet_ntop"
     2085  c_inet_ntop :: CInt -> Ptr a -> Ptr CChar -> CInt{-CSockLen???-} -> IO (Ptr CChar)
     2086
     2087foreign import ccall safe "inet_pton"
     2088  c_inet_pton :: CInt -> Ptr CChar -> Ptr a -> IO CInt
     2089#endif
     2090
    19562091foreign import ccall unsafe "my_inet_ntoa"
    19572092  c_inet_ntoa :: HostAddress -> IO (Ptr CChar)
    19582093
  • network.cabal

    diff -urN --exclude=_darcs n/network.cabal n6/network.cabal
    n n6  
    11name:           network
    2 version:        2.0
     2version:        2.0.1
    33license:        BSD3
    44license-file:   LICENSE
    55maintainer:     [email protected]
     
    1313                include/HsNet.h include/Typeable.h
    1414                -- C sources only used on some systems
    1515                cbits/ancilData.c
    16                 cbits/asyncAccept.c cbits/initWinSock.c cbits/winSockErr.c
     16                cbits/asyncAccept.c cbits/initWinSock.c
     17                cbits/winSockAddr.c cbits/winSockErr.c
    1718extra-tmp-files:
    1819                config.log config.status autom4te.cache
    1920                network.buildinfo include/HsNetworkConfig.h