summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2016-02-26 22:55:54 -0800
committerKaz Kylheku <kaz@kylheku.com>2016-02-26 22:55:54 -0800
commit4496c575892fa34ae9aabf4e1c0f7da87f10c4c2 (patch)
tree5e662b6f6bc1bcc42aa834a7703deaa43f92cec5
parent4f14d3a2ded6137c5dd6449f4ec2d566947c4157 (diff)
downloadtxr-4496c575892fa34ae9aabf4e1c0f7da87f10c4c2.tar.gz
txr-4496c575892fa34ae9aabf4e1c0f7da87f10c4c2.tar.bz2
txr-4496c575892fa34ae9aabf4e1c0f7da87f10c4c2.zip
Adding socket support: unix, ipv4, ipv6.
* socket.c, socket.h: New files. * Makefile: include new socket.o among objects if have_objects variable is defined to 'y'. * configure (have_sockets): New variable. New configure test for socket-related functionality. (HAVE_SOCKETS, HAVE_GETADDRINFO): New configuration preprocessor symbols. Also, reordering the shell probing so that /usr/xpg4/bin/sh is the last fallback. On Solaris, it chokes on some code that is needed for Solaris. * lisplib.c (sock_set_entries, sock_instantiate): New static functions. (lisplib_init): Register new functions as autoload hooks. * share/txr/stdlib/socket.tl: New file. * stream.c (socket_error_s): New symbol variable. (struct stdio_handle): New members, family and type, helping stdio streams represent sockets too. (stdio_stream_mark): Mark new members of struct stdio_handle. (make_stdio_stream_common): Initialize new members. (make_sock_stream, stream_fd, sock_family, sock_type, open_socket, open_sockfd): New functions. (stream_init): Initialize socket_error_s variable. Register sock-family, sock-type and open-socket intrinsic functions. Register socket-error subtype. * stream.h (socket_error_s, make_sock_stream, stream_fd, sock_family, sock_type, open_socket, open_sockfd): Declared.
-rw-r--r--Makefile1
-rwxr-xr-xconfigure80
-rw-r--r--lisplib.c34
-rw-r--r--share/txr/stdlib/socket.tl46
-rw-r--r--socket.c382
-rw-r--r--socket.h28
-rw-r--r--stream.c96
-rw-r--r--stream.h16
8 files changed, 682 insertions, 1 deletions
diff --git a/Makefile b/Makefile
index a33a0a83..4dd2bf9a 100644
--- a/Makefile
+++ b/Makefile
@@ -51,6 +51,7 @@ OBJS-$(debug_support) += debug.o
OBJS-$(have_syslog) += syslog.o
OBJS-$(have_glob) += glob.o
OBJS-$(have_posix_sigs) += signal.o
+OBJS-$(have_sockets) += socket.o
OBJS-$(have_termios) += linenoise/linenoise.o
EXTRA_OBJS-$(add_win_res) += win/txr.res
diff --git a/configure b/configure
index 5c6c44b9..b4158aa2 100755
--- a/configure
+++ b/configure
@@ -33,7 +33,7 @@
#
if test x$txr_shell = x ; then
- for shell in /usr/xpg4/bin/sh /bin/bash /usr/bin/bash ; do
+ for shell in /bin/bash /usr/bin/bash /usr/xpg4/bin/sh ; do
if test -x $shell ; then
txr_shell=$shell
break
@@ -128,6 +128,7 @@ have_glob=
have_windows_h=
have_windres=
have_posix_sigs=
+have_sockets=
need_darwin_c_source=
have_git=
have_pwuid=
@@ -662,6 +663,7 @@ have_glob := $have_glob
# do we modern posix signal handling?
have_posix_sigs := $have_posix_sigs
+have_sockets := $have_sockets
have_termios := $have_termios
termios_define := $termios_define
@@ -2443,6 +2445,82 @@ elif [ -n "$file_offset_define" ] ; then
lang_flags="$lang_flags -D$file_offset_define"
fi
+printf "Checking for socket API ... "
+
+cat > conftest.c <<!
+#include <sys/types.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#include <sys/un.h>
+
+int main(int argc, char **argv)
+{
+ static struct sockaddr_in in_addr;
+ static struct sockaddr_un un_addr;
+ static char buf[256];
+ socklen_t len;
+
+ int s = socket(AF_INET, SOCK_STREAM, 0);
+ int e0 = bind(s, (struct sockaddr *) &in_addr, sizeof in_addr);
+ int e1 = listen(s, 42);
+ int e3 = connect(s, (struct sockaddr *) &un_addr, sizeof un_addr);
+ int e4 = send(s, buf, sizeof buf, 0);
+ int e5 = sendto(s, buf, sizeof buf, 0,
+ (struct sockaddr *) &un_addr, sizeof un_addr);
+ int e6 = recv(s, buf, sizeof buf, 0);
+ int e7 = (len = sizeof in_addr,
+ recvfrom(s, buf, sizeof buf, 0,
+ (struct sockaddr *) &in_addr, &len));
+ int e8 = shutdown(s, 0);
+ in_addr_t ia = inet_addr("10.0.0.1");
+
+ return 0;
+}
+!
+
+if conftest ; then
+ printf "yes\n"
+ printf "#define HAVE_SOCKETS 1\n" >> $config_h
+ have_sockets=y
+elif conftest EXTRA_LDFLAGS="-lsocket -lnsl" ; then
+ printf "yes\n"
+ printf "#define HAVE_SOCKETS 1\n" >> $config_h
+ have_sockets=y
+ conf_ldflags="${conf_ldflags:+"$conf_ldflags "}-lsocket -lnsl"
+ printf "Need libs for sockets: regenerating %s ..." $config_make
+ gen_config_make
+ printf "done\n"
+else
+ printf "no\n"
+fi
+
+printf "Checking for getaddrinfo ... "
+
+cat > conftest.c <<!
+#include <sys/types.h>
+#include <netdb.h>
+#include <stdio.h>
+
+int main(void)
+{
+ struct addrinfo hints;
+ struct addrinfo *ptr;
+ int res = getaddrinfo("node", "serv", &hints, &ptr);
+ freeaddrinfo(ptr);
+ puts(gai_strerror(res));
+ return 0;
+}
+!
+
+if conftest ; then
+ printf "yes\n"
+ printf "#define HAVE_GETADDRINFO 1\n" >> $config_h
+else
+ printf "no\n"
+fi
+
+
#
# Dependent variables
#
diff --git a/lisplib.c b/lisplib.c
index c99fc648..0040dc2b 100644
--- a/lisplib.c
+++ b/lisplib.c
@@ -36,6 +36,7 @@
#include "gc.h"
#include "debug.h"
#include "txr.h"
+#include "socket.h"
#include "lisplib.h"
val dl_table;
@@ -275,6 +276,36 @@ static val yield_instantiate(val set_fun)
return nil;
}
+#if HAVE_SOCKETS
+
+static val sock_set_entries(val dlt, val fun)
+{
+ val name[] = {
+ lit("sockaddr"), lit("sockaddr-in"), lit("sockaddr-in6"),
+ lit("sockaddr-un"), lit("addrinfo"),
+ lit("getaddrinfo"),
+ lit("af-unspec"), lit("af-unix"), lit("af-inet"), lit("af-inet6"),
+ lit("sock-stream"), lit("sock-dgram"),
+ lit("sock-nonblock"), lit("sock-cloexec"),
+ lit("ai-passive"), lit("ai-canonname"), lit("ai-numerichost"),
+ lit("ai-v4mapped"), lit("ai-all"), lit("ai-addrconfig"),
+ lit("ai-numericserv"),
+ nil
+ };
+ set_dlt_entries(dlt, name, fun);
+ return nil;
+}
+
+static val sock_instantiate(val set_fun)
+{
+ funcall1(set_fun, nil);
+ load(format(nil, lit("~a/socket.tl"), stdlib_path, nao));
+ sock_load_init();
+ return nil;
+}
+
+#endif
+
val dlt_register(val dlt,
val (*instantiate)(val),
val (*set_entries)(val, val))
@@ -298,6 +329,9 @@ void lisplib_init(void)
dlt_register(dl_table, except_instantiate, except_set_entries);
dlt_register(dl_table, type_instantiate, type_set_entries);
dlt_register(dl_table, yield_instantiate, yield_set_entries);
+#if HAVE_SOCKETS
+ dlt_register(dl_table, sock_instantiate, sock_set_entries);
+#endif
}
val lisplib_try_load(val sym)
diff --git a/share/txr/stdlib/socket.tl b/share/txr/stdlib/socket.tl
new file mode 100644
index 00000000..beff73be
--- /dev/null
+++ b/share/txr/stdlib/socket.tl
@@ -0,0 +1,46 @@
+;; Copyright 2016
+;; Kaz Kylheku <kaz@kylheku.com>
+;; Vancouver, Canada
+;; All rights reserved.
+;;
+;; Redistribution of this software in source and binary forms, with or without
+;; modification, is permitted provided that the following two conditions are met.
+;;
+;; Use of this software in any manner constitutes agreement with the disclaimer
+;; which follows the two conditions.
+;;
+;; 1. Redistributions of source code must retain the above copyright
+;; notice, this list of conditions and the following disclaimer.
+;; 2. Redistributions in binary form must reproduce the above copyright
+;; notice, this list of conditions and the following disclaimer in
+;; the documentation and/or other materials provided with the
+;; distribution.
+;;
+;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+;; WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE
+;; COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+;; AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+(defstruct sockaddr nil)
+
+(defstruct sockaddr-in sockaddr
+ (addr 0) (port 0))
+
+(defstruct sockaddr-in6 sockaddr
+ (addr 0) (port 0) (flow-info 0) (scope-id 0))
+
+(defstruct sockaddr-un sockaddr
+ path)
+
+(defstruct addrinfo nil
+ (flags 0)
+ (family 0)
+ (socktype 0)
+ (protocol 0)
+ (canonname 0))
+
+(defvarl shut-rd 0)
+(defvarl shut-wr 1)
+(defvarl shut-rdwr 2)
diff --git a/socket.c b/socket.c
new file mode 100644
index 00000000..6a637edf
--- /dev/null
+++ b/socket.c
@@ -0,0 +1,382 @@
+/* Copyright 2010-2016
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution of this software in source and binary forms, with or without
+ * modification, is permitted provided that the following two conditions are met.
+ *
+ * Use of this software in any manner constitutes agreement with the disclaimer
+ * which follows the two conditions.
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+ * AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <stddef.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <wchar.h>
+#include <signal.h>
+#include <dirent.h>
+#include <errno.h>
+#include "config.h"
+#include <sys/un.h>
+#include <netdb.h>
+#include ALLOCA_H
+#include "lib.h"
+#include "stream.h"
+#include "signal.h"
+#include "utf8.h"
+#include "unwind.h"
+#include "gc.h"
+#include "eval.h"
+#include "args.h"
+#include "struct.h"
+#include "arith.h"
+#include "socket.h"
+
+val sockaddr_in_s, sockaddr_in6_s, sockaddr_un_s, addrinfo_s;
+val flags_s, family_s, socktype_s, protocol_s, addr_s, canonname_s;
+val port_s, flow_info_s, scope_id_s, path_s;
+
+static val ipv4_addr_to_num(struct in_addr *src)
+{
+ return num_from_buffer(coerce(mem_t *, &src->s_addr), 4);
+}
+
+static void ipv4_addr_from_num(struct in_addr *dst, val addr)
+{
+ if (!num_to_buffer(addr, coerce(mem_t *, &dst->s_addr), 4))
+ uw_throwf(socket_error_s, lit("~s out of range for IPv4 address"),
+ addr, nao);
+}
+
+static val ipv6_addr_to_num(struct in6_addr *src)
+{
+ return num_from_buffer(src->s6_addr, 16);
+}
+
+static void ipv6_addr_from_num(struct in6_addr *dst, val addr)
+{
+ if (!num_to_buffer(addr, dst->s6_addr, 16))
+ uw_throwf(socket_error_s, lit("~s out of range for IPv6 address"),
+ addr, nao);
+}
+
+static void ipv6_flow_info_from_num(struct sockaddr_in6 *dst, val flow)
+{
+ if (!num_to_buffer(flow, coerce(mem_t *, &dst->sin6_flowinfo), 4))
+ uw_throwf(socket_error_s, lit("~s out of range for IPv6 flow info"),
+ flow, nao);
+}
+
+static void ipv6_scope_id_from_num(struct sockaddr_in6 *dst, val scope)
+{
+ if (!num_to_buffer(scope, coerce(mem_t *, &dst->sin6_scope_id), 4))
+ uw_throwf(socket_error_s, lit("~s out of range for IPv6 scope ID"),
+ scope, nao);
+}
+
+
+static val sockaddr_in_out(struct sockaddr_in *src)
+{
+ args_decl(args, ARGS_MIN);
+ val out = make_struct(sockaddr_in_s, nil, args);
+ slotset(out, addr_s, ipv4_addr_to_num(&src->sin_addr));
+ slotset(out, port_s, num_fast(ntohs(src->sin_port)));
+ return out;
+}
+
+static val sockaddr_in6_out(struct sockaddr_in6 *src)
+{
+ args_decl(args, ARGS_MIN);
+ val out = make_struct(sockaddr_in6_s, nil, args);
+ slotset(out, addr_s, ipv6_addr_to_num(&src->sin6_addr));
+ slotset(out, port_s, num_fast(ntohs(src->sin6_port)));
+ return out;
+}
+
+static val unix_sockaddr_out(struct sockaddr_un *src)
+{
+ args_decl(args, ARGS_MIN);
+ val out = make_struct(sockaddr_un_s, nil, args);
+ slotset(out, path_s, string_utf8(src->sun_path));
+ return out;
+}
+
+#ifdef HAVE_GETADDRINFO
+
+static void addrinfo_in(struct addrinfo *dest, val src)
+{
+ dest->ai_flags = c_num(default_arg(slot(src, flags_s), zero));
+ dest->ai_family = c_num(default_arg(slot(src, family_s), zero));
+ dest->ai_socktype = c_num(default_arg(slot(src, socktype_s), zero));
+ dest->ai_protocol = c_num(default_arg(slot(src, protocol_s), zero));
+}
+
+static val getaddrinfo_wrap(val node_in, val service_in, val hints_in)
+{
+ val node = default_arg(node_in, nil);
+ val service = default_arg(service_in, nil);
+ val hints = default_arg(hints_in, nil);
+ struct addrinfo hints_ai, *phints = hints ? &hints_ai : 0, *alist, *aiter;
+ char *node_u8 = stringp(node) ? utf8_dup_to(c_str(node)) : 0;
+ char *service_u8 = stringp(service) ? utf8_dup_to(c_str(service)) : 0;
+ val node_num_p = integerp(node);
+ val svc_num_p = integerp(service);
+ int res;
+ list_collect_decl (out, ptail);
+
+ if (hints) {
+ memset(&hints_ai, 0, sizeof hints_ai);
+ addrinfo_in(&hints_ai, hints);
+ }
+
+ res = getaddrinfo(node_u8, service_u8, phints, &alist);
+
+ free(node_u8);
+ free(service_u8);
+
+ if (res == 0) {
+ for (aiter = alist; aiter; aiter = aiter->ai_next) {
+ switch (aiter->ai_family) {
+ case AF_INET:
+ {
+ struct sockaddr_in *sa = coerce(struct sockaddr_in *, aiter->ai_addr);
+ if (node_num_p)
+ ipv4_addr_from_num(&sa->sin_addr, node);
+ if (svc_num_p)
+ sa->sin_port = htons(c_num(service));
+ ptail = list_collect(ptail, sockaddr_in_out(sa));
+ }
+ break;
+ case AF_INET6:
+ {
+ struct sockaddr_in6 *sa = coerce(struct sockaddr_in6 *, aiter->ai_addr);
+ if (node_num_p)
+ ipv6_addr_from_num(&sa->sin6_addr, node);
+ if (svc_num_p)
+ sa->sin6_port = ntohs(c_num(service));
+ ptail = list_collect(ptail, sockaddr_in6_out(sa));
+ }
+ break;
+ }
+ }
+ }
+
+ freeaddrinfo(alist);
+
+ return out;
+}
+
+#endif
+
+static void addr_mismatch(val addr, val family)
+{
+ uw_throwf(socket_error_s, lit("address ~s doesn't match address family ~s"),
+ addr, family, nao);
+}
+
+static void sockaddr_in(val sockaddr, val family,
+ struct sockaddr_storage *buf, socklen_t *len)
+{
+ val addr_type = typeof(sockaddr);
+
+ if (addr_type == sockaddr_in_s) {
+ val addr = slot(sockaddr, addr_s);
+ val port = slot(sockaddr, port_s);
+ struct sockaddr_in *sa = coerce(struct sockaddr_in *, buf);
+ if (family != num_fast(AF_INET))
+ addr_mismatch(sockaddr, family);
+ sa->sin_family = AF_INET;
+ ipv4_addr_from_num(&sa->sin_addr, addr);
+ sa->sin_port = ntohs(c_num(port));
+ *len = sizeof *sa;
+ } else if (addr_type == sockaddr_in6_s) {
+ val addr = slot(sockaddr, addr_s);
+ val port = slot(sockaddr, port_s);
+ val flow = slot(sockaddr, flow_info_s);
+ val scope = slot(sockaddr, scope_id_s);
+ struct sockaddr_in6 *sa = coerce(struct sockaddr_in6 *, buf);
+ if (family != num_fast(AF_INET6))
+ addr_mismatch(sockaddr, family);
+ sa->sin6_family = AF_INET6;
+ ipv6_addr_from_num(&sa->sin6_addr, addr);
+ ipv6_flow_info_from_num(sa, flow);
+ ipv6_scope_id_from_num(sa, scope);
+ sa->sin6_port = ntohs(c_num(port));
+ *len = sizeof *sa;
+ } else if (addr_type == sockaddr_un_s) {
+ val path = slot(sockaddr, path_s);
+ char *path_u8 = utf8_dup_to(c_str(path));
+ struct sockaddr_un *sa = coerce(struct sockaddr_un *, buf);
+ memset(sa, 0, sizeof *sa);
+ sa->sun_family = AF_UNIX;
+ strncpy(sa->sun_path, path_u8, sizeof sa->sun_path - 1);
+ free(path_u8);
+ *len = sizeof *sa;
+ } else {
+ uw_throwf(socket_error_s, lit("object ~s isn't a socket address"),
+ sockaddr, nao);
+ }
+}
+
+static val sock_bind(val sock, val sockaddr)
+{
+ val sfd = stream_fd(sock);
+ val family = sock_family(sock);
+ struct sockaddr_storage sa;
+ socklen_t salen;
+
+ sockaddr_in(sockaddr, family, &sa, &salen);
+
+ if (bind(c_num(sfd), coerce(struct sockaddr *, &sa), salen) != 0)
+ uw_throwf(socket_error_s, lit("bind failed: ~d/~s"),
+ num(errno), string_utf8(strerror(errno)), nao);
+
+ return t;
+}
+
+static val sock_connect(val sock, val sockaddr)
+{
+ val sfd = stream_fd(sock);
+ val family = sock_family(sock);
+ struct sockaddr_storage sa;
+ socklen_t salen;
+
+ sockaddr_in(sockaddr, family, &sa, &salen);
+
+ if (connect(c_num(sfd), coerce(struct sockaddr *, &sa), salen) != 0)
+ uw_throwf(socket_error_s, lit("connect failed: ~d/~s"),
+ num(errno), string_utf8(strerror(errno)), nao);
+
+ return t;
+}
+
+static val sock_listen(val sock, val backlog)
+{
+ val sfd = stream_fd(sock);
+
+ if (listen(c_num(sfd), c_num(default_arg(backlog, num_fast(16)))))
+ uw_throwf(socket_error_s, lit("listen failed: ~d/~s"),
+ num(errno), string_utf8(strerror(errno)), nao);
+
+ return t;
+}
+
+static val sock_accept(val sock, val mode_str)
+{
+ val sfd = stream_fd(sock);
+ val family = sock_family(sock);
+ struct sockaddr_storage sa;
+ socklen_t salen;
+ int afd;
+ val peer;
+
+ sig_save_enable;
+
+ afd = accept(c_num(sfd), coerce(struct sockaddr *, &sa), &salen);
+
+ sig_restore_enable;
+
+ if (afd < 0)
+ uw_throwf(socket_error_s, lit("accept failed: ~d/~s"),
+ num(errno), string_utf8(strerror(errno)), nao);
+
+ if (family == num_fast(AF_INET))
+ peer = sockaddr_in_out(coerce(struct sockaddr_in *, &sa));
+ else if (family == num_fast(AF_INET6))
+ peer = sockaddr_in6_out(coerce(struct sockaddr_in6 *, &sa));
+ else if (family == num_fast(AF_UNIX))
+ peer = unix_sockaddr_out(coerce(struct sockaddr_un *, &sa));
+ else
+ uw_throwf(socket_error_s, lit("accept: ~s isn't a supported socket family"),
+ family, nao);
+
+ {
+ val stream = open_sockfd(num(afd), family, num_fast(SOCK_STREAM), mode_str);
+ sock_set_peer(stream, peer);
+ return stream;
+ }
+}
+
+static val sock_shutdown(val sock, val how)
+{
+ val sfd = stream_fd(sock);
+
+ flush_stream(sock);
+
+ if (shutdown(c_num(sfd), c_num(default_arg(how, num_fast(SHUT_WR)))))
+ uw_throwf(socket_error_s, lit("shutdown failed: ~d/~s"),
+ num(errno), string_utf8(strerror(errno)), nao);
+
+ return t;
+}
+
+void sock_load_init(void)
+{
+ sockaddr_in_s = intern(lit("sockaddr-in"), user_package);
+ sockaddr_in6_s = intern(lit("sockaddr-in6"), user_package);
+ sockaddr_un_s = intern(lit("sockaddr-un"), user_package);
+ addrinfo_s = intern(lit("addrinfo"), user_package);
+ flags_s = intern(lit("flags"), user_package);
+ family_s = intern(lit("family"), user_package);
+ socktype_s = intern(lit("socktype"), user_package);
+ protocol_s = intern(lit("protocol"), user_package);
+ addr_s = intern(lit("addr"), user_package);
+ canonname_s = intern(lit("canonname"), user_package);
+ port_s = intern(lit("port"), user_package);
+ flow_info_s = intern(lit("flow-info"), user_package);
+ scope_id_s = intern(lit("scope-id"), user_package);
+ path_s = intern(lit("path"), user_package);
+
+#ifdef HAVE_GETADDRINFO
+ reg_fun(intern(lit("getaddrinfo"), user_package), func_n3o(getaddrinfo_wrap, 1));
+#endif
+
+ reg_varl(intern(lit("af-unspec"), user_package), num_fast(AF_UNSPEC));
+ reg_varl(intern(lit("af-unix"), user_package), num_fast(AF_UNIX));
+ reg_varl(intern(lit("af-inet"), user_package), num_fast(AF_INET));
+ reg_varl(intern(lit("af-inet6"), user_package), num_fast(AF_INET6));
+ reg_varl(intern(lit("sock-stream"), user_package), num_fast(SOCK_STREAM));
+ reg_varl(intern(lit("sock-dgram"), user_package), num_fast(SOCK_DGRAM));
+ reg_varl(intern(lit("inaddr-any"), user_package), zero);
+ reg_varl(intern(lit("inaddr-loopback"), user_package), num(0x7F000001));
+ reg_varl(intern(lit("in6addr-any"), user_package), zero);
+ reg_varl(intern(lit("in6addr-loopback"), user_package), one);
+#ifdef SOCK_NONBLOCK
+ reg_varl(intern(lit("sock-nonblock"), user_package), num_fast(SOCK_NONBLOCK));
+#endif
+#ifdef SOCK_CLOEXEC
+ reg_varl(intern(lit("sock-cloexec"), user_package), num_fast(SOCK_CLOEXEC));
+#endif
+#ifdef HAVE_GETADDRINFO
+ reg_varl(intern(lit("ai-passive"), user_package), num_fast(AI_PASSIVE));
+ reg_varl(intern(lit("ai-canonname"), user_package), num_fast(AI_CANONNAME));
+ reg_varl(intern(lit("ai-numerichost"), user_package), num_fast(AI_NUMERICHOST));
+ reg_varl(intern(lit("ai-v4mapped"), user_package), num_fast(AI_V4MAPPED));
+ reg_varl(intern(lit("ai-all"), user_package), num_fast(AI_ALL));
+ reg_varl(intern(lit("ai-addrconfig"), user_package), num_fast(AI_ADDRCONFIG));
+ reg_varl(intern(lit("ai-numericserv"), user_package), num_fast(AI_NUMERICSERV));
+#endif
+
+ reg_fun(intern(lit("sock-bind"), user_package), func_n2(sock_bind));
+ reg_fun(intern(lit("sock-connect"), user_package), func_n2(sock_connect));
+ reg_fun(intern(lit("sock-listen"), user_package), func_n2o(sock_listen, 1));
+ reg_fun(intern(lit("sock-accept"), user_package), func_n2o(sock_accept, 1));
+ reg_fun(intern(lit("sock-shutdown"), user_package), func_n2o(sock_shutdown, 1));
+}
diff --git a/socket.h b/socket.h
new file mode 100644
index 00000000..b334ee27
--- /dev/null
+++ b/socket.h
@@ -0,0 +1,28 @@
+/* Copyright 2010-2016
+ * Kaz Kylheku <kaz@kylheku.com>
+ * Vancouver, Canada
+ * All rights reserved.
+ *
+ * Redistribution of this software in source and binary forms, with or without
+ * modification, is permitted provided that the following two conditions are met.
+ *
+ * Use of this software in any manner constitutes agreement with the disclaimer
+ * which follows the two conditions.
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in
+ * the documentation and/or other materials provided with the
+ * distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL THE
+ * COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DAMAGES, HOWEVER CAUSED,
+ * AND UNDER ANY THEORY OF LIABILITY, ARISING IN ANY WAY OUT OF THE USE OF THIS
+ * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+void sock_init(void);
+void sock_load_init(void);
diff --git a/stream.c b/stream.c
index 2fd6b301..b55cd44c 100644
--- a/stream.c
+++ b/stream.c
@@ -49,6 +49,9 @@
#if HAVE_WINDOWS_H
#include <windows.h>
#endif
+#if HAVE_SOCKETS
+#include <sys/socket.h>
+#endif
#include ALLOCA_H
#include "lib.h"
#include "gc.h"
@@ -73,6 +76,10 @@ val format_s;
val stdio_stream_s;
+#if HAVE_SOCKETS
+val socket_error_s;
+#endif
+
void strm_base_init(struct strm_base *s)
{
static struct strm_base init = { indent_off, 60, 10, 0, 0 };
@@ -315,6 +322,10 @@ struct stdio_handle {
val mode; /* used by tail */
unsigned is_rotated; /* used by tail */
unsigned is_real_time;
+#if HAVE_SOCKETS
+ val family;
+ val type;
+#endif
};
static void stdio_stream_print(val stream, val out, val pretty)
@@ -346,6 +357,10 @@ static void stdio_stream_mark(val stream)
gc_mark(h->descr);
gc_mark(h->mode);
gc_mark(h->err);
+#if HAVE_SOCKETS
+ gc_mark(h->family);
+ gc_mark(h->type);
+#endif
}
static val errno_to_string(val err)
@@ -1124,6 +1139,10 @@ static val make_stdio_stream_common(FILE *f, val descr, struct cobj_ops *ops)
#else
h->is_real_time = 0;
#endif
+#if HAVE_SOCKETS
+ h->family = nil;
+ h->type = nil;
+#endif
return stream;
}
@@ -1144,6 +1163,40 @@ val make_pipe_stream(FILE *f, val descr)
return make_stdio_stream_common(f, descr, &pipe_ops.cobj_ops);
}
+#if HAVE_SOCKETS
+val make_sock_stream(FILE *f, val family, val type)
+{
+ val s = make_stdio_stream_common(f, lit("socket"), &stdio_ops.cobj_ops);
+ struct stdio_handle *h = coerce(struct stdio_handle *, s->co.handle);
+ h->family = family;
+ h->type = type;
+ return s;
+}
+#endif
+
+val stream_fd(val stream)
+{
+ struct stdio_handle *h = coerce(struct stdio_handle *,
+ cobj_handle(stream, stdio_stream_s));
+ return h->f ? num(fileno(h->f)) : nil;
+}
+
+#if HAVE_SOCKETS
+val sock_family(val stream)
+{
+ struct stdio_handle *h = coerce(struct stdio_handle *,
+ cobj_handle(stream, stdio_stream_s));
+ return h->family;
+}
+
+val sock_type(val stream)
+{
+ struct stdio_handle *h = coerce(struct stdio_handle *,
+ cobj_handle(stream, stdio_stream_s));
+ return h->type;
+}
+#endif
+
#if HAVE_FORK_STUFF
static val make_pipevp_stream(FILE *f, val descr, pid_t pid)
{
@@ -3106,6 +3159,35 @@ val open_fileno(val fd, val mode_str)
fd, nao)));
}
+#if HAVE_SOCKETS
+val open_sockfd(val fd, val family, val type, val mode_str_in)
+{
+ struct stdio_mode m;
+ val mode_str = default_arg(mode_str_in, lit("r+"));
+ FILE *f = (errno = 0, w_fdopen(c_num(fd), c_str(normalize_mode(&m, mode_str))));
+
+ if (!f) {
+ close(c_num(fd));
+ uw_throwf(file_error_s, lit("error creating stream for socket ~a: ~d/~s"),
+ fd, num(errno), string_utf8(strerror(errno)), nao);
+ }
+
+ if (type == num_fast(SOCK_DGRAM))
+ setvbuf(f, (char *) NULL, _IOFBF, 65536);
+ else
+ setvbuf(f, (char *) NULL, _IOLBF, 0);
+
+ return set_mode_props(m, make_sock_stream(f, family, type));
+}
+
+val open_socket(val family, val type, val mode_str)
+{
+ int fd = socket(c_num(family), c_num(type), 0);
+ return open_sockfd(num(fd), family, type, mode_str);
+}
+#endif
+
+
val open_tail(val path, val mode_str, val seek_end_p)
{
struct stdio_mode m;
@@ -3485,6 +3567,9 @@ void stream_init(void)
fd_k = intern(lit("fd"), keyword_package);
format_s = intern(lit("format"), user_package);
stdio_stream_s = intern(lit("stdio-stream"), user_package);
+#if HAVE_SOCKETS
+ socket_error_s = intern(lit("socket-error"), user_package);
+#endif
reg_var(stdin_s = intern(lit("*stdin*"), user_package),
make_stdio_stream(stdin, lit("stdin")));
@@ -3545,6 +3630,10 @@ void stream_init(void)
reg_fun(intern(lit("stream-set-prop"), user_package), func_n3(stream_set_prop));
reg_fun(intern(lit("stream-get-prop"), user_package), func_n2(stream_get_prop));
reg_fun(intern(lit("fileno"), user_package), curry_12_1(func_n2(stream_get_prop), fd_k));
+#ifdef HAVE_SOCKETS
+ reg_fun(intern(lit("sock-family"), user_package), func_n1(sock_family));
+ reg_fun(intern(lit("sock-type"), user_package), func_n1(sock_type));
+#endif
reg_fun(intern(lit("make-catenated-stream"), user_package), func_n0v(make_catenated_stream_v));
reg_fun(intern(lit("cat-streams"), user_package), func_n1(make_catenated_stream));
reg_fun(intern(lit("catenated-stream-p"), user_package), func_n1(catenated_stream_p));
@@ -3553,6 +3642,9 @@ void stream_init(void)
reg_fun(intern(lit("open-directory"), user_package), func_n1(open_directory));
reg_fun(intern(lit("open-file"), user_package), func_n2o(open_file, 1));
reg_fun(intern(lit("open-fileno"), user_package), func_n2o(open_fileno, 1));
+#ifdef HAVE_SOCKETS
+ reg_fun(intern(lit("open-socket"), user_package), func_n3o(open_socket, 2));
+#endif
reg_fun(intern(lit("open-tail"), user_package), func_n3o(open_tail, 1));
reg_fun(intern(lit("open-command"), user_package), func_n2o(open_command, 1));
reg_fun(intern(lit("open-pipe"), user_package), func_n2(open_command));
@@ -3576,6 +3668,10 @@ void stream_init(void)
reg_varl(intern(lit("indent-data"), user_package), num_fast(indent_data));
reg_varl(intern(lit("indent-code"), user_package), num_fast(indent_code));
+#if HAVE_SOCKETS
+ uw_register_subtype(socket_error_s, error_s);
+#endif
+
fill_stream_ops(&null_ops);
fill_stream_ops(&stdio_ops);
fill_stream_ops(&tail_ops);
diff --git a/stream.h b/stream.h
index 0891d9bc..28d7ea70 100644
--- a/stream.h
+++ b/stream.h
@@ -95,6 +95,10 @@ extern val stdin_s, stdout_s, stddebug_s, stderr_s, stdnull_s;
extern val print_flo_precision_s, print_flo_digits_s, print_flo_format_s;
extern val print_base_s;
+#if HAVE_SOCKETS
+extern val socket_error_s;
+#endif
+
void strm_base_init(struct strm_base *s);
void strm_base_cleanup(struct strm_base *s);
void strm_base_mark(struct strm_base *s);
@@ -106,6 +110,14 @@ val make_null_stream(void);
val make_stdio_stream(FILE *, val descr);
val make_tail_stream(FILE *, val descr);
val make_pipe_stream(FILE *, val descr);
+#if HAVE_SOCKETS
+val make_sock_stream(FILE *, val family, val type);
+#endif
+val stream_fd(val stream);
+#if HAVE_SOCKETS
+val sock_family(val stream);
+val sock_type(val stream);
+#endif
val make_string_input_stream(val);
val make_string_byte_input_stream(val);
val make_string_output_stream(void);
@@ -151,6 +163,10 @@ val get_string(val stream, val nchars, val close_after_p);
val open_directory(val path);
val open_file(val path, val mode_str);
val open_fileno(val fd, val mode_str);
+#if HAVE_SOCKETS
+val open_sockfd(val fd, val family, val type, val mode_str);
+val open_socket(val family, val type, val mode_str);
+#endif
val open_tail(val path, val mode_str, val seek_end_p);
val open_command(val path, val mode_str);
val open_process(val path, val mode_str, val args);