[m-rev.] diff 2/2: [net] Impement a Mercury interface to getaddrinfo
Paul Bone
paul at bone.id.au
Tue Apr 7 16:42:02 AEST 2015
Branches: master
---
[net] Impement a Mercury interface to getaddrinfo
Add a Mercury interface to the C function getaddrinfo. getaddrinfo
superceeds gethostbyname and getservbyname. It is reenterant and also makes
it easier to support IPv6 amoung other things. Other predicates in netdb.m
should be written in terms of getaddrinfo.
extras/net/getaddrinfo.m:
As above.
extras/net/netdb.m:
Add predicates that use getaddrinfo to perform lookups.
extras/net/types.m:
Add predicates to convert to and from the raw values for family and
socktype.
extras/net/test_lookups.m:
extras/net/Makefile:
Add a test program.
.gitignore:
This .gitignore file was causing git to ignore the Mercury.options file
in net/extras. A leading slash in .gitignore patterns matches the start
of a path, this allows us to ignore these patterns when they're only in
the root directory.
extras/net/Mercury.options:
Work around a Mercury bug.
Add this missing file.
---
.gitignore | 22 +--
extras/net/Makefile | 10 +-
extras/net/Mercury.options | 10 ++
extras/net/getaddrinfo.m | 384 +++++++++++++++++++++++++++++++++++++++++++++
extras/net/net.m | 1 +
extras/net/netdb.m | 74 +++++++--
extras/net/test_lookups.m | 61 +++++++
extras/net/types.m | 68 ++++++++
8 files changed, 607 insertions(+), 23 deletions(-)
create mode 100644 extras/net/Mercury.options
create mode 100644 extras/net/getaddrinfo.m
create mode 100644 extras/net/test_lookups.m
diff --git a/.gitignore b/.gitignore
index ebc6c2d..d288830 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,7 @@
-README
-INSTALL
-TODO
-WORK_IN_PROGRESS
+/README
+/INSTALL
+/TODO
+/WORK_IN_PROGRESS
configure
config.cache
config.status
@@ -10,15 +10,15 @@ configure.log
configure.help
confdefs.h
so_locations
+/Mercury.options
Mmake.common
Mmake.params
Mmake.stage.params
-stage1
-stage2
-stage3
-install_grade_dir.*
-Mercury.options
+/stage1
+/stage2
+/stage3
+/install_grade_dir.*
autom4te.cache
aclocal.m4
-.configured_library_grades
-main.o
+/.configured_library_grades
+/main.o
diff --git a/extras/net/Makefile b/extras/net/Makefile
index c3bac94..1b59fa4 100644
--- a/extras/net/Makefile
+++ b/extras/net/Makefile
@@ -12,7 +12,7 @@ MCFLAGS=-O3 --intermodule-optimization --use-grade-subdirs --grade hlc.gc
MERCURY_FILES=$(wildcard *.m)
-all: libnet.so echo
+all: libnet.so echo test_lookups
libnet.so: $(MERCURY_FILES)
$(MMC) $(MCFLAGS) --make libnet
@@ -20,9 +20,15 @@ libnet.so: $(MERCURY_FILES)
echo: $(MERCURY_FILES)
$(MMC) $(MCFLAGS) --make echo
+test_lookups: $(MERCURY_FILES)
+ $(MMC) $(MCFLAGS) --make test_lookups
+
tags: $(MERCURY_FILES)
$(MTAGS) $(MERCURY_FILES)
.PHONY: clean
clean:
- rm -rf Mercury *.mh *.err echo libnet.so libnet.a net.init tags
+ rm -rf Mercury *.mh *.err \
+ echo test_lookups libnet.so libnet.a \
+ net.init \
+ tags
diff --git a/extras/net/Mercury.options b/extras/net/Mercury.options
new file mode 100644
index 0000000..9ad0830
--- /dev/null
+++ b/extras/net/Mercury.options
@@ -0,0 +1,10 @@
+#
+# These options are required to get access to some reenterant versions of
+# socket functions.
+#
+EXTRA_CFLAGS=-D_BSD_SOURCE=1 -D_DEFAULT_SOURCE=1
+
+# Workaround a bug in Mercury's pack bits optimisation.
+MCFLAGS=--arg-pack-bits 0
+
+
diff --git a/extras/net/getaddrinfo.m b/extras/net/getaddrinfo.m
new file mode 100644
index 0000000..081f777
--- /dev/null
+++ b/extras/net/getaddrinfo.m
@@ -0,0 +1,384 @@
+%-----------------------------------------------------------------------------%
+% 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: getaddrinfo
+% Main Author: Paul Bone <paul at bone.id.au>
+% Stability: low
+%
+% Provide an interface to the getaddrinfo C function.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+:- module net.getaddrinfo.
+
+:- interface.
+
+:- import_module int.
+:- import_module list.
+:- import_module maybe.
+
+:- import_module net.netdb.
+:- import_module net.types.
+
+%-----------------------------------------------------------------------------%
+
+:- type node_and_or_service
+ ---> node_only(
+ no_node :: string
+ )
+ ; service_only(
+ so_service :: service
+ )
+ ; node_and_service(
+ nas_node :: string,
+ nas_service :: service
+ ).
+
+:- type addrinfo
+ ---> addrinfo(
+ ai_family :: family,
+ ai_socktype :: maybe(socktype),
+ ai_protocol :: protocol_num,
+ ai_sockaddr :: sockaddr,
+ ai_maybe_name :: maybe(string)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % The address info flags bitfield.
+ %
+:- type gai_flags == int.
+
+ % Return only addresses that make sense given the system's network
+ % interface configuration. For example, IPv6 addresses will only be
+ % returned if at least one IPv6 interface is configured and is not the
+ % loopback interface.
+ %
+:- func gai_flag_addrconfig = int.
+
+ % Return addresses suitable for use with the bind() call. WIthout this
+ % flag returned addresses are suitable for use with the connect() call.
+ %
+:- func gai_flag_passive = int.
+
+%-----------------------------------------------------------------------------%
+
+:- pred getaddrinfo(node_and_or_service::in,
+ gai_flags::in, maybe(family)::in, maybe(socktype)::in,
+ maybe(protocol)::in, maybe_error(list(addrinfo))::out) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module require.
+:- import_module string.
+
+:- import_module net.errno.
+
+:- pragma foreign_decl("C",
+"
+#ifdef MR_WIN32
+ #include ""mercury_windows.h""
+ #include <winsock2.h>
+ #include <ws2tcpip.h>
+#else
+ #include <sys/types.h>
+ #include <sys/socket.h>
+ #include <netdb.h>
+#endif
+").
+
+:- pragma foreign_decl("C", local,
+"
+#ifdef MR_WIN32
+ #define error() WSAGetLastError()
+#else
+ #define error() errno
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+ gai_flag_addrconfig = (Flag::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Flag = AI_ADDRCONFIG;
+").
+
+:- pragma foreign_proc("C",
+ gai_flag_passive = (Flag::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Flag = AI_PASSIVE;
+").
+
+:- pred flag_numericservice(gai_flags::out) is semidet.
+
+:- pragma foreign_proc("C",
+ flag_numericservice(Flag::out),
+ [will_not_call_mercury, thread_safe, promise_pure,
+ will_not_throw_exception],
+"
+ #ifdef AI_NUMERICSERV
+ Flag = AI_NUMERICSERV;
+ SUCCESS_INDICATOR = MR_YES;
+ #else
+ SUCCESS_INDICATOR = MR_NO;
+ #endif
+").
+
+%-----------------------------------------------------------------------------%
+
+getaddrinfo(NodeAndOrService, Flags0, MaybeFamily0, MaybeSocktype0,
+ MaybeProtocol0, Result) :-
+ make_node_and_service_c_strings(NodeAndOrService, Node, Service),
+ (
+ nas_service_is_numeric(NodeAndOrService),
+ flag_numericservice(NumericServiceFlag)
+ ->
+ Flags = Flags0 \/ NumericServiceFlag
+ ;
+ Flags = Flags0
+ ),
+ map_maybe((pred(A::in, B::out) is det :-
+ family_int(A, B)
+ ), MaybeFamily0, MaybeFamily),
+ maybe_default(0, MaybeFamily, Family),
+ map_maybe((pred(A::in, B::out) is det :-
+ socktype_int(A, B)
+ ), MaybeSocktype0, MaybeSocktype),
+ maybe_default(0, MaybeSocktype, Socktype),
+ MaybeProtocol = map_maybe((func(P) = P ^ p_num), MaybeProtocol0),
+ maybe_default(0, MaybeProtocol, Protocol),
+ promise_pure (
+ getaddrinfo_c(Node, Service, Flags, Family, Socktype, Protocol,
+ AddrInfoList0, Result0),
+ ( Result0 = gai_ok ->
+ addrinfo_c_to_addrinfos(AddrInfoList0, AddrInfoList),
+ impure free_addrinfo_c(AddrInfoList0),
+ Result = ok(AddrInfoList)
+ ; Result0 = gai_not_found ->
+ Result = ok([])
+ ;
+ Result = error(gai_strerror(Result0))
+ )
+ ).
+
+:- pred getaddrinfo_c(nullable_string::in, nullable_string::in,
+ int::in, int::in, int::in, int::in, addrinfo_c::out, int::out) is det.
+
+:- pragma foreign_proc("C",
+ getaddrinfo_c(Node::in, Service::in, Flags::in, Family::in, Socktype::in,
+ Protocol::in, AddrInfoList::out, Result::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ struct addrinfo hints;
+ memset(&hints, 0, sizeof(hints));
+ hints.ai_flags = Flags;
+ hints.ai_family = Family;
+ hints.ai_socktype = Socktype;
+ hints.ai_protocol = Protocol;
+
+ Result = getaddrinfo(Node, Service, &hints, &AddrInfoList);
+").
+
+%-----------------------------------------------------------------------%
+
+:- pred make_node_and_service_c_strings(node_and_or_service::in,
+ nullable_string::out, nullable_string::out) is det.
+
+make_node_and_service_c_strings(node_and_service(Node0, Service0), Node,
+ Service) :-
+ make_nullable_string(Node0, Node),
+ make_service(Service0, Service).
+make_node_and_service_c_strings(node_only(Node0), Node, null_string) :-
+ make_nullable_string(Node0, Node).
+make_node_and_service_c_strings(service_only(Service0), null_string,
+ Service) :-
+ make_service(Service0, Service).
+
+:- pred make_service(service::in, nullable_string::out) is det.
+
+make_service(numeric_service(ServiceNum), Service) :-
+ make_nullable_string(string(ServiceNum), Service).
+make_service(string_service(ServiceStr), Service) :-
+ make_nullable_string(ServiceStr, Service).
+
+:- pred nas_service_is_numeric(node_and_or_service::in) is semidet.
+
+nas_service_is_numeric(NAS) :-
+ ( NAS = service_only(Service)
+ ; NAS = node_and_service(_, Service)
+ ),
+ service_is_numeric(Service).
+
+:- pred service_is_numeric(service::in) is semidet.
+
+service_is_numeric(numeric_service(_)).
+
+%-----------------------------------------------------------------------------%
+
+:- type addrinfo_c.
+
+:- pragma foreign_type("C",
+ addrinfo_c,
+ "struct addrinfo*",
+ [can_pass_as_mercury_type]).
+
+:- pred addrinfo_c_to_addrinfos(addrinfo_c::in, list(addrinfo)::out) is det.
+
+addrinfo_c_to_addrinfos(AddrInfoC, AddrInfoList) :-
+ read_addrinfo(AddrInfoC, FamilyInt, SocktypeInt, ProtocolNum, Sockaddr),
+ ( read_addrinfo_name(AddrInfoC, Name) ->
+ MaybeName = yes(Name)
+ ;
+ MaybeName = no
+ ),
+ (
+ family_int(FamilyPrime, FamilyInt)
+ ->
+ Family = FamilyPrime
+ ;
+ unexpected($file, $pred,
+ "getaddrinfo returned '0' for family")
+ ),
+ (
+ socktype_int(SocktypePrime, SocktypeInt)
+ ->
+ MaybeSocktype = yes(SocktypePrime)
+ ;
+ MaybeSocktype = no
+ ),
+ AddrInfo = addrinfo(Family, MaybeSocktype, ProtocolNum, Sockaddr,
+ MaybeName),
+ ( next_addrinfo_c(AddrInfoC, NextAddrInfoC) ->
+ addrinfo_c_to_addrinfos(NextAddrInfoC, AddrInfoList0),
+ AddrInfoList = [AddrInfo | AddrInfoList0]
+ ;
+ AddrInfoList = [AddrInfo]
+ ).
+
+:- pred read_addrinfo(addrinfo_c::in, int::out, int::out, int::out,
+ sockaddr::out) is det.
+
+:- pragma foreign_proc("C",
+ read_addrinfo(AddrInfo::in, Family::out, Socktype::out, ProtocolNum::out,
+ Sockaddr::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ int len;
+
+ Family = AddrInfo->ai_family;
+ Socktype = AddrInfo->ai_socktype;
+ ProtocolNum = AddrInfo->ai_protocol;
+ Sockaddr = MR_GC_malloc(AddrInfo->ai_addrlen);
+ memcpy(Sockaddr, AddrInfo->ai_addr, AddrInfo->ai_addrlen);
+
+ len = sock_addr_size(Sockaddr);
+ assert((len == -1) || (len == AddrInfo->ai_addrlen));
+").
+
+:- pred read_addrinfo_name(addrinfo_c::in, string::out) is semidet.
+
+:- pragma foreign_proc("C",
+ read_addrinfo_name(AddrInfo::in, Name::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ SUCCESS_INDICATOR = AddrInfo->ai_canonname != NULL;
+ if (SUCCESS_INDICATOR) {
+ MR_make_aligned_string_copy(Name, AddrInfo->ai_canonname);
+ }
+").
+
+:- pred next_addrinfo_c(addrinfo_c::in, addrinfo_c::out) is semidet.
+
+:- pragma foreign_proc("C",
+ next_addrinfo_c(AddrInfo::in, NextAddrInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ NextAddrInfo = AddrInfo->ai_next;
+ SUCCESS_INDICATOR = NextAddrInfo != NULL;
+").
+
+:- impure pred free_addrinfo_c(addrinfo_c::in) is det.
+
+:- pragma foreign_proc("C",
+ free_addrinfo_c(AddrInfo::in),
+ [will_not_call_mercury, thread_safe, will_not_throw_exception],
+"
+ freeaddrinfo(AddrInfo);
+").
+
+%-----------------------------------------------------------------------------%
+
+:- func gai_ok = int.
+gai_ok = 0.
+
+:- func gai_not_found = int.
+:- pragma foreign_proc("C",
+ gai_not_found = (Num::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+ "
+ Num = EAI_NONAME;
+ ").
+
+:- func gai_strerror(int) = string.
+
+:- pragma foreign_proc("C",
+ gai_strerror(Num::in) = (String::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+ "
+ MR_make_aligned_string_copy(String, gai_strerror(Num));
+ ").
+
+%-----------------------------------------------------------------------------%
+
+:- pred maybe_default(T::in, maybe(T)::in, T::out) is det.
+
+maybe_default(Default, no, Default).
+maybe_default(_, yes(X), X).
+
+%-----------------------------------------------------------------------%
+
+:- type nullable_string.
+:- pragma foreign_type("C",
+ nullable_string,
+ "char*").
+
+:- func null_string = nullable_string.
+
+:- pragma foreign_proc("C",
+ null_string = (X::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ X = NULL;
+").
+
+:- pred make_nullable_string(string::in, nullable_string::out) is det.
+
+:- pragma foreign_proc("C",
+ make_nullable_string(Str0::in, Str::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Str = Str0;
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
diff --git a/extras/net/net.m b/extras/net/net.m
index 5bc7806..77ac277 100644
--- a/extras/net/net.m
+++ b/extras/net/net.m
@@ -18,5 +18,6 @@
:- implementation.
:- include_module errno.
+:- include_module getaddrinfo.
version("DEV").
diff --git a/extras/net/netdb.m b/extras/net/netdb.m
index 73bfa85..7959fea 100644
--- a/extras/net/netdb.m
+++ b/extras/net/netdb.m
@@ -22,6 +22,7 @@
:- interface.
:- import_module io.
+:- import_module int.
:- import_module list.
:- import_module maybe.
:- import_module string.
@@ -44,10 +45,27 @@
%-----------------------------------------------------------------------------%
-:- type addrinfo.
+:- type service
+ ---> numeric_service(int)
+ ; string_service(string).
%-----------------------------------------------------------------------------%
+:- type lookup_result
+ ---> lookup_result(
+ hasr_family :: family,
+ hasr_socktype :: socktype,
+ hasr_protocol :: protocol_num,
+ hasr_sockaddr :: sockaddr
+ ).
+
+:- pred lookup_host_and_service(string::in, service::in, maybe(family)::in,
+ maybe(socktype)::in, maybe_error(list(lookup_result))::out)
+ is det.
+
+:- pred lookup_local_socket(service::in, maybe(family)::in,
+ maybe(socktype)::in, maybe_error(list(lookup_result))::out) is det.
+
%:- pred gethostbyname(string::in, res(hostent)::out,
% io::di, io::uo) is det.
@@ -77,6 +95,7 @@
:- import_module bool.
:- import_module require.
+:- import_module net.getaddrinfo.
:- import_module net.errno.
:- pragma foreign_decl("C",
@@ -223,15 +242,50 @@ c_protocol_to_protocol(CProto, 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]).
+lookup_host_and_service(Host, Service, MaybeFamily, MaybeSocktype,
+ MaybeResults) :-
+ getaddrinfo(node_and_service(Host, Service), gai_flag_addrconfig,
+ MaybeFamily, MaybeSocktype, no, MaybeResults0),
+ (
+ MaybeResults0 = ok(Results0),
+ map(make_host_and_service_result, Results0, Results),
+ MaybeResults = ok(Results)
+ ;
+ MaybeResults0 = error(Error),
+ MaybeResults = error(Error)
+ ).
+
+lookup_local_socket(Service, MaybeFamily, MaybeSocktype, MaybeResults) :-
+ getaddrinfo(service_only(Service),
+ gai_flag_addrconfig \/ gai_flag_passive, MaybeFamily, MaybeSocktype,
+ no, MaybeResults0),
+ map_maybe_error(map(make_host_and_service_result),
+ MaybeResults0, MaybeResults).
+
+:- pred make_host_and_service_result(addrinfo::in,
+ lookup_result::out) is det.
+
+make_host_and_service_result(AI, lookup_result(Family, SockType,
+ ProtocolNum, Sockaddr)) :-
+ Family = AI ^ ai_family,
+ MaybeSockType = AI ^ ai_socktype,
+ (
+ MaybeSockType = yes(SockType)
+ ;
+ MaybeSockType = no,
+ unexpected($file, $pred, "No socktype")
+ ),
+ ProtocolNum = AI ^ ai_protocol,
+ Sockaddr = AI ^ ai_sockaddr.
+
+%-----------------------------------------------------------------------------%
+
+:- pred map_maybe_error(pred(T, U), maybe_error(T, E), maybe_error(U, E)).
+:- mode map_maybe_error(pred(in, out) is det, in, out) is det.
+
+map_maybe_error(P, ok(X), ok(Y)) :-
+ P(X, Y).
+map_maybe_error(_, error(E), error(E)).
%-----------------------------------------------------------------------------%
diff --git a/extras/net/test_lookups.m b/extras/net/test_lookups.m
new file mode 100644
index 0000000..537ed53
--- /dev/null
+++ b/extras/net/test_lookups.m
@@ -0,0 +1,61 @@
+
+:- module test_lookups.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- import_module list.
+:- import_module maybe.
+:- import_module string.
+
+:- import_module net.
+:- import_module net.netdb.
+:- import_module net.types.
+
+main(!IO) :-
+ TCPS = "tcp",
+ getprotobyname(TCPS, TCP, !IO),
+ io.format("get_proto_by_name(""%s"", %s, !IO).\n",
+ [s(TCPS), s(string(TCP))], !IO),
+ lookup_host_and_service("www.google.com", string_service("http"),
+ yes(fam_inet), no, GAIResultHostService),
+ (
+ GAIResultHostService = ok(HostServiceResults),
+ io.write_string("www.google.com:\n", !IO),
+ foldl(write_lookup_result, HostServiceResults, !IO)
+ ;
+ GAIResultHostService = error(ErrorA),
+ io.format("Lookup error for www.google.com: %s", [s(ErrorA)], !IO)
+ ),
+ lookup_local_socket(string_service("http"), yes(fam_inet),
+ yes(sock_stream), ResultLocalSocket),
+ (
+ ResultLocalSocket = ok(LocalSockets),
+ io.write_string("local sockets:\n", !IO),
+ foldl(write_lookup_result, LocalSockets, !IO)
+ ;
+ ResultLocalSocket = error(ErrorB),
+ io.format("Lookup error for local sockets: %s", [s(ErrorB)], !IO)
+ ).
+
+:- pred write_lookup_result(lookup_result::in,
+ io::di, io::uo) is det.
+
+write_lookup_result(lookup_result(Family, Socktype, ProtoNum, SockAddr),
+ !IO) :-
+ io.format("Family: %s, Socktype: %s, Protocol: %s, Addr: %s\n",
+ [s(string(Family)), s(string(Socktype)), s(ProtoName),
+ s(SockStr)],
+ !IO),
+ ProtoName = string(ProtoNum),
+ ( ipv4_sockaddr(InAddr, Port, SockAddr) ->
+ SockStr = format("%s:%d", [s(to_string(InAddr)), i(Port)])
+ ;
+ SockStr = "unknown"
+ ).
+
diff --git a/extras/net/types.m b/extras/net/types.m
index b9ecc81..7116e51 100644
--- a/extras/net/types.m
+++ b/extras/net/types.m
@@ -43,6 +43,16 @@
---> fam_inet
; fam_inet6.
+ % Convert to and from the integer representation of a family. This is
+ % sometimes required, for example when '0' indicates unspecified in the
+ % underlying foreign code.
+ %
+:- pred family_int(family, int).
+:- mode family_int(in, out) is det.
+:- mode family_int(out, in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
% 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
@@ -52,6 +62,14 @@
---> sock_stream
; sock_dgram.
+ % Convert socktypes to and from integers.
+ %
+:- pred socktype_int(socktype, int).
+:- mode socktype_int(in, out) is det.
+:- mode socktype_int(out, in) is semidet.
+
+%-----------------------------------------------------------------------------%
+
% An IPv4 Address.
%
:- type in_addr.
@@ -154,6 +172,31 @@
% fam_appletalk - "AF_APPLETALK",
% fam_packet - "AF_PACKET",
+:- pragma foreign_proc("C",
+ family_int(Family::in, Int::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Int = Family;
+").
+
+:- pragma foreign_proc("C",
+ family_int(Family::out, Int::in),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Family = Int;
+ switch (Family) {
+ case AF_INET:
+ case AF_INET6:
+ SUCCESS_INDICATOR = MR_YES;
+ break;
+ default:
+ SUCCESS_INDICATOR = MR_NO;
+ break;
+ }
+").
+
:- pragma foreign_enum("C", socktype/0,
[sock_stream - "SOCK_STREAM",
sock_dgram - "SOCK_DGRAM"]).
@@ -166,6 +209,31 @@
% and SOCK_CLOEXEC values, this functionality should be accessed via
% setsocketopt.
+:- pragma foreign_proc("C",
+ socktype_int(Socktype::in, Int::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Int = Socktype;
+").
+
+:- pragma foreign_proc("C",
+ socktype_int(Socktype::out, Int::in),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ will_not_throw_exception],
+"
+ Socktype = Int;
+ switch (Socktype) {
+ case SOCK_STREAM:
+ case SOCK_DGRAM:
+ SUCCESS_INDICATOR = MR_YES;
+ break;
+ default:
+ SUCCESS_INDICATOR = MR_NO;
+ break;
+ }
+").
+
%-----------------------------------------------------------------------------%
:- pragma foreign_type("C",
--
2.1.4
More information about the reviews
mailing list