[m-rev.] diff: extras/ Update the net library

Paul Bone paul at bone.id.au
Mon Sep 29 09:57:42 AEST 2014


extras/ Update the net library

This library had been neglected for a while and came to my attention when it
used deprecated (or at least old) C interfaces rather than newer reentrant
ones.  I've started to improve this library by giving a more typesafe and
Mercury-esque API, using only reentrant C functions, and eventually adding
support for more protocols, (eg: IPv6 and UDP) better integration with
Mercury's io module and generally making it easier to use.

What's working now:

    + creating sockets,
    + binding and listening,
    + connecting (untested),
    + accepting,
    + closing.
    + The interface is generally more type-safe, using new types suck as
      "socket" and "address" rather than "int" and "c_pointer".

What's not working/incomplete:

    + I havn't yet touched the tcp.m module, but I intend to remove it and
      create a new high-level interface for various protocols.
    + Any kind of reading / writing over sockets at all.
    + Name lookups.
    + A lot of the interface is incomplete / missing useful functions and
      predicates.

This is a work in progress.

Makefile:
    New Makefile.

README.md:
    New Readme file.

net.m:
    net is now a module containing the other modules as submodules.

sockets.m:
    Many changes as described above.

netdb.m:
    This new module contains host and other name lookups.  Only service
    lookups are currently implemented.

types.m:
    Types shared by sockets.m and netdb.m.

echo.m:
    An example echo server.

errno.m:
    strerror functionality.

tcp.m:
    Conform to changes in net.m.
---
 extras/net/Makefile  |  24 ++++
 extras/net/README.md |  69 ++++++++++
 extras/net/echo.m    |  96 +++++++++++++
 extras/net/errno.m   |  53 ++++++++
 extras/net/net.m     |  12 +-
 extras/net/netdb.m   | 332 +++++++++++++++++++++++++++++++++++++++++++++
 extras/net/sockets.m | 377 ++++++++++++++++++++-------------------------------
 extras/net/tcp.m     |   2 +-
 extras/net/types.m   | 253 ++++++++++++++++++++++++++++++++++
 9 files changed, 985 insertions(+), 233 deletions(-)
 create mode 100644 extras/net/Makefile
 create mode 100644 extras/net/README.md
 create mode 100644 extras/net/echo.m
 create mode 100644 extras/net/errno.m
 create mode 100644 extras/net/netdb.m
 create mode 100644 extras/net/types.m

