quentin/schemelib
1
0
Fork 0
Code Issues Pull requests Releases Wiki Activity

Fix broken implem

Browse source
This commit is contained in:
Quentin 2020-07-09 17:51:13 +02:00
parent f9b8f8a869
commit 1032ee7032
2 changed files with 29 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
bindings/libc.scm
View file

@ -33,17 +33,26 @@
(protocol->int protocol))) (protocol->int protocol)))
(define-ftype (define-ftype
[socklen_t unsigned-32]
[in_addr_t unsigned-32]
[in_addr [in_addr
(struct (struct
(s_addr unsigned-long))] [addr in_addr_t])]
[sa_family_t unsigned-short]
[in_port_t unsigned-16]
[sockaddr_common
(struct
[family sa_family_t])]
[sockaddr
(struct
[common sockaddr_common]
[data (array 14 char)])]
[sockaddr_in [sockaddr_in
(struct (struct
(sin_family short) [common sockaddr_common]
(sin_port unsigned-short) [port in_port_t]
(sin_addr in_addr) [addr in_addr]
(sin_zero (array 8 char)))] [zero (array 8 char)])])
)
(define (level->int flag) (define (level->int flag)
(case flag (case flag
@ -66,7 +75,7 @@
(define (inet_ntop af src dst size) (define (inet_ntop af src dst size)
((foreign-procedure ((foreign-procedure
"inet_ntop" "inet_ntop"
(int void* (* char) int) (int void* (* char) unsigned-32)
string) string)
(domain->int af) (domain->int af)
src dst size)) src dst size))
@ -107,7 +116,7 @@
(define (recvfrom sockfd buf len msgflag src-addr addrlen) (define (recvfrom sockfd buf len msgflag src-addr addrlen)
((foreign-procedure ((foreign-procedure
"recvfrom" "recvfrom"
(int void* int int (* sockaddr_in) (* int)) (int void* size_t int (* sockaddr_in) (* socklen_t))
int) int)
sockfd sockfd
buf buf

19
examples/udp_server.scm
View file

@ -26,14 +26,14 @@
(ftype-sizeof sockaddr_in) (ftype-sizeof sockaddr_in)
(lambda (raw-addr) (lambda (raw-addr)
(let ([addr (make-ftype-pointer sockaddr_in raw-addr)]) (let ([addr (make-ftype-pointer sockaddr_in raw-addr)])
(ftype-set! sockaddr_in (sin_family) addr (domain->int 'AF_INET)) (ftype-set! sockaddr_in (common family) addr (domain->int 'AF_INET))
(ftype-set! sockaddr_in (sin_port) addr (htons port)) (ftype-set! sockaddr_in (port) addr (htons port))
(check-err (check-err
(inet_pton (inet_pton
'AF_INET 'AF_INET
host host
(ftype-pointer-address (ftype-pointer-address
(ftype-&ref sockaddr_in (sin_addr) addr))) (ftype-&ref sockaddr_in (addr) addr)))
"Unable to convert your IP address to binary") "Unable to convert your IP address to binary")
(bind (bind
sock sock
@ -46,9 +46,9 @@
[buf (foreign-alloc bufsize)] [buf (foreign-alloc bufsize)]
[straddr (make-ftype-pointer char [straddr (make-ftype-pointer char
(foreign-alloc straddrsize))] (foreign-alloc straddrsize))]
[addrlen (make-ftype-pointer int [addrlen (make-ftype-pointer socklen_t
(foreign-alloc (ftype-sizeof int)))] (foreign-alloc (ftype-sizeof socklen_t)))]
[_ (ftype-set! int () addrlen (ftype-sizeof sockaddr_in))] [_ (ftype-set! socklen_t () addrlen (ftype-sizeof sockaddr_in))]
[addr (make-ftype-pointer [addr (make-ftype-pointer
sockaddr_in sockaddr_in
(foreign-alloc (ftype-sizeof sockaddr_in)))] (foreign-alloc (ftype-sizeof sockaddr_in)))]
@ -57,14 +57,15 @@
(loop (loop
(lambda () (lambda ()
(let ([nread (recvfrom sock buf bufsize 'MSG_DEFAULT addr addrlen)]) (let ([nread (recvfrom sock buf bufsize 'MSG_DEFAULT addr addrlen)])
(printf "~a~%" (ftype-pointer->sexpr addr))
(fx (fx
(inet_ntop (inet_ntop
'AF_INET 'AF_INET
(ftype-pointer-address (ftype-pointer-address
(ftype-&ref sockaddr_in (sin_addr) addr)) (ftype-&ref sockaddr_in (addr) addr))
straddr straddr
straddrsize) straddrsize)
(ntohs (ftype-ref sockaddr_in (sin_port) addr)) (ntohs (ftype-ref sockaddr_in (port) addr))
buf nread)))) buf nread))))
(foreign-free (ftype-pointer-address straddr)) (foreign-free (ftype-pointer-address straddr))
@ -75,7 +76,7 @@
(udpsock-create (udpsock-create
(lambda (sock) (lambda (sock)
(udpsock-reuseaddr sock) (udpsock-reuseaddr sock)
(udpsock-bind sock "0.0.0.0" 1337) (udpsock-bind sock "127.0.0.8" 1337)
(udpsock-readblock (udpsock-readblock
sock sock
(lambda (host port buf size) (lambda (host port buf size)