From 47a07340ee0e7859df04a04071028df44bbdd7c1 Mon Sep 17 00:00:00 2001
From: Quentin <quentin@deuxfleurs.fr>
Date: Fri, 10 Jul 2020 10:32:46 +0200
Subject: [PATCH] Working UDP wrapper

---
 bindings/libc.scm       |  9 ++++++
 bindings/utils.scm      |  9 ++++++
 examples/udp_server.scm | 65 ++++++++++++++++++++++++-----------------
 3 files changed, 57 insertions(+), 26 deletions(-)

diff --git a/bindings/libc.scm b/bindings/libc.scm
index f6c1eec..eb2669e 100644
--- a/bindings/libc.scm
+++ b/bindings/libc.scm
@@ -124,3 +124,12 @@
     (msgflag->int msgflag)
     src-addr
     addrlen))
+
+(define (sendto sockfd buf len msgflag dest-addr addrlen)
+  ((foreign-procedure
+     "sendto"
+     (int void* size_t int (* sockaddr_in) socklen_t)
+     ssize_t)
+    sockfd buf len
+    (msgflag->int msgflag)
+    dest-addr addrlen))
diff --git a/bindings/utils.scm b/bindings/utils.scm
index 6c9e2c0..a8277ac 100644
--- a/bindings/utils.scm
+++ b/bindings/utils.scm
@@ -9,6 +9,15 @@
           (let ([str (f (fx+ i 1))])
             (string-set! str i c) str)))))
 
+(define (string->char* src dest destmax)
+  (let ([strlen (string-length src)])
+    (let f ([i 0])
+      (cond
+        ((or (>= i strlen) (>= i destmax)) dest)
+        (#t 
+          (ftype-set! char () dest i (string-ref src i))
+          (f (fx+ i 1)))))))
+
 (define (alloc size fx)
   (let ([v (foreign-alloc size)])
     (fx v)
diff --git a/examples/udp_server.scm b/examples/udp_server.scm
index 0b73843..724be95 100644
--- a/examples/udp_server.scm
+++ b/examples/udp_server.scm
@@ -21,26 +21,35 @@
           (ftype-sizeof int))
         "Unable to set REUSE ADDRESS"))))
 
-(define (udpsock-bind sock host port)
-  (alloc 
-    (ftype-sizeof sockaddr_in)
-    (lambda (raw-addr)
-      (let ([addr (make-ftype-pointer sockaddr_in raw-addr)])
-        (ftype-set! sockaddr_in (common family) addr (domain->int 'AF_INET))
-        (ftype-set! sockaddr_in (port) addr (htons port))
-        (check-err
-          (inet_pton 
+(define (configure-sockaddr_in! addr host port)
+  (ftype-set! sockaddr_in (common family) addr (domain->int 'AF_INET))
+  (ftype-set! sockaddr_in (port) addr (htons port))
+  (check-err
+    (inet_pton 
             'AF_INET 
             host
             (ftype-pointer-address
               (ftype-&ref sockaddr_in (addr) addr)))
-          "Unable to convert your IP address to binary")
-        (bind
-          sock
-          (ftype-pointer-address addr)
-          (ftype-sizeof sockaddr_in))))))
+          "Unable to convert your IP address to binary"))
 
-(define (udpsock-readblock sock fx)
+(define (build-sockaddr_in host port cb)
+  (alloc 
+    (ftype-sizeof sockaddr_in)
+    (lambda (raw-addr)
+      (let ([addr (make-ftype-pointer sockaddr_in raw-addr)])
+        (configure-sockaddr_in! addr host port)
+        (cb addr)))))
+
+(define (udpsock-bind sock host port)
+  (build-sockaddr_in
+    host port
+    (lambda (addr)
+      (bind
+        sock
+        (ftype-pointer-address addr)
+        (ftype-sizeof sockaddr_in)))))
+
+(define (udpsock-io sock fx)
   (letrec* 
     ([bufsize 1500] [straddrsize 255]
      [buf (foreign-alloc bufsize)]
@@ -57,7 +66,6 @@
     (loop 
       (lambda ()
         (let ([nread (recvfrom sock buf bufsize 'MSG_DEFAULT addr addrlen)])
-        (printf "~a~%" (ftype-pointer->sexpr addr))
         (fx
           (inet_ntop 
             'AF_INET 
@@ -66,7 +74,12 @@
               straddr
               straddrsize)
             (ntohs (ftype-ref sockaddr_in (port) addr))
-            buf nread))))
+            buf 
+            nread
+            (lambda (host port sendbuf sendbuflen) 
+              (configure-sockaddr_in! addr host port)
+              (sendto sock sendbuf sendbuflen 'MSG_DEFAULT addr (ftype-sizeof sockaddr_in))
+            )))))
 
     (foreign-free (ftype-pointer-address straddr))
     (foreign-free (ftype-pointer-address addrlen))
@@ -77,13 +90,13 @@
   (lambda (sock)
     (udpsock-reuseaddr sock)
     (udpsock-bind sock "127.0.0.8" 1337)
-    (udpsock-readblock 
+    (udpsock-io 
       sock 
-      (lambda (host port buf size)
-        (printf 
-          "host: ~a, port: ~a, size: ~a, buf: ~a~%"
-          host port size 
-          (char*->string
-            (make-ftype-pointer char buf)
-            size))
-))))
+      (lambda (host port buf nread send)
+        (let* ([charbuf (make-ftype-pointer char buf)]
+              [udpmsg (char*->string charbuf nread)])
+          (printf 
+            "host: ~a, port: ~a, nread: ~a, buf: ~a~%"
+            host port nread udpmsg)
+          (send host port (ftype-pointer-address (string->char* udpmsg charbuf nread)) nread)
+)))))