WIP udp server

bindings/libc.scm

@@ -67,15 +67,15 @@
   ((foreign-procedure
      "inet_ntop"
      (int void* (* char) int)
-     void*)
+     string)
      (domain->int af)
      src dst size))
 
 (define (htons host)
-  ((foreign-procedure "htons" (short) short) host))
+  ((foreign-procedure "htons" (unsigned-16) unsigned-16) host))
 
 (define (ntohs net)
-  ((foreign-procedure "ntohs" (short) short) net))
+  ((foreign-procedure "ntohs" (unsigned-16) unsigned-16) net))
 
 (define (setsockopt sockfd level optname optval optlen)
   ((foreign-procedure

bindings/utils.scm

@@ -0,0 +1,22 @@
+; Convert a char* to a Scheme string
+; Extracted from this paper:
+; http://scheme2011.ucombinator.org/papers/Keep2011.pdf
+(define (char*->string fptr)
+  (let f ([i 0])
+    (let ([c (ftype-ref char () fptr i)])
+      (if (char=? c #\nul) 
+          (make-string i)
+          (let ([str (f (fx+ i 1))])
+            (string-set! str i c)str)))))
+
+(define (alloc size fx)
+  (let ([v (foreign-alloc size)])
+    (fx v)
+    (foreign-free v)))
+
+(define (check-err ret msg)
+  (cond
+    ((< ret 0)
+     (perror msg)
+     (raise msg))
+    (#t ret)))

examples/udp_server.scm

@@ -1,16 +1,5 @@
 (load "../bindings/libc.scm")
-
+(load "../bindings/utils.scm")
-(define (check-err ret msg)
-  (cond
-    ((< ret 0)
-     (perror msg)
-     (raise msg))
-    (#t ret)))
-
-(define (alloc size fx)
-  (let ([v (foreign-alloc size)])
-    (fx v)
-    (foreign-free v)))
 
 (define (udpsock-create fx)
   (fx 
@@ -89,4 +78,8 @@
     (udpsock-readblock 
       sock 
       (lambda (host port buf size)
+        (printf "~a~%" size)
+        (printf "~a~%" port)
+        (printf "~a~%" host)
+        (printf "~a~%" (ftype-ref string () buf))
 ))))