Retropikzel
/
foreign-c-srfis
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Drop the unix socket support from SRFI-106

This commit is contained in:
retropikzel 2026-01-10 06:19:26 +02:00
parent 2d7b225804
commit 7a565dc24d
3 changed files with 102 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

65
srfi/106.scm
View File

@ -36,7 +36,6 @@
(define *af-inet* 2)
(define *af-inet6* 10)
(define *af-unix* 1)
(define *af-unspec* 0)
(define *sock-stream* 1)
@ -78,7 +77,16 @@
(define socket-merge-flags (lambda flags (apply + flags)))
(define (socket-purge-flags base-flag . flags) (apply - (cons base-flag flags)))
(define (make-network-socket node service ai-family ai-socktype ai-flags ai-protocol)
(define (make-client-socket node service . args)
(let* ((ai-family (if (>= (length args) 1) (list-ref args 0) *af-inet*))
(ai-socktype (if (>= (length args) 2) (list-ref args 1) *sock-stream*))
(ai-flags (if (>= (length args) 3)
(list-ref args 2)
(socket-merge-flags *ai-v4mapped* *ai-addrconfig*)))
(ai-protocol
(if (>= (length args) 4)
(list-ref args 3)
*ipproto-ip*)))
(let* ((ai-family-offset (c-type-size 'int))
(ai-socktype-offset (* (c-type-size 'int) 2))
(ai-protocol-offset (* (c-type-size 'int) 3))
@ -126,45 +134,8 @@
;; TODO Why 8 works but 1 does not?
(when (= (c-poll pollfd 8 5000) 0)
(error "make-client-socket (poll) error")))
(make-socket socket-file-descriptor)))
(define (make-unix-socket node service ai-family ai-socktype ai-flags ai-protocol)
(let* ((socket-file-descriptor (c-socket ai-family ai-socktype 0))
(sockaddr
(let* ((pointer (make-c-bytevector 128 0))
(pointer-address (c-bytevector->integer pointer))
(node-pointer (integer->c-bytevector
(+ pointer-address *ai-family-size*))))
(c-bytevector-set! pointer 'u16 0 *af-unix*)
(c-strcpy node-pointer (string->c-utf8 node))
pointer))
(sockaddr-size (+ *ai-family-size* (bytevector-length (string->utf8 node)))))
(when (< socket-file-descriptor 0)
(c-perror (string->c-utf8 "make-client-socket (socket) error"))
(raise-continuable "make-client-socket (socket) error"))
(when (< (c-fcntl socket-file-descriptor F-SETFL O-NONBLOCK) 0)
(c-perror (string->c-utf8 "make-client-socket (fcntl) error"))
(raise-continuable "make-client-socket (fcntl) error"))
(let ((connect-result (c-connect socket-file-descriptor sockaddr sockaddr-size)))
(when (< connect-result 0)
(c-perror (string->c-utf8 "make-client-socket (connect) error"))
(raise-continuable "make-client-socket (connect) error"))
(make-socket socket-file-descriptor))))
(define (make-client-socket node service . args)
(let* ((ai-family (if (>= (length args) 1) (list-ref args 0) *af-inet*))
(ai-socktype (if (>= (length args) 2) (list-ref args 1) *sock-stream*))
(ai-flags (if (>= (length args) 3)
(list-ref args 2)
(socket-merge-flags *ai-v4mapped* *ai-addrconfig*)))
(ai-protocol
(if (>= (length args) 4)
(list-ref args 3)
*ipproto-ip*)))
(if (equal? ai-family *af-unix*)
(make-unix-socket node service ai-family ai-socktype ai-flags ai-protocol)
(make-network-socket node service ai-family ai-socktype ai-flags ai-protocol))))
(define message-type
(lambda names
(if (null? names)
@ -244,7 +215,10 @@
(raise-continuable "make-server-socket (listen) error"))
(make-socket socket-file-descriptor)))
(define (make-network-server-socket service ai-family ai-socktype ai-protocol)
(define (make-server-socket service . args)
(let* ((ai-family (if (>= (length args) 1) (list-ref args 0) *af-inet*))
(ai-socktype (if (>= (length args) 2) (list-ref args 1) *sock-stream*))
(ai-protocol (if (>= (length args) 3) (list-ref args 2) *ipproto-ip*)))
(let* ((ai-flags AI-PASSIVE)
(ai-flags-offset 0)
(ai-family-offset (c-type-size 'int))
@ -298,16 +272,7 @@
(when (< (c-listen socket-file-descriptor 5) 0)
(c-perror (string->c-utf8 "make-server-socket (listen) error"))
(raise-continuable "make-server-socket (listen) error"))
(make-socket socket-file-descriptor)))
(define (make-server-socket service . args)
(let* ((ai-family (if (>= (length args) 1) (list-ref args 0) *af-inet*))
(ai-socktype (if (>= (length args) 2) (list-ref args 1) *sock-stream*))
(ai-protocol (if (>= (length args) 3) (list-ref args 2) *ipproto-ip*)))
(if (equal? ai-family *af-unix*)
;(make-unix-server-socket node service ai-family ai-socktype ai-protocol)
(error "Unix server sockets are WIP")
(make-network-server-socket service ai-family ai-socktype ai-protocol))))
(make-socket socket-file-descriptor))))
(define (socket-accept socket)
(let* ((addrlen (let ((pointer (make-c-bytevector (c-type-size 'int))))

1
srfi/106.sld
View File

@ -25,7 +25,6 @@
socket-purge-flags
*af-inet*
*af-inet6*
*af-unix*
*af-unspec*
*sock-stream*
*sock-dgram*

35
srfi/106/test.scm
View File

@ -38,38 +38,3 @@
(debug (utf8->string (socket-recv client-sock1 3)))
(display "Testing UNIX socket")
(newline)
(debug (address-family unix))
(debug (address-info v4mapped addrconfig))
(debug (socket-domain stream))
(debug (ip-protocol ip))
(define sock-path "/tmp/demo.sock")
(c-system (string->c-utf8 (string-append "echo \"lol\" | nc -l -U " sock-path " &")))
(define usock1 (make-client-socket sock-path "3000" *af-unix*))
(debug usock1)
(debug (utf8->string (socket-recv usock1 3)))
(socket-send usock1 (string->utf8 "Hello from usock1\n"))
(socket-close usock1)
(define usock2-port "")
(define usock2 (make-server-socket usock2-port *af-unix*))
(debug usock2)
(display (string-append "run: echo \"lol\" | nc " sock-path " " usock2-port))
(newline)
(define client-usock1 (socket-accept usock2))
(debug client-usock1)
(socket-send client-sock1 (string->utf8 "Hello from client-usock1\n"))
(debug (utf8->string (socket-recv client-usock1 3)))