WIP udp server

This commit is contained in:
Quentin 2020-07-09 16:20:59 +02:00
parent 757656573a
commit 3e49fc158b
3 changed files with 30 additions and 15 deletions

View file

@ -67,15 +67,15 @@
((foreign-procedure
"inet_ntop"
(int void* (* char) int)
void*)
string)
(domain->int af)
src dst size))
(define (htons host)
((foreign-procedure "htons" (short) short) host))
((foreign-procedure "htons" (unsigned-16) unsigned-16) host))
(define (ntohs net)
((foreign-procedure "ntohs" (short) short) net))
((foreign-procedure "ntohs" (unsigned-16) unsigned-16) net))
(define (setsockopt sockfd level optname optval optlen)
((foreign-procedure

22
bindings/utils.scm Normal file
View file

@ -0,0 +1,22 @@
; Convert a char* to a Scheme string
; Extracted from this paper:
; http://scheme2011.ucombinator.org/papers/Keep2011.pdf
(define (char*->string fptr)
(let f ([i 0])
(let ([c (ftype-ref char () fptr i)])
(if (char=? c #\nul)
(make-string i)
(let ([str (f (fx+ i 1))])
(string-set! str i c)str)))))
(define (alloc size fx)
(let ([v (foreign-alloc size)])
(fx v)
(foreign-free v)))
(define (check-err ret msg)
(cond
((< ret 0)
(perror msg)
(raise msg))
(#t ret)))

View file

@ -1,16 +1,5 @@
(load "../bindings/libc.scm")
(define (check-err ret msg)
(cond
((< ret 0)
(perror msg)
(raise msg))
(#t ret)))
(define (alloc size fx)
(let ([v (foreign-alloc size)])
(fx v)
(foreign-free v)))
(load "../bindings/utils.scm")
(define (udpsock-create fx)
(fx
@ -89,4 +78,8 @@
(udpsock-readblock
sock
(lambda (host port buf size)
(printf "~a~%" size)
(printf "~a~%" port)
(printf "~a~%" host)
(printf "~a~%" (ftype-ref string () buf))
))))