From c8f61c889305217e70c3f21e483bd979b9c5bc5d Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Fri, 22 Aug 2014 22:41:42 +0900
Subject: [PATCH] Adding send and receive support, with an example of how to
 use them with udp.

---
 examples/echo-server-udp.scm | 22 ++++++++++++++++++++
 lib/chibi/accept.c           | 38 +++++++++++++++++++++++++++++++++++
 lib/chibi/net.scm            | 39 ++++++++++++++++++++++++++++++++++--
 lib/chibi/net.sld            |  1 +
 lib/chibi/net.stub           | 10 +++++++++
 5 files changed, 108 insertions(+), 2 deletions(-)
 create mode 100755 examples/echo-server-udp.scm

diff --git a/examples/echo-server-udp.scm b/examples/echo-server-udp.scm
new file mode 100755
index 00000000..0e1077a8
--- /dev/null
+++ b/examples/echo-server-udp.scm
@@ -0,0 +1,22 @@
+#!/usr/bin/env chibi-scheme
+
+(import (scheme base) (chibi net))
+
+(define (get-udp-address-info host service)
+  (let ((hints (make-address-info address-family/inet
+                                  socket-type/datagram
+                                  ip-proto/udp)))
+    (get-address-info host service hints)))
+
+;; create and bind a udp socket
+(let* ((addr (get-udp-address-info #f 5556))
+       (sock (socket (address-info-family addr)
+                     (address-info-socket-type addr)
+                     (address-info-protocol addr))))
+  (bind sock (address-info-address addr) (address-info-address-length addr))
+  ;; for every packet we receive, just send it back
+  (let lp ()
+    (cond
+     ((receive sock 512 0 addr)
+      => (lambda (bv) (send sock bv 0 addr))))
+    (lp)))
diff --git a/lib/chibi/accept.c b/lib/chibi/accept.c
index b9ec5d0d..63cd7510 100644
--- a/lib/chibi/accept.c
+++ b/lib/chibi/accept.c
@@ -24,6 +24,44 @@ sexp sexp_accept (sexp ctx, sexp self, int sock, struct sockaddr* addr, socklen_
   return sexp_make_fileno(ctx, sexp_make_fixnum(res), SEXP_FALSE);
 }
 
+/* likewise sendto and recvfrom should suspend the thread gracefully */
+
+sexp sexp_sendto (sexp ctx, sexp self, int sock, const void* buffer, size_t len, int flags, struct sockaddr* addr, socklen_t addr_len) {
+#if SEXP_USE_GREEN_THREADS
+  sexp f;
+#endif
+  ssize_t res;
+  res = sendto(sock, buffer, len, flags, addr, addr_len);
+#if SEXP_USE_GREEN_THREADS
+  if (res < 0 && errno == EWOULDBLOCK) {
+    f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER);
+    if (sexp_opcodep(f)) {
+      ((sexp_proc2)sexp_opcode_func(f))(ctx, f, 1, sexp_make_fixnum(sock));
+      return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
+    }
+  }
+#endif
+  return sexp_make_fixnum(res);
+}
+
+sexp sexp_recvfrom (sexp ctx, sexp self, int sock, void* buffer, size_t len, int flags, struct sockaddr* addr, socklen_t addr_len) {
+#if SEXP_USE_GREEN_THREADS
+  sexp f;
+#endif
+  ssize_t res;
+  res = recvfrom(sock, buffer, len, flags, addr, &addr_len);
+#if SEXP_USE_GREEN_THREADS
+  if (res < 0 && errno == EWOULDBLOCK) {
+    f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER);
+    if (sexp_opcodep(f)) {
+      ((sexp_proc2)sexp_opcode_func(f))(ctx, f, 1, sexp_make_fixnum(sock));
+      return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
+    }
+  }
+#endif
+  return sexp_make_fixnum(res);
+}
+
 /* If we're listening on a socket from Scheme, we most likely want it */
 /* to be non-blocking. */
 
diff --git a/lib/chibi/net.scm b/lib/chibi/net.scm
index 05186168..0d1fcd08 100644
--- a/lib/chibi/net.scm
+++ b/lib/chibi/net.scm
@@ -1,12 +1,12 @@
 ;; Copyright (c) 2010-2012 Alex Shinn.  All rights reserved.
 ;; BSD-style license: http://synthcode.com/license.txt
 
