Ticket #1212: ipv6.patch

File ipv6.patch, 32.5 KB (added by bos@…, 7 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:     libraries@haskell.org 
     
    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