Working UDP wrapper

This commit is contained in:
Quentin 2020-07-10 10:32:46 +02:00
parent 19f1ced0d6
commit 47a07340ee
3 changed files with 57 additions and 26 deletions

View file

@ -124,3 +124,12 @@
(msgflag->int msgflag)
src-addr
addrlen))
(define (sendto sockfd buf len msgflag dest-addr addrlen)
((foreign-procedure
"sendto"
(int void* size_t int (* sockaddr_in) socklen_t)
ssize_t)
sockfd buf len
(msgflag->int msgflag)
dest-addr addrlen))

View file

@ -9,6 +9,15 @@
(let ([str (f (fx+ i 1))])
(string-set! str i c) str)))))
(define (string->char* src dest destmax)
(let ([strlen (string-length src)])
(let f ([i 0])
(cond
((or (>= i strlen) (>= i destmax)) dest)
(#t
(ftype-set! char () dest i (string-ref src i))
(f (fx+ i 1)))))))
(define (alloc size fx)
(let ([v (foreign-alloc size)])
(fx v)

View file

@ -21,26 +21,35 @@
(ftype-sizeof int))
"Unable to set REUSE ADDRESS"))))
(define (udpsock-bind sock host port)
(alloc
(ftype-sizeof sockaddr_in)
(lambda (raw-addr)
(let ([addr (make-ftype-pointer sockaddr_in raw-addr)])
(ftype-set! sockaddr_in (common family) addr (domain->int 'AF_INET))
(ftype-set! sockaddr_in (port) addr (htons port))
(check-err
(inet_pton
(define (configure-sockaddr_in! addr host port)
(ftype-set! sockaddr_in (common family) addr (domain->int 'AF_INET))
(ftype-set! sockaddr_in (port) addr (htons port))
(check-err
(inet_pton
'AF_INET
host
(ftype-pointer-address
(ftype-&ref sockaddr_in (addr) addr)))
"Unable to convert your IP address to binary")
(bind
sock
(ftype-pointer-address addr)
(ftype-sizeof sockaddr_in))))))
"Unable to convert your IP address to binary"))
(define (udpsock-readblock sock fx)
(define (build-sockaddr_in host port cb)
(alloc
(ftype-sizeof sockaddr_in)
(lambda (raw-addr)
(let ([addr (make-ftype-pointer sockaddr_in raw-addr)])
(configure-sockaddr_in! addr host port)
(cb addr)))))
(define (udpsock-bind sock host port)
(build-sockaddr_in
host port
(lambda (addr)
(bind
sock
(ftype-pointer-address addr)
(ftype-sizeof sockaddr_in)))))
(define (udpsock-io sock fx)
(letrec*
([bufsize 1500] [straddrsize 255]
[buf (foreign-alloc bufsize)]
@ -57,7 +66,6 @@
(loop
(lambda ()
(let ([nread (recvfrom sock buf bufsize 'MSG_DEFAULT addr addrlen)])
(printf "~a~%" (ftype-pointer->sexpr addr))
(fx
(inet_ntop
'AF_INET
@ -66,7 +74,12 @@
straddr
straddrsize)
(ntohs (ftype-ref sockaddr_in (port) addr))
buf nread))))
buf
nread
(lambda (host port sendbuf sendbuflen)
(configure-sockaddr_in! addr host port)
(sendto sock sendbuf sendbuflen 'MSG_DEFAULT addr (ftype-sizeof sockaddr_in))
)))))
(foreign-free (ftype-pointer-address straddr))
(foreign-free (ftype-pointer-address addrlen))
@ -77,13 +90,13 @@
(lambda (sock)
(udpsock-reuseaddr sock)
(udpsock-bind sock "127.0.0.8" 1337)
(udpsock-readblock
(udpsock-io
sock
(lambda (host port buf size)
(printf
"host: ~a, port: ~a, size: ~a, buf: ~a~%"
host port size
(char*->string
(make-ftype-pointer char buf)
size))
))))
(lambda (host port buf nread send)
(let* ([charbuf (make-ftype-pointer char buf)]
[udpmsg (char*->string charbuf nread)])
(printf
"host: ~a, port: ~a, nread: ~a, buf: ~a~%"
host port nread udpmsg)
(send host port (ftype-pointer-address (string->char* udpmsg charbuf nread)) nread)
)))))