-;;> \subsubsubsection{\scheme{(make-address-info family socktype proto [hints])}}
+;;> \procedure{(make-address-info family socktype proto [hints])}
 
 (define (make-address-info family socktype proto . o)
   (%make-address-info family socktype proto (if (pair? o) (car o) 0)))
 
-;;> \subsubsubsection{\scheme{(get-address-info host service [addrinfo])}}
+;;> \procedure{(get-address-info host service [addrinfo])}
 
 ;;> Create and return a new addrinfo structure for the given host
 ;;> and service.  \var{host} should be a string and \var{service} a
@@ -106,3 +106,38 @@
 (define (get-socket-option socket level name)
   (let ((res (getsockopt socket level name)))
     (and (pair? res) (car res))))
+
+;;> Sends the bytevector \var{bv} to \var{socket} with sendto and
+;;> returns the number of bytes sent, or a negative value on error.
+;;> If \var{addrinfo} is unspecified, \var{socket} must previously
+;;> have had a default address specified with \scheme{connect}.
+
+(define (send socket bv . o)
+  (let* ((flags (if (pair? o) (car o) 0))
+         (addrinfo (and (pair? o) (pair? (cdr o)) (cadr o)))
+         (sockaddr (and addrinfo (address-info-address addrinfo)))
+         (sockaddr-len (if addrinfo (address-info-address-length addrinfo) 0)))
+    (%send socket bv flags sockaddr sockaddr-len)))
+
+;;> Recieves data from \var{socket} to fill the bytevector \var{bv} by
+;;> calling recvfrom.  Returns the number of bytes read, or a negative
+;;> value on error.  If \var{addrinfo} is unspecified, \var{socket}
+;;> must previously have had a default address specified with
+;;> \scheme{connect}.
+
+(define (receive! socket bv . o)
+  (let* ((flags (if (pair? o) (car o) 0))
+         (addrinfo (and (pair? o) (pair? (cdr o)) (cadr o)))
+         (sockaddr (and addrinfo (address-info-address addrinfo)))
+         (sockaddr-len (if addrinfo (address-info-address-length addrinfo) 0)))
+    (%receive! socket bv flags sockaddr sockaddr-len)))
+
+;;> Shortcut for \scheme{receive}, returning a newly created
+;;> bytevector of length \var{n} on success and \scheme{#f} on
+;;> failure.
+
+(define (receive socket n . o)
+  (let* ((bv (make-bytevector n))
+         (m (apply receive! socket bv o)))
+    (and (>= m 0)
+         (subbytes bv 0 m))))
diff --git a/lib/chibi/net.sld b/lib/chibi/net.sld
index 9f7506cc..f1344f16 100644
--- a/lib/chibi/net.sld
+++ b/lib/chibi/net.sld
@@ -4,6 +4,7 @@
           socket connect bind accept listen open-socket-pair
           sockaddr-name sockaddr-port make-sockaddr
           with-net-io open-net-io make-listener-socket
+          send receive! receive
           address-info-family address-info-socket-type address-info-protocol
           address-info-address address-info-address-length address-info-next
           address-family/unix address-family/inet address-family/unspecified
diff --git a/lib/chibi/net.stub b/lib/chibi/net.stub
index 2023b85d..c4a757ce 100644
--- a/lib/chibi/net.stub
+++ b/lib/chibi/net.stub
@@ -51,6 +51,16 @@
 
 (define-c int connect (fileno sockaddr int))
 
+(define-c sexp (%send "sexp_sendto")
+  ((value ctx sexp) (value self sexp)
+   fileno bytevector (value (bytevector-length arg3) size_t) int
+   (maybe-null sockaddr) socklen_t))
+
+(define-c sexp (%receive! "sexp_recvfrom")
+  ((value ctx sexp) (value self sexp)
+   fileno bytevector (value (bytevector-length arg3) size_t) int
+   (maybe-null sockaddr) socklen_t))
+
 ;;> Returns a list of 2 new sockets, the input and output end of a new
 ;;> pipe, respectively.