setsockopt

This commit is contained in:
Quentin 2020-07-09 12:12:38 +02:00
parent e1cf9a35b5
commit 33653804dc
2 changed files with 60 additions and 8 deletions

View file

@ -1,19 +1,19 @@
(load-shared-object "libc.so.6") (load-shared-object "libc.so.6")
(define (domain-flag->int flag) (define (domain->int flag)
(case flag (case flag
((AF_INET) 2) ((AF_INET) 2)
)) ))
(define (type-flag->int flag) (define (type->int flag)
(case flag (case flag
((SOCK_DGRAM) 2) ((SOCK_DGRAM) 2)
((SOCK_DCCP) 6) ((SOCK_DCCP) 6)
)) ))
(define (protocol-flag->int flag) (define (protocol->int flag)
(case flag (case flag
((IPPROTO_NONE) 0) ((IPPROTO_IP) 0)
((IPPROTO_DCCP) 33) ((IPPROTO_DCCP) 33)
)) ))
@ -28,6 +28,46 @@
"socket" "socket"
(int int int) (int int int)
int) int)
(domain-flag->int domain) (domain->int domain)
(type-flag->int type) (type->int type)
(protocol-flag->int protocol))) (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))

View file

@ -10,9 +10,21 @@
(define (udp-sock fx) (define (udp-sock fx)
(fx (fx
(check-err (check-err
(socket 'AF_INET 'SOCK_DGRAM 'IPPROTO_NONE) (socket 'AF_INET 'SOCK_DGRAM 'IPPROTO_IP)
"Unable to init UDP socket"))) "Unable to init UDP socket")))
(udp-sock (udp-sock
(lambda (s) (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))) (printf "~a~%" s)))