setsockopt

bindings/libc.scm

@@ -1,19 +1,19 @@
 (load-shared-object "libc.so.6")
 
-(define (domain-flag->int flag)
+(define (domain->int flag)
   (case flag
     ((AF_INET) 2)
 ))
 
-(define (type-flag->int flag)
+(define (type->int flag)
   (case flag
     ((SOCK_DGRAM) 2)
     ((SOCK_DCCP) 6)
 ))
 
-(define (protocol-flag->int flag)
+(define (protocol->int flag)
   (case flag
-    ((IPPROTO_NONE) 0)
+    ((IPPROTO_IP) 0)
     ((IPPROTO_DCCP) 33)
 ))
 
@@ -28,6 +28,46 @@
     "socket"
     (int int int)
     int)
-     (domain-flag->int domain)
-     (type-flag->int type) 
-     (protocol-flag->int protocol)))
+     (domain->int domain)
+     (type->int type) 
+     (protocol->int protocol)))
+
+(define-ftype
+  [in_addr
+    (struct
+      (s_addr unsigned-long))]
+
+  [sockaddr_in
+    (struct
+      (sin_family short)
+      (sin_port unsigned-short)
+      (sin_addr in_addr)
+      (sin_zero (array 8 char)))]
+)
+
+(define (level->int flag)
+   (case flag
+    ((SOL_SOCKET) #x1)
+))
+
+(define (optname->int flag)
+   (case flag
+    ((SO_REUSEADDR) #x2)
+))
+
+(define (alloc size fx)
+  (let ([v (foreign-alloc size)])
+    (fx v)
+    (foreign-free v)))
+
+(define (setsockopt sockfd level optname optval optlen)
+  ((foreign-procedure
+    "setsockopt"
+    (int int int void* int)
+    int) 
+   sockfd 
+   (level->int level)
+   (optname->int optname)
+   optval optlen))
+
+

examples/udp_server.scm

@@ -10,9 +10,21 @@
 (define (udp-sock fx)
   (fx 
     (check-err 
-      (socket 'AF_INET 'SOCK_DGRAM 'IPPROTO_NONE)
+      (socket 'AF_INET 'SOCK_DGRAM 'IPPROTO_IP)
       "Unable to init UDP socket")))
 
 (udp-sock 
   (lambda (s)
+    (alloc 
+      (ftype-sizeof int)
+      (lambda (activation)
+        (foreign-set! 'int activation 0 1)
+        (check-err
+          (setsockopt 
+            s 
+            'SOL_SOCKET 
+            'SO_REUSEADDR
+            activation
+            (ftype-sizeof int))
+          "Unable to set REUSE ADDRESS")))
     (printf "~a~%" s)))