diff --git a/bindings/libc.scm b/bindings/libc.scm index 18d3103..85dc570 100644 --- a/bindings/libc.scm +++ b/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)) + + diff --git a/examples/udp_server.scm b/examples/udp_server.scm index c7a63cd..4866507 100644 --- a/examples/udp_server.scm +++ b/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)))