diff --git a/extras/net/Makefile b/extras/net/Makefile
new file mode 100644
index 0000000..f9d3f67
--- /dev/null
+++ b/extras/net/Makefile
@@ -0,0 +1,24 @@
+# vim: noet ts=4 sw=4
+#-----------------------------------------------------------------------------#
+# Copyright (C) 2014 The Mercury Team
+# This file may only be copied under the terms of the GNU Library General
+# Public Licence - see the file COPYING in the Mercury distribution.
+#-----------------------------------------------------------------------------#
+
+MMC=mmc
+MTAGS=mtags
+MCFLAGS=-O3 --intermodule-optimization --use-grade-subdirs --grade hlc.gc
+
+
+MERCURY_FILES=$(wildcard *.m)
+
+all : libnet.so echo
+
+libnet.so : $(MERCURY_FILES)
+	$(MMC) $(MCFLAGS) --make libnet
+
+echo : $(MERCURY_FILES)
+	$(MMC) $(MCFLAGS) --make echo
+
+tags : $(MERCURY_FILES)
+	$(MTAGS) $(MERCURY_FILES)
diff --git a/extras/net/README.md b/extras/net/README.md
new file mode 100644
index 0000000..52dd960
--- /dev/null
+++ b/extras/net/README.md
@@ -0,0 +1,69 @@
+Networking Library
+==================
+
+This library is inteded to provide support for networking with both 1) a
+simple binding around the BSD sockets interface 2) a higher-level set of
+predicates and functions for common patterns.  This is a work in progress
+and many things are unimplemented.
+
+Copying
+-------
+
+Copyright (C) 2014 The Mercury Team
+This file may only be copied under the terms of the GNU Library General
+Public Licence - see the file COPYING in the Mercury distribution.
+
+TODO
+----
+
+    + Currently no method is provided to connect these sockets to the
+      standard libraries IO or stream modules.
+    + sendmsg()/recvmsg().
+    + Cross platform functionality (Only tested on Linux so far).
+    + Non blocking support.
+    + Improved name lookup / reverse lookup
+    + Network layer:
+
+        + IPv6
+        + Unix domain sockets
+
+    + Protocol layer:
+
+        + UDP
+        + SCTP
+
+    + High level interface
+
+
+Modules
+-------
+
+    + net.
+
+        Main library module
+
+    + net.types.
+
+        Common datatypes
+
+    + net.sockets.
+
+        Sockets predicates.  This includes the most fundermental operations
+        such as listen/connect.
+
+    + net.netdb.
+
+        Network name lookups.
+
+    + net.tcp
+
+        Deprecated module.
+
+    + net.errno
+
+        Internal module with errno functionality.
+
+    + echo
+
+        An example echo server (incomplete).
+
diff --git a/extras/net/echo.m b/extras/net/echo.m
new file mode 100644
index 0000000..e1a5866
--- /dev/null
+++ b/extras/net/echo.m
@@ -0,0 +1,96 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2014 The Mercury Team.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% Module: echo 
+% Main Author:  Paul Bone <paul at bone.id.au>
+%
+% A simple echo server.
+%
+% Because the sockets library can't yet connect to the io module we cannot
+% yet read or write to and from sockets.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module echo.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module list.
+:- import_module maybe.
+:- import_module require.
+:- import_module string.
+
+:- import_module net.
+:- import_module net.sockets.
+:- import_module net.types.
+
+main(!IO) :-
+    socket(fam_inet, sock_stream, ResSocket, !IO),
+    (
+        ResSocket = ok(Socket),
+        bind(Socket, ipv4_sockaddr(in_addr_any, 6969), ResBind, !IO),
+        (
+            ResBind = ok,
+            listen(Socket, 5, ResListen, !IO),
+            (
+                ResListen = ok,
+                run(Socket, !IO)
+            ;
+                ResListen = error(Error),
+                unexpected($file, $pred, "listen failed: " ++ Error)
+            )
+        ;
+            ResBind = error(Error),
+            unexpected($file, $pred, "bind failed: " ++ Error)
+        ),
+        close(Socket, ResClose, !IO),
+        (
+            ResClose = ok
+        ;
+            ResClose = error(Error),
+            unexpected($file, $pred, "close failed: " ++ Error)
+        )
+    ;
+        ResSocket = error(Error),
+        unexpected($file, $pred, "create socket failed: " ++ Error)
+    ).
+
+:- pred run(socket::in, io::di, io::uo) is det.
+
+run(Socket, !IO) :-
+    accept(Socket, Result, !IO),
+    (
+        Result = ok(accept_result(NewSocket, Address)),
+        ( ipv4_sockaddr(InAddr, Port, Address) ->
+            io.format("Connection from %s port %d\n",
+                [s(to_string(InAddr)), i(Port)], !IO)
+        ;
+            io.format("Connection from unknown peer family: %s\n",
+                [s(string(family(Address)))], !IO)
+        ),
+        close(NewSocket, CloseRes, !IO),
+        (
+            CloseRes = ok
+        ;
+            CloseRes = error(Error),
+            unexpected($file, $pred, "create socket failed: " ++ Error)
+        )
+    ;
+        Result = error(Error),
+        unexpected($file, $pred, "create socket failed: " ++ Error)
+    ),
+    run(Socket, !IO).
+
diff --git a/extras/net/errno.m b/extras/net/errno.m
new file mode 100644
index 0000000..f3cdc42
--- /dev/null
+++ b/extras/net/errno.m
@@ -0,0 +1,53 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2014 The Mercury Team.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% Module: errno.
+% Main Author:  Paul Bone <paul at bone.id.au>
+% Stability:    low
+%
+% Provide an interface to the C errno type and functions.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module net.errno.
+
+:- interface.
+
+:- import_module int.
+:- import_module string.
+
+:- type errno == int.
+
+:- func strerror(errno) = string.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
+    % Errno handling.
+    %
+strerror(Errno) = String :-
+    strerror(Errno, String).
+
+:- pred strerror(int::in, string::uo) is det.
+
+:- pragma foreign_proc("C",
+    strerror(Errno::in, Str::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+    char errbuf[MR_STRERROR_BUF_SIZE];
+
+    MR_make_aligned_string_copy(Str,
+        MR_strerror(Errno, errbuf, sizeof(errbuf)));
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
diff --git a/extras/net/net.m b/extras/net/net.m
index 33b7829..0392876 100644
--- a/extras/net/net.m
+++ b/extras/net/net.m
@@ -4,8 +4,18 @@
 % Public License - see the file COPYING.LIB
 %---------------------------------------------------------------------------%
 :- module net.
+
 :- interface.
+
+:- include_module netdb.
+:- include_module sockets.
+:- include_module tcp.
+:- include_module types.
+
 :- pred version(string::out) is det.
+
 :- implementation.
-:- import_module sockets, tcp.
+
+:- include_module errno.
+
 version("DEV").
diff --git a/extras/net/netdb.m b/extras/net/netdb.m
new file mode 100644
index 0000000..8021d7e
--- /dev/null
+++ b/extras/net/netdb.m
@@ -0,0 +1,332 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2014 The Mercury Team
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% Module: netdb 
+% Main Author:  Paul Bone <paul at bone.id.au>
+% Stability:    low
+%
+% Provide an interface to the POSIX C interface for network lookups.
+%
+% This interface uses the more modern getaddrinfo(2) interface rather than
+% the old and not-thread-safe gethostbyname(2) interface.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module net.netdb.
+
+:- interface.
+
+:- import_module int.
+:- import_module io.
+:- import_module list.
+:- import_module maybe.
+:- import_module string.
+
+%-----------------------------------------------------------------------------%
+
+:- type protocol
+    --->    protocol(
+                p_name          :: string,
+                p_aliases       :: list(string),
+                p_num           :: protocol_num
+            ).
+
+:- type protocol_num == int.
+
+    % Lookup a protocol entry by name.
+    %
+:- pred getprotobyname(string::in, maybe(protocol)::out,
+    io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+
+:- type addrinfo.
+
+%-----------------------------------------------------------------------------%
+
+%:- pred gethostbyname(string::in, res(hostent)::out,
+%    io::di, io::uo) is det.
+
+%:- pred getservbyname(string::in, string::in, int::out,
+%    io::di, io::uo) is det.
+
+    % port_address(Host, Port, Result, !IO),
+    %
+    % Lookup a hostname and build an address structure with the resulting
+    % address and the given port.
+    %
+:- pragma obsolete(port_address/5).
+:- pred port_address(string::in, int::in, maybe_error(c_pointer)::out,
+    io::di, io::uo) is det.
+
+    % service_address(Host, Service, Result, !IO),
+    %
+:- pragma obsolete(service_address/5).
+:- pred service_address(string::in, string::in,
+    maybe_error(c_pointer)::out, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module bool.
+:- import_module require.
+
+:- import_module net.errno.
+
+:- pragma foreign_decl("C",
+"
+#include <netdb.h>
+").
+
+:- pragma foreign_decl("C", local,
+"
+#ifdef MR_WIN32
+  #define  error()      WSAGetLastError()
+#else
+  #define  error()      errno
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+
+getprotobyname(Name, MaybeProtocol, !IO) :-
+    getprotobyname_c(buffer_size, Name, CProtocol, Success, Found, !IO),
+    (
+        Success = yes,
+        (
+            Found = yes,
+            c_protocol_to_protocol(CProtocol, Protocol),
+            MaybeProtocol = yes(Protocol)
+        ;
+            Found = no,
+            MaybeProtocol = no
+        )
+    ;
+        Success = no,
+        % A buffer size of 1024 bytes was insufficent for a protocol name,
+        % protocols are usually 3 letters long like "tcp".
+        unexpected($file, $pred, "Buffer too small")
+    ).
+
+:- pred getprotobyname_c(int::in, string::in, protocol_c::out, bool::out,
+    bool::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    getprotobyname_c(BufferSize::in, Name::in, Protocol::out, Success::out,
+        Found::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+    int result;
+    struct protoent *temp = MR_GC_NEW(struct protoent);
+    char *buffer = MR_GC_malloc_atomic(BufferSize);
+
+    result = getprotobyname_r(Name, temp, buffer, BufferSize, &Protocol);
+    Success = result == 0 ? MR_YES : MR_NO;
+    Found = Protocol != NULL ? MR_YES : MR_NO;
+").
+
+%-----------------------------------------------------------------------------%
+
+:- type protocol_c.
+:- pragma foreign_type("C", protocol_c, "struct protoent*",
+    [can_pass_as_mercury_type]).
+
+:- pred c_protocol_to_protocol(protocol_c::in, protocol::uo) is det.
+
+c_protocol_to_protocol(CProto, Proto) :-
+    c_protocol_get_name(CProto, OfficialName),
+    c_protocol_get_aliases(CProto, Aliases),
+    c_protocol_get_number(CProto, Number),
+    Proto = protocol(OfficialName, Aliases, Number).
+
+:- pred c_protocol_get_name(protocol_c::in, string::uo) is det.
+
+:- pragma foreign_proc("C",
+    c_protocol_get_name(Proto::in, Name::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+    "MR_make_aligned_string_copy_saved_hp(Name, Proto->p_name, NULL);").
+
+:- pred c_protocol_get_aliases(protocol_c::in, list(string)::uo) is det.
+
+:- pragma foreign_proc("C",
+    c_protocol_get_aliases(Proto::in, List::uo),
+    [may_call_mercury, promise_pure, thread_safe],
+"
+    List = MR_list_empty();
+    int i = 0;
+
+    while (Proto->p_aliases[i] != NULL) {
+        MR_String str;
+        MR_make_aligned_string_copy_saved_hp(str, Proto->p_aliases[i], NULL);
+        List = MR_list_cons((MR_Word)str, List);
+        i++;
+    }
+").
+
+:- pred c_protocol_get_number(protocol_c::in, int::uo) is det.
+
+:- pragma foreign_proc("C",
+    c_protocol_get_number(Proto::in, Number::uo),
+    [will_not_call_mercury, promise_pure, thread_safe],
+    "Number = Proto->p_proto;").
+
+%-----------------------------------------------------------------------------%
+
+%
+% We box the pointer to addrinfo since these structures are allocated using
+% malloc, we use an extra layer of indirection to use a Boehm GC pointer
+% with a finalizer to free the underlying malloc object.
+%
+:- pragma foreign_type("C",
+    addrinfo,
+    "struct addrinfo**",
+    [can_pass_as_mercury_type]).
+
+%-----------------------------------------------------------------------------%
+
+%gethostbyname(Name, Result, !IO) :-
+%    gethostbyname_c(Name, Hostent, Success, Error, !IO),
+%    (
+%        Success = yes,
+%        Result = ok(Hostent)
+%    ;
+%        Success = no,
+%        Result = error(Error)
+%    ).
+%
+%:- pred gethostbyname(string::in, hostent::out, bool::out, string::out,
+%    io::di, io::uo) is det.
+%
+%:- pragma foreign_proc(c,
+%    gethostbyname_c(Name::in, Host::out, _IO0::di, _IO::uo),
+%     [will_not_call_mercury, promise_pure, tabled_for_io],
+%"
+%    /*
+%     * Not thread safe.
+%     */
+%    struct hostent  *host;
+%    Host = gethostbyname(Name);
+%    Host = (MR_String) host->h_name;
+%").
+%
+%%-----------------------------------------------------------------------------%
+%
+%:- pragma foreign_proc(c,
+%    getservbyname(Name::in, Protocol::in, Port::out, _IO0::di, _IO::uo),
+%     [will_not_call_mercury, promise_pure, tabled_for_io],
+%"
+%    struct servent *service;
+%    service = getservbyname(Name, Protocol);
+%    if (service != NULL) {
+%        Port = (MR_Integer) ntohs(service->s_port);
+%    } else {
+%        Port = -1;
+%    }
+%").
+
+%-----------------------------------------------------------------------------%
+
+port_address(Host, Port, MaybeSA, !IO) :-
+    port_address(Host, Port, SA, Success, Errno, !IO),
+    (
+        Success = yes,
+        MaybeSA = ok(SA)
+    ;
+        Success = no,
+        MaybeSA = error(strerror(Errno))
+    ).
+
+:- pred port_address(string::in, int::in, c_pointer::out,  bool::out,
+    int::out, io::di, io::uo) is det.
+
+    % XXX Not thread safe as this uses gethostbyname
+    %
+:- pragma foreign_proc("C",
+    port_address(Host::in, Port::in, SA::out, Success::out, Errno::out,
+        _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct hostent *host;
+    struct sockaddr_in *addr;
+
+    host = gethostbyname(Host);
+    if (host == NULL) {
+        Errno = error();
+        Success = MR_NO;
+    } else {
+        addr = MR_GC_NEW(struct sockaddr_in);
+
+        MR_memcpy(&(addr->sin_addr), host->h_addr_list[0], host->h_length);
+        addr->sin_family = host->h_addrtype;
+        addr->sin_port = htons(Port);
+
+        SA = (MR_Word) addr;
+        Success = MR_YES;
+    }
+").
+
+%-----------------------------------------------------------------------------%
+
+service_address(Service, Host, MaybeSA, !IO) :-
+    service_address(Service, Host, SA, Success, Errno, !IO),
+    (
+        Success = yes,
+        MaybeSA = ok(SA)
+    ;
+        Success = no,
+        MaybeSA = error(strerror(Errno))
+    ).
+
+:- pred service_address(string::in, string::in, c_pointer::out,
+    bool::out, int::out, io::di, io::uo) is det.
+
+    % XXX Not thread safe as this uses gethostbyname and getservbyname.
+    %
+:- pragma foreign_proc("C",
+    service_address(Service::in, Host::in, SA::out, Success::out,
+        Errno::out, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+    struct hostent *host;
+    struct servent *service;
+    struct sockaddr_in *addr;
+
+    host = gethostbyname(Host);
+    if (host == NULL) {
+        Errno = error();
+        Success = MR_NO;
+    } else {
+        service = getservbyname(Service,""tcp"");
+
+        if (service == NULL) {
+            Errno = error();
+            Success = MR_NO;
+        } else {
+            addr = MR_GC_NEW(struct sockaddr_in);
+            MR_memcpy(&(addr->sin_addr), host->h_addr_list[0], host->h_length);
+            addr->sin_family = host->h_addrtype;
+            addr->sin_port = service->s_port;
+            SA = (MR_Word) addr;
+            Success = MR_YES;
+        }
+    }
+").
+
+%-----------------------------------------------------------------------------%
+
+    % The initial length of buffers for strings (suggested by
+    % getprotobyname_r(3).
+    %
+:- func buffer_size = int.
+
+buffer_size = 1024.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
diff --git a/extras/net/sockets.m b/extras/net/sockets.m
index e2f4b47..9376368 100644
--- a/extras/net/sockets.m
+++ b/extras/net/sockets.m
@@ -7,98 +7,98 @@
 %-----------------------------------------------------------------------------%
 %
 % Module: sockets
-% Main Author:  pro at missioncriticalit.com
-%               (based on code written by pma at missioncriticalit.com)
-% Stability:    low
+% Main Author:          pro at missioncriticalit.com
+%                       (based on code written by pma at missioncriticalit.com)
+% Largely rewritten by: Paul Bone
+% Stability:            low
 %
 % Provide a low-level interface to sockets.
-% The more declarative interface is provided by the module tcp.
 %
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- module sockets.
+:- module net.sockets.
 :- interface.
 
 :- import_module io.
+:- import_module maybe.
 
-%-----------------------------------------------------------------------------%
-
-:- type res(T)
-    --->    ok(T)
-    ;       error(string).
-
-:- type res
-    --->    ok
-    ;       error(string).
+:- import_module net.netdb.
+:- import_module net.types.
 
 %-----------------------------------------------------------------------------%
 
-    % gethostbyname(Hostname, RealName, !IO),
+    % The socket family.  This type is incomplete, support for socket
+    % families such as IPX or appletalk will probably never be added.
+    % However Unix domain sockets may be added in the future.
     %
-    % Note, this does not return the address of the host, it returns the
-    % "official name of the host" gethostbyname(3), this may be a mistake.
+:- type family
+    --->    fam_inet
+    ;       fam_inet6.
+
+    % The socket type.  Informally (for fam_inet and fam_inet6) these
+    % correspond to TCP and UDP respectively.  More precicely these specify
+    % the socket's behavour, the protocol is optionally specified
+    % seperately.
     %
-:- pred gethostbyname(string::in, string::out, io::di, io::uo) is det.
+:- type socktype
+    --->    sock_stream
+    ;       sock_dgram.
 
-    % getservbyname(ServiceName, Protocol, PortNum, !IO),
-    %
-    % Lookup the port number for a service name (eg "http") and a protocol
-    % (eg "tcp").  If the service was not found then -1 is returned.
-    %
-:- pred getservbyname(string::in, string::in, int::out, io::di, io::uo) is det.
+:- type socket.
+
+%-----------------------------------------------------------------------------%
 
     % socket(Domain, Type, Protocol, Result, !IO),
     %
     % Create a new socket.
     %
-:- pred socket(int::in, int::in, int::in, sockets.res(int)::out,
-    io::di, io::uo) is det.
+:- pred socket(family::in, socktype::in, protocol_num::in,
+    maybe_error(socket)::out, io::di, io::uo) is det.
 
-    % port_address(Host, Port, Result, !IO),
+    % socket(Domain, Type, Result, !IO),
     %
-    % Lookup a hostname and build an address structure with the resulting
-    % address and the given port.
+    % Create a new socket, use this variant to have the sockets library
+    % detect the correct protocal (usually the only protocol).
     %
-:- pred port_address(string::in, int::in, sockets.res(c_pointer)::out,
-    io::di, io::uo) is det.
-
-    % service_address(Host, Service, Result, !IO),
-    %
-:- pred service_address(string::in, string::in,
-    sockets.res(c_pointer)::out, io::di, io::uo) is det.
+:- pred socket(family::in, socktype::in,
+    maybe_error(socket)::out, io::di, io::uo) is det.
 
-    % connect(Fd, Addr, Addrlen, Result, !IO),
-    %
-    % XXX: Where does the caller get the Addrlen parameter from?
+    % connect(Socket, Addr, Addrlen, Result, !IO),
     %
-:- pred connect(int::in, c_pointer::in, int::in, sockets.res::out,
+:- pred connect(socket::in, sockaddr::in, maybe_error::out,
     io::di, io::uo) is det.
 
-    % bind(Fd, Addr, Addrlen, Result, !IO),
+    % bind(Socket, Addr, Result, !IO),
     %
-:- pred bind(int::in, c_pointer::in, int::in, sockets.res::out,
+:- pred bind(socket::in, sockaddr::in, maybe_error::out,
     io::di, io::uo) is det.
 
-    % listen(Fd, Backlog, Result, !IO),
+    % listen(Socket, Backlog, Result, !IO),
     %
-:- pred listen(int::in, int::in, sockets.res::out, io::di, io::uo)
+:- pred listen(socket::in, int::in, maybe_error::out, io::di, io::uo)
     is det.
 
-    % accept(Fd, Addr, Result, !IO),
+:- type accept_result
+    --->    accept_result(
+                ar_socket       :: socket,
+                ar_address      :: sockaddr
+            ).
+
+    % accept(Socket, Addr, Result, !IO),
     %
     % Accept will block until a connection to our socket is made.
     %
-:- pred accept(int::in, c_pointer::in, sockets.res(int)::out,
+:- pred accept(socket::in, maybe_error(accept_result)::out,
     io::di, io::uo) is det.
 
-    % close(Fd, Result, !IO),
+    % close(Socket, Result, !IO),
     %
     % This closes the socket with lingering enabled.  The call will not
     % return until all the queued data has been sent or he timeout expires
     % (2 seconds).
     %
-:- pred close(int::in, sockets.res::out, io::di, io::uo) is det.
+:- pred close(socket::in, maybe_error::out, io::di, io::uo) is det.
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
@@ -107,29 +107,63 @@
 
 :- import_module bool.
 
-:- pragma foreign_decl("C", "
+:- import_module net.errno.
+
+:- pragma foreign_decl("C",
+"
 #ifdef MR_WIN32
   #include <winsock.h>
-
-  #define  error()      WSAGetLastError()
-
-#else /* !MR_WIN32 */
-
+#else
   #include <errno.h>
   #include <netdb.h>
-
   #include <netinet/in.h>
-
   #include <sys/types.h>
   #include <sys/socket.h>
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+
+    % This list of address families is from socket(2) on linux.
+    %
+:- pragma foreign_enum("C", family/0,
+    [fam_inet       - "AF_INET",
+     fam_inet6      - "AF_INET6"]).
+%     fam_unix       - "AF_UNIX",
+%     fam_ipx        - "AF_IPX",
+%     fam_netlink    - "AF_NETLINK",
+%     fam_x25        - "AF_X25",
+%     fam_ax25       - "AF_AX25",
+%     fam_atmpvc     - "AF_ATMPVC",
+%     fam_appletalk  - "AF_APPLETALK",
+%     fam_packet     - "AF_PACKET",
+
+:- pragma foreign_enum("C", socktype/0,
+    [sock_stream    - "SOCK_STREAM",
+     sock_dgram     - "SOCK_DGRAM"]).
+% See socket(2) for the meaning of these values.
+%     sock_seqpacket - "SOCK_SEQPACKET",
+%     sock_raw       - "SOCK_RAW",
+%     sock_rdm       - "SOCK_RDM",
+    % Note: sock_packet is obosolete.
+    % Note: We deleberately do not support the non-portable SOCK_NONBLOCK
+    % and SOCK_CLOEXEC values, this functionality should be accessed via
+    % setsocketopt.
+
+:- pragma foreign_type("C", socket, "MR_Integer", [can_pass_as_mercury_type]).
+
+%-----------------------------------------------------------------------------%
 
+:- pragma foreign_decl("C", local,
+"
+#ifdef MR_WIN32
+  #define  error()      WSAGetLastError()
+
+#else /* !MR_WIN32 */
   #define  error()      errno
 
   #define  INVALID_SOCKET   -1
 #endif /* !MR_WIN32 */
-
-  #include \"mercury_string.h\"
-
 ").
 
 %-----------------------------------------------------------------------------%
@@ -164,31 +198,8 @@
 
 %-----------------------------------------------------------------------------%
 
-    % XXX not thread safe.
-:- pragma foreign_proc(c,
-    gethostbyname(Name::in, Host::out, _IO0::di, _IO::uo),
-     [will_not_call_mercury, promise_pure, tabled_for_io],
-"
-    struct hostent  *host;
-    host = gethostbyname(Name);
-    Host = (MR_String) host->h_name;
-").
-
-    % XXX not thread safe.
-:- pragma foreign_proc(c,
-    getservbyname(Name::in, Protocol::in, Port::out, _IO0::di, _IO::uo),
-     [will_not_call_mercury, promise_pure, tabled_for_io],
-"
-    struct servent *service;
-    service = getservbyname(Name, Protocol);
-    if (service != NULL) {
-        Port = (MR_Integer) ntohs(service->s_port);
-    } else {
-        Port = -1;
-    }
-").
-
-%-----------------------------------------------------------------------------%
+socket(Domain, Type, MaybeSocket, !IO) :-
+    socket(Domain, Type, 0, MaybeSocket, !IO).
 
 socket(Domain, Type, Protocol, MaybeSocket, !IO) :-
     socket(Domain, Type, Protocol, Socket, Success, Errno, !IO),
@@ -200,8 +211,8 @@ socket(Domain, Type, Protocol, MaybeSocket, !IO) :-
         MaybeSocket = error(strerror(Errno))
     ).
 
-:- pred socket(int::in, int::in, int::in, int::out, bool::out,
-    int::out, io::di, io::uo) is det.
+:- pred socket(family::in, socktype::in, protocol_num::in,
+    socket::out, bool::out, int::out, io::di, io::uo) is det.
 
 :- pragma foreign_proc(c,
     socket(Domain::in, Type::in, Protocol::in, Socket::out, Success::out,
@@ -219,96 +230,8 @@ socket(Domain, Type, Protocol, MaybeSocket, !IO) :-
 
 %-----------------------------------------------------------------------------%
 
-port_address(Host, Port, MaybeSA, !IO) :-
-    port_address(Host, Port, SA, Success, Errno, !IO),
-    (
-        Success = yes,
-        MaybeSA = ok(SA)
-    ;
-        Success = no,
-        MaybeSA = error(strerror(Errno))
-    ).
-
-:- pred port_address(string::in, int::in, c_pointer::out,  bool::out,
-    int::out, io::di, io::uo) is det.
-
-    % XXX Not thread safe as this uses gethostbyname
-    %
-:- pragma foreign_proc("C",
-    port_address(Host::in, Port::in, SA::out, Success::out, Errno::out,
-        _IO0::di, _IO::uo),
-    [will_not_call_mercury, promise_pure, tabled_for_io],
-"
-    struct hostent *host;
-    struct sockaddr_in *addr;
-
-    host = gethostbyname(Host);
-    if (host == NULL) {
-        Errno = error();
-        Success = MR_NO;
-    } else {
-        addr = MR_GC_NEW(struct sockaddr_in);
-
-        MR_memcpy(&(addr->sin_addr), host->h_addr_list[0], host->h_length);
-        addr->sin_family = host->h_addrtype;
-        addr->sin_port = htons(Port);
-
-        SA = (MR_Word) addr;
-        Success = MR_YES;
-    }
-").
-
-%-----------------------------------------------------------------------------%
-
-service_address(Service, Host, MaybeSA, !IO) :-
-    service_address(Service, Host, SA, Success, Errno, !IO),
-    (
-        Success = yes,
-        MaybeSA = ok(SA)
-    ;
-        Success = no,
-        MaybeSA = error(strerror(Errno))
-    ).
-
-:- pred service_address(string::in, string::in, c_pointer::out,
-    bool::out, int::out, io::di, io::uo) is det.
-
-    % XXX Not thread safe as this uses gethostbyname and getservbyname.
-    %
-:- pragma foreign_proc("C",
-    service_address(Service::in, Host::in, SA::out, Success::out,
-        Errno::out, _IO0::di, _IO::uo),
-    [will_not_call_mercury, promise_pure, tabled_for_io],
-"
-    struct hostent *host;
-    struct servent *service;
-    struct sockaddr_in *addr;
-
-    host = gethostbyname(Host);
-    if (host == NULL) {
-        Errno = error();
-        Success = MR_NO;
-    } else {
-        service = getservbyname(Service,""tcp"");
-
-        if (service == NULL) {
-            Errno = error();
-            Success = MR_NO;
-        } else {
-            addr = MR_GC_NEW(struct sockaddr_in);
-            MR_memcpy(&(addr->sin_addr), host->h_addr_list[0], host->h_length);
-            addr->sin_family = host->h_addrtype;
-            addr->sin_port = service->s_port;
-            SA = (MR_Word) addr;
-            Success = MR_YES;
-        }
-    }
-").
-
-%-----------------------------------------------------------------------------%
-
-connect(Fd, Addr, AddrLen, Result, !IO) :-
-    connect(Fd, Addr, AddrLen, Success, Errno, !IO),
+connect(Socket, Addr, Result, !IO) :-
+    connect(Socket, Addr, Success, Errno, !IO),
     (
         Success = yes,
         Result = ok
@@ -317,16 +240,14 @@ connect(Fd, Addr, AddrLen, Result, !IO) :-
         Result = error(strerror(Errno))
     ).
 
-:- pred connect(int::in, c_pointer::in, int::in, bool::out,
-    int::out, io::di, io::uo) is det.
+:- pred connect(socket::in, sockaddr::in, bool::out, int::out,
+    io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    connect(Fd::in, Addr::in, AddrLen::in, Success::out, Errno::out,
-        _IO0::di, _IO::uo),
+    connect(Socket::in, Addr::in, Success::out, Errno::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
-    struct sockaddr *addr = (struct sockaddr *) Addr;
-    if (connect(Fd, addr, AddrLen) == INVALID_SOCKET) {
+    if (connect(Socket, &(Addr->raw), sock_addr_size(Addr)) == INVALID_SOCKET) {
         Errno = error();
         Success = MR_NO;
     } else {
@@ -336,8 +257,8 @@ connect(Fd, Addr, AddrLen, Result, !IO) :-
 
 %-----------------------------------------------------------------------------%
 
-bind(Fd, Addr, AddrLen, Result, !IO) :-
-    bind(Fd, Addr, AddrLen, Success, Errno, !IO),
+bind(Socket, Addr, Result, !IO) :-
+    bind(Socket, Addr, Success, Errno, !IO),
     (
         Success = yes,
         Result = ok
@@ -346,16 +267,15 @@ bind(Fd, Addr, AddrLen, Result, !IO) :-
         Result = error(strerror(Errno))
     ).
 
-:- pred bind(int::in, c_pointer::in, int::in, bool::out, int::out,
+:- pred bind(socket::in, sockaddr::in, bool::out, int::out,
     io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    bind(Fd::in, Addr::in, AddrLen::in, Success::out, Errno::out,
+    bind(Socket::in, Addr::in, Success::out, Errno::out,
         _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
-    struct sockaddr *addr = (struct sockaddr *) Addr;
-    if (bind(Fd, addr, AddrLen) == INVALID_SOCKET) {
+    if (bind(Socket, &(Addr->raw), sock_addr_size(Addr)) == INVALID_SOCKET) {
         Errno = error();
         Success = MR_NO;
     } else {
@@ -365,8 +285,8 @@ bind(Fd, Addr, AddrLen, Result, !IO) :-
 
 %-----------------------------------------------------------------------------%
 
-listen(Fd, Backlog, Result, !IO) :-
-    listen(Fd, Backlog, Success, Errno, !IO),
+listen(Socket, Backlog, Result, !IO) :-
+    listen(Socket, Backlog, Success, Errno, !IO),
     (
         Success = yes,
         Result = ok
@@ -375,14 +295,15 @@ listen(Fd, Backlog, Result, !IO) :-
         Result = error(strerror(Errno))
     ).
 
-:- pred listen(int::in, int::in, bool::out, int::out,
+:- pred listen(socket::in, int::in, bool::out, int::out,
     io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    listen(Fd::in, BackLog::in, Success::out, Errno::out, _IO0::di, _IO::uo),
+    listen(Socket::in, BackLog::in, Success::out, Errno::out,
+        _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
-    if (listen(Fd, BackLog) == INVALID_SOCKET) {
+    if (listen(Socket, BackLog) == INVALID_SOCKET) {
         Errno = error();
         Success = MR_NO;
     } else {
@@ -392,38 +313,53 @@ listen(Fd, Backlog, Result, !IO) :-
 
 %-----------------------------------------------------------------------------%
 
-accept(Fd, Addr, MaybeNewSocket, !IO) :-
-    accept(Fd, Addr, NewSocket, Success, Errno, !IO),
+accept(Socket, Result, !IO) :-
+    accept(Socket, NewSocket, Addr, Success, AddressOk, Errno, !IO),
     (
         Success = yes,
-        MaybeNewSocket = ok(NewSocket)
+        (
+            AddressOk = yes,
+            Result = ok(accept_result(NewSocket, Addr))
+        ;
+            AddressOk = no,
+            close(NewSocket, _, !IO),
+            Result = error("Could not decode peer address")
+        )
     ;
         Success = no,
-        MaybeNewSocket = error(strerror(Errno))
+        Result = error(strerror(Errno))
     ).
 
-:- pred accept(int::in, c_pointer::in, int::out, bool::out, int::out,
-    io::di, io::uo) is det.
+:- pred accept(socket::in, socket::out, sockaddr::out, bool::out, bool::out,
+    int::out, io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    accept(Fd::in, Addr::in, NewSocket::out, Success::out, Errno::out,
-        _IO0::di, _IO::uo),
+    accept(Socket::in, NewSocket::out, Addr::out, Success::out,
+        AddressOk::out, Errno::out, _IO0::di, _IO::uo),
     [thread_safe, will_not_call_mercury, promise_pure, tabled_for_io],
 "
-    struct sockaddr *addr = (struct sockaddr *) Addr;
-    NewSocket = accept(Fd, addr, NULL);
+    socklen_t addrlen;
+
+    Addr = MR_GC_NEW(union my_sockaddr);
+    addrlen = sizeof(union my_sockaddr);
+    NewSocket = accept(Socket, &(Addr->raw), &addrlen);
     if (NewSocket == INVALID_SOCKET) {
         Errno = error();
         Success = MR_NO;
+        AddressOk = MR_NO;
+    } else if (addrlen > sizeof(union my_sockaddr)){
+        Success = MR_YES;
+        AddressOk = MR_NO;
     } else {
         Success = MR_YES;
+        AddressOk = MR_YES;
     }
 ").
 
 %-----------------------------------------------------------------------------%
 
-close(Fd, Result, !IO) :-
-    close(Fd, Success, Errno, !IO),
+close(Socket, Result, !IO) :-
+    close(Socket, Success, Errno, !IO),
     (
         Success = yes,
         Result = ok
@@ -432,16 +368,16 @@ close(Fd, Result, !IO) :-
         Result = error(strerror(Errno))
     ).
 
-:- pred close(int::in, bool::out, int::out, io::di, io::uo) is det.
+:- pred close(socket::in, bool::out, int::out, io::di, io::uo) is det.
 
 :- pragma foreign_proc("C",
-    close(Fd::in, Success::out, Errno::out, _IO0::di, _IO::uo),
+    close(Socket::in, Success::out, Errno::out, _IO0::di, _IO::uo),
     [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
 "
     struct linger sockets_linger = { MR_TRUE, 2 };
-    setsockopt(Fd, SOL_SOCKET, SO_LINGER,
+    setsockopt(Socket, SOL_SOCKET, SO_LINGER,
         &sockets_linger, sizeof(sockets_linger));
-    if (-1 == shutdown(Fd, SHUT_RDWR)) {
+    if (-1 == close(Socket)) {
         Errno = error();
         Success = MR_NO;
     } else {
@@ -450,26 +386,5 @@ close(Fd, Result, !IO) :-
 ").
 
 %-----------------------------------------------------------------------------%
-
-    % Errno handling.
-    %
-:- func strerror(int) = string.
-
-strerror(Errno) = String :-
-    strerror(Errno, String).
-
-:- pred strerror(int::in, string::uo) is det.
-
-:- pragma foreign_proc("C",
-    strerror(Errno::in, Str::uo),
-    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
-"
-    char errbuf[MR_STRERROR_BUF_SIZE];
-
-    MR_make_aligned_string_copy(Str,
-        MR_strerror(Errno, errbuf, sizeof(errbuf)));
-").
-
-%-----------------------------------------------------------------------------%
 :- end_module sockets.
-%-----------------------------------------------------------------------------%
+g%-----------------------------------------------------------------------------%
diff --git a/extras/net/tcp.m b/extras/net/tcp.m
index 1a116bd..6d70000 100644
--- a/extras/net/tcp.m
+++ b/extras/net/tcp.m
@@ -15,7 +15,7 @@
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
-:- module tcp.
+:- module net.tcp.
 :- interface.
 
 :- import_module io.
diff --git a/extras/net/types.m b/extras/net/types.m
new file mode 100644
index 0000000..4077492
--- /dev/null
+++ b/extras/net/types.m
@@ -0,0 +1,253 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%---------------------------------------------------------------------------%
+% Copyright (C) 2014 The Mercury Team
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% Module: types 
+% Main Author:  Paul Bone <paul at bone.id.au>
+% Stability:    low
+%
+% Networking datatypes and conversion predicates.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module net.types.
+
+:- interface.
+
+:- import_module string.
+
+:- import_module net.sockets.
+
+%-----------------------------------------------------------------------------%
+
+	% An IPv4 Address.
+	%
+:- type in_addr.
+
+    % Constant (special) IP addresses:
+    %  + the wildcard address:  0.0.0.0
+    %  + the loopback address:  127.0.0.1
+    %  + the broadcast address: 255.255.255.255
+    %
+    % See also ip(7).
+    %
+:- func in_addr_any = in_addr.
+:- func in_addr_loopback = in_addr.
+:- func in_addr_broadcast = in_addr.
+
+    % Convert an address from numbers-and-dots format into an in_addr
+    % structure.
+    %
+    % The numbers-and-dots format is general and allows up to four numbers
+    % seperated by dots, the numbers may be decimal, octal or hexadecimal, 
+    % See inet_aton(3).
+	%
+:- pred from_string(string::in, in_addr::uo) is semidet.
+
+    % Convert an in_addr into a dotted-decimal format.  This predicate and
+    % inet_aton are not reciprical, therefore this should not be a reverse
+    % mode of the above.
+    %
+    % The dotted-decimal format is the typical format with four decimal
+    % numbers seperated by dots.
+	%
+:- pred to_string(in_addr::in, string::uo) is det.
+:- func to_string(in_addr) = string.
+
+    % A port number.
+    %
+:- type port == int.
+
+%-----------------------------------------------------------------------------%
+
+    % A socket address, for example in ipv4 this is an IP address and a port
+    % number pair.
+    %
+:- type sockaddr.
+
+:- func family(sockaddr) = family.
+
+    % Construct and deconstruct ipv4 sockaddrs.  Deconstruction fails if
+    % this is not an ipv4 socket address.
+    %
+:- pred ipv4_sockaddr(in_addr, port, sockaddr).
+:- mode ipv4_sockaddr(in, in, uo) is det.
+:- mode ipv4_sockaddr(out, out, in) is semidet.
+
+:- func ipv4_sockaddr(in_addr, port) = sockaddr.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- implementation.
+
+:- import_module bool.
+:- import_module int.
+:- import_module require.
+
+:- import_module net.errno.
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C",
+"
+#include <netinet/in.h>
+#include <arpa/inet.h>
+").
+
+:- pragma foreign_decl("C", local,
+"
+#ifdef MR_WIN32
+  #define  error()      WSAGetLastError()
+#else
+  #define  error()      errno
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_type("C",
+    in_addr,
+    "struct in_addr*",
+    [can_pass_as_mercury_type]).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+    in_addr_any = (Addr::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Addr = MR_GC_NEW(struct in_addr);
+    Addr->s_addr = INADDR_ANY;
+").
+
+:- pragma foreign_proc("C",
+    in_addr_loopback = (Addr::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Addr = MR_GC_NEW(struct in_addr);
+    Addr->s_addr = INADDR_LOOPBACK;
+").
+
+:- pragma foreign_proc("C",
+    in_addr_broadcast = (Addr::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    Addr = MR_GC_NEW(struct in_addr);
+    Addr->s_addr = INADDR_BROADCAST;
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+	from_string(String::in, Addr::uo),
+	[will_not_call_mercury, promise_pure, thread_safe],
+"
+    Addr = MR_GC_NEW(struct in_addr);
+
+    SUCCESS_INDICATOR = inet_aton(String, Addr);
+").
+
+%-----------------------------------------------------------------------------%
+
+to_string(Addr, String) :-
+    to_string(Addr, String, Success, Errno),
+    (
+        Success = yes
+    ;
+        Success = no,
+        unexpected($file, $pred,
+            "Cannot convert address to string" ++ strerror(Errno))
+    ).
+to_string(Addr) = String :-
+    to_string(Addr, String).
+
+:- pred to_string(in_addr::in, string::uo, bool::out, errno::out) is det.
+
+:- pragma foreign_proc("C",
+    to_string(Addr::in, String::uo, Success::out, Errno::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+"
+    char *temp = MR_GC_malloc_atomic(INET_ADDRSTRLEN);
+
+    String = (char*)inet_ntop(AF_INET, Addr, temp, INET_ADDRSTRLEN);
+    if (String != NULL) {
+        Success = MR_YES;
+    } else {
+        Success = MR_NO;
+        Errno = error();
+    }
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C",
+"
+    union my_sockaddr {
+        struct sockaddr     raw;
+        struct sockaddr_in  in;
+    };
+
+    socklen_t sock_addr_size(union my_sockaddr *addr);
+").
+
+:- pragma foreign_code("C",
+"
+    socklen_t sock_addr_size(union my_sockaddr *addr) {
+        switch (addr->raw.sa_family) {
+            case AF_INET:
+                return sizeof(struct sockaddr_in);
+            default:
+                fprintf(stderr, ""Unhandled family\\n"");
+                abort();
+        }
+    }
+").
+
+:- pragma foreign_type("C",
+    sockaddr,
+    "union my_sockaddr *",
+    [can_pass_as_mercury_type]).
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+    family(Addr::in) = (Family::out),
+    [will_not_call_mercury, promise_pure, thread_safe],
+    "Family = Addr->raw.sa_family;").
+
+%-----------------------------------------------------------------------------%
+
+ipv4_sockaddr(InAddr, Port) = Sockaddr :-
+    ipv4_sockaddr(InAddr, Port, Sockaddr).
+
+:- pragma foreign_proc("C",
+    ipv4_sockaddr(InAddr::in, Port::in, Sockaddr::uo),
+    [will_not_call_mercury, thread_safe, promise_pure],
+"
+    Sockaddr = (union my_sockaddr*)MR_GC_NEW(struct sockaddr_in);
+    Sockaddr->in.sin_family = AF_INET;
+    Sockaddr->in.sin_port = htons(Port);
+    Sockaddr->in.sin_addr = *InAddr;
+").
+
+:- pragma foreign_proc("C",
+    ipv4_sockaddr(InAddr::out, Port::out, Sockaddr::in),
+    [will_not_call_mercury, thread_safe, promise_pure],
+"
+    if (Sockaddr->in.sin_family == AF_INET) {
+        Port = ntohs(Sockaddr->in.sin_port);
+        InAddr = &(Sockaddr->in.sin_addr);
+        SUCCESS_INDICATOR = MR_YES;
+    } else {
+        SUCCESS_INDICATOR = MR_NO;
+    }
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
-- 
2.1.0




More information about the reviews mailing list