Update makefile to use scheme-venv

.gitignore

@@ -0,0 +1,3 @@
+*.tgz
+venv
+*.html

Dockerfile.test

@@ -9,7 +9,7 @@ RUN wget https://gitlab.com/-/project/6808260/uploads/094ce726ce3c6cf8c14560f1e3
     && tar -xf akku-1.1.0.amd64-linux.tar.xz \
     && mv akku-1.1.0.amd64-linux akku
 RUN git clone https://github.com/ashinn/chibi-scheme.git --depth=1
-RUN git clone https://codeberg.org/retropikzel/compile-scheme.git --depth=1
+RUN git clone https://codeberg.org/retropikzel/compile-scheme.git --depth=2
 RUN git clone https://codeberg.org/retropikzel/foreign-c-libraries.git --depth=1
 WORKDIR /build/chibi-scheme
 RUN make
@@ -22,7 +22,8 @@ RUN git clone https://codeberg.org/foreign-c/foreign-c.git --depth=2
 ARG SCHEME=chibi
 ARG IMAGE=${SCHEME}:head
 FROM schemers/${IMAGE}
-RUN apt-get update && apt-get install -y make gcc libffi-dev libcurl4 gauche
+RUN apt-get update && apt-get install -y make gcc libffi-dev libcurl4 gauche \
+    netcat-openbsd ca-certificates curl
 RUN mkdir ${HOME}/.snow && echo "()" > ${HOME}/.snow/config.scm
 COPY --from=build /build /build
 ARG SCHEME=chibi
@@ -37,13 +38,15 @@ RUN bash install.sh
 ENV PATH=/root/.local/bin:${PATH}
 RUN akku update
 WORKDIR /build/foreign-c
-RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(srfi 64)" || true
-RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(foreign c)" || true
-RUN timeout 30 snow-chibi install --impls=${SCHEME} --always-yes "(retropikzel shell)" || true
+RUN snow-chibi install --impls=${SCHEME} --always-yes "(srfi 64)"
+RUN snow-chibi install --impls=${SCHEME} --always-yes "(foreign c)"
+RUN snow-chibi install --impls=${SCHEME} --always-yes "(retropikzel shell)"
+RUN snow-chibi install --impls=${SCHEME} --always-yes "(retropikzel debug)"
+RUN snow-chibi install --impls=${SCHEME} --always-yes --install-source-dir=. --install-library-dir=. "(foreign c)"
+RUN snow-chibi install --impls=${SCHEME} --always-yes "(retropikzel debug)"
 RUN make SCHEME=${SCHEME} build install
 WORKDIR /workdir
 RUN cp -r /build/foreign-c-libraries/retropikzel retropikzel/
 RUN cp -r /build/foreign-c/foreign .
 COPY Makefile .
 COPY srfi srfi/
-

Jenkinsfile

@@ -15,7 +15,7 @@ pipeline {
     parameters {
         string(name: 'R7RS_SCHEMES', defaultValue: 'chibi chicken gauche guile kawa mosh racket sagittarius stklos ypsilon', description: '')
         string(name: 'R6RS_SCHEMES', defaultValue: 'chezscheme guile ikarus ironscheme mosh racket sagittarius ypsilon', description: '')
-        string(name: 'SRFIS', defaultValue: '170', description: '')
+        string(name: 'SRFIS', defaultValue: '160 170', description: '')
     }
 
     stages {

Makefile

@@ -2,6 +2,7 @@
 	test-r7rs-docker
 .PHONY: test-r6rs test-r7rs
 SCHEME=chibi
+RNRS=r7rs
 SRFI=170
 AUTHOR=Retropikzel
 
@@ -31,32 +32,52 @@ install:
 uninstall:
 	-snow-chibi remove --impls=${SCHEME} ${PKG}
 
+init-venv: build
+	@rm -rf venv
+	@scheme-venv ${SCHEME} ${RNRS} venv
+	@echo "(import (scheme base) (scheme write) (scheme read) (scheme char) (scheme file) (scheme process-context) (srfi 64) (srfi ${SRFI}))" > venv/test.scm
+	@printf "#!r6rs\n(import (rnrs) (srfi :64) (srfi :${SRFI}))" > venv/test.sps
+	@cat ${TESTFILE} >> venv/test.scm
+	@cat ${TESTFILE} >> venv/test.sps
+	@if [ "${RNRS}" = "r6rs" ]; then if [ -d ../foreign-c ]; then cp -r ../foreign-c/foreign venv/lib/; fi; fi
+	@if [ "${RNRS}" = "r6rs" ]; then cp -r retropikzel venv/lib/; fi
+	@if [ "${SCHEME}" = "chezs" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${SCHEME}" = "ikarus" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${SCHEME}" = "ironscheme" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${SCHEME}" = "racket" ]; then ./venv/bin/akku install akku-r7rs chez-srfi; fi
+	@if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/akku install; fi
+	@if [ "${SCHEME}" = "chicken" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
+	@if [ "${SCHEME}-${RNRS}" = "mosh-r7rs" ]; then ./venv/bin/snow-chibi install --always-yes srfi.64; fi
+	@if [ "${RNRS}" = "r7rs" ]; then ./venv/bin/snow-chibi install ${PKG}; fi
+
+run-test: init-venv
+	if [ "${RNRS}" = "r6rs" ]; then ./venv/bin/scheme-compile venv/test.sps; fi
+	if [ "${RNRS}" = "r7rs" ]; then VENV_CSC_ARGS="-L -lcurl" ./venv/bin/scheme-compile venv/test.scm; fi
+	./venv/test
+
 test-r7rs: tmpdir
 	@if [ "${SCHEME}" = "chibi" ]; then rm -rf ${TMPDIR}/srfi/98.*; fi
 	cd ${TMPDIR} && echo "(import (scheme base) (scheme write) (scheme file) (scheme process-context) (foreign c) (srfi ${SRFI}) (srfi 64))" > test-r7rs.scm
 	cd ${TMPDIR} && cat srfi/${SRFI}/test.scm >> test-r7rs.scm
 	cd ${TMPDIR} && COMPILE_R7RS=${SCHEME} compile-scheme -I . -o test-r7rs test-r7rs.scm
-	cd ${TMPDIR} && printf "\n" | ./test-r7rs
+	cd ${TMPDIR} && printf "\n" | timeout 60 ./test-r7rs
 
 test-r7rs-docker:
-	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-srfi-test-${SCHEME} .
+	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-srfi-test-${SCHEME} -f Dockerfile.test .
 	docker run -t foreign-c-srfi-test-${SCHEME} sh -c "make SCHEME=${SCHEME} SRFI=${SRFI} SNOW_CHIBI_ARGS=--always-yes build install test-r7rs"
 
 test-r6rs: tmpdir
 	cd ${TMPDIR} && echo "(import (rnrs) (foreign c) (srfi :${SRFI}) (srfi :64))" > test-r6rs.sps
 	cd ${TMPDIR} && cat srfi/${SRFI}/test.scm >> test-r6rs.sps
-	cd ${TMPDIR} && akku install chez-srfi akku-r7rs "(foreign c)" #"(retropikzel shell)"
+	cd ${TMPDIR} && akku install chez-srfi akku-r7rs "(foreign c)"
 	cd ${TMPDIR} && COMPILE_R7RS=${SCHEME} compile-scheme -I .akku/lib -o test-r6rs test-r6rs.sps
-	cd ${TMPDIR} && ./test-r6rs
+	cd ${TMPDIR} && timeout 60 ./test-r6rs
 
 test-r6rs-docker:
-	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-srfi-test-${SCHEME} .
+	docker build --build-arg IMAGE=${DOCKERIMG} --build-arg SCHEME=${SCHEME} --tag=foreign-c-srfi-test-${SCHEME} -f Dockerfile.test .
 	docker run -t foreign-c-srfi-test-${SCHEME} sh -c "make SCHEME=${SCHEME} SRFI=${SRFI} test-r6rs"
 
 tmpdir:
 	rm -rf ${TMPDIR}
 	mkdir -p ${TMPDIR}
 	cp -r srfi ${TMPDIR}/
-
-clean:
-	git clean -X -f

README.md

@@ -0,0 +1,7 @@
+To SRFI library run
+
+    make SCHEME=chibi SRFI=106 build install
+
+
+Change chibi to any other implementation supported by snow-chibi, and 106
+to any filename without suffix in srfi/*.sld

srfi/106.scm

@@ -36,7 +36,6 @@
 
 (define *af-inet* 2)
 (define *af-inet6* 10)
-(define *af-unix* 1)
 (define *af-unspec* 0)
 
 (define *sock-stream* 1)
@@ -72,85 +71,12 @@
 (define SO-REUSEPORT 15)
 (define AI-PASSIVE 1)
 
-(define +sockaddr-size+ 16)
-(define +ai-family-size+ 2)
+(define *sockaddr-size* 16)
+(define *ai-family-size* 2)
 
 (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)
-  (let* ((ai-family-offset (c-type-size 'int))
-         (ai-socktype-offset (* (c-type-size 'int) 2))
-         (ai-protocol-offset (* (c-type-size 'int) 3))
-         (addrinfo-hints
-           (let ((pointer (make-c-bytevector 128 0)))
-             (c-bytevector-set! pointer 'int ai-family-offset ai-family)
-             (c-bytevector-set! pointer 'int ai-socktype-offset ai-socktype)
-             pointer))
-         (addrinfo (make-c-bytevector 128 0))
-         (addrinfo-result
-           (call-with-address-of
-             addrinfo
-             (lambda (addrinfo-address)
-               (call-with-address-of
-                 addrinfo-hints
-                 (lambda (addrinfo-hints-address)
-                   (c-getaddrinfo (string->c-utf8 node)
-                                  (string->c-utf8 service)
-                                  addrinfo-hints
-                                  addrinfo-address))))))
-         (socket-file-descriptor
-           (c-socket
-             (c-bytevector-ref addrinfo 'int ai-family-offset)
-             (c-bytevector-ref addrinfo 'int ai-socktype-offset)
-             (c-bytevector-ref addrinfo 'int ai-protocol-offset))))
-    (when (< addrinfo-result 0)
-      (c-perror (string->c-utf8 "make-client-socket (addrinfo) error"))
-      (raise-continuable "make-client-socket (addrinfo) error"))
-    (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"))
-    (letrec* ((ai-addr-offset (* (c-type-size 'int) 6))
-              (ai-addrlen-offset (* (c-type-size 'int) 4))
-              (connect-result
-                (c-connect socket-file-descriptor
-                           (c-bytevector-ref addrinfo 'pointer ai-addr-offset)
-                           (c-bytevector-ref addrinfo 'int ai-addrlen-offset)))
-              (pollfd (make-c-bytevector 128 0)))
-      (c-bytevector-set! pollfd 'uint 0 socket-file-descriptor)
-      (c-bytevector-set! pollfd 'int 0 0)
-      ;; FIXME No magic numbers, like 8 or 1 here. Put into variable with good name
-      ;; 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->address pointer))
-                  (node-pointer (address->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*))
@@ -161,9 +87,54 @@
            (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))))
+    (let* ((ai-family-offset (c-type-size 'int))
+           (ai-socktype-offset (* (c-type-size 'int) 2))
+           (ai-protocol-offset (* (c-type-size 'int) 3))
+           (addrinfo-hints
+             (let ((pointer (make-c-bytevector 128 0)))
+               (c-bytevector-set! pointer 'int ai-family-offset ai-family)
+               (c-bytevector-set! pointer 'int ai-socktype-offset ai-socktype)
+               pointer))
+           (addrinfo (make-c-bytevector 128 0))
+           (addrinfo-result
+             (call-with-address-of
+               addrinfo
+               (lambda (addrinfo-address)
+                 (call-with-address-of
+                   addrinfo-hints
+                   (lambda (addrinfo-hints-address)
+                     (c-getaddrinfo (string->c-utf8 node)
+                                    (string->c-utf8 service)
+                                    addrinfo-hints
+                                    addrinfo-address))))))
+           (socket-file-descriptor
+             (c-socket
+               (c-bytevector-ref addrinfo 'int ai-family-offset)
+               (c-bytevector-ref addrinfo 'int ai-socktype-offset)
+               (c-bytevector-ref addrinfo 'int ai-protocol-offset))))
+      (when (< addrinfo-result 0)
+        (c-perror (string->c-utf8 "make-client-socket (addrinfo) error"))
+        (raise-continuable "make-client-socket (addrinfo) error"))
+      (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"))
+      (letrec* ((ai-addr-offset (* (c-type-size 'int) 6))
+                (ai-addrlen-offset (* (c-type-size 'int) 4))
+                (connect-result
+                  (c-connect socket-file-descriptor
+                             (c-bytevector-ref addrinfo 'pointer ai-addr-offset)
+                             (c-bytevector-ref addrinfo 'int ai-addrlen-offset)))
+                (pollfd (make-c-bytevector 128 0)))
+        (c-bytevector-set! pollfd 'uint 0 socket-file-descriptor)
+        (c-bytevector-set! pollfd 'int 0 0)
+        ;; FIXME No magic numbers, like 8 or 1 here. Put into variable with good name
+        ;; 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 message-type
   (lambda names
@@ -196,6 +167,8 @@
 
 (define (socket-recv socket size . flags)
   ;; TODO FIXME If connection is closed return empty bytevector
+  (when (not (integer? size))
+    (error "socket-recv error: size must be integer" size))
   (let* ((msg-type (if (null? flags)
                      (message-type 'none)
                      (apply message-type flags)))
@@ -212,9 +185,9 @@
          (node "127.0.0.1")
          (sockaddr
            (let* ((pointer (make-c-bytevector 128 0))
-                  (pointer-address (c-bytevector->address pointer))
-                  (node-pointer (address->c-bytevector
-                                  (+ pointer-address +ai-family-size+))))
+                  (pointer-address (c-bytevector->integer pointer))
+                  (node-pointer (integer->c-bytevector
+                                  (+ pointer-address *ai-family-size*))))
              (c-bytevector-set! pointer 'u16 0 *af-inet*)
              (c-bytevector-set! pointer
                                 'u16
@@ -226,7 +199,7 @@
          (option (let ((pointer (make-c-bytevector (c-type-size 'int))))
                    (c-bytevector-set! pointer 'int 0 1)
                    pointer))
-         (sockaddr-size (+ +ai-family-size+ (bytevector-length (string->utf8 node)))))
+         (sockaddr-size (+ *ai-family-size* (bytevector-length (string->utf8 node)))))
     (when (< socket-file-descriptor 0)
       (c-perror (string->c-utf8 "make-server-socket (socket) error"))
       (raise-continuable "make-server-socket (socket) error"))
@@ -236,7 +209,7 @@
     (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEPORT option (c-type-size 'int)) 0)
       (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEPORT) error"))
       (raise-continuable "make-server-socket (setsockopt SO-REUSEPORT) error"))
-    (when (< (c-bind socket-file-descriptor sockaddr +sockaddr-size+) 0)
+    (when (< (c-bind socket-file-descriptor sockaddr *sockaddr-size*) 0)
       (c-perror (string->c-utf8 "socket-accept (bind) error"))
       (raise-continuable "socket-accept (bind) error"))
     (when (< (c-listen socket-file-descriptor 0) 0)
@@ -244,70 +217,64 @@
       (raise-continuable "make-server-socket (listen) error"))
     (make-socket socket-file-descriptor)))
 
-(define (make-network-server-socket service ai-family ai-socktype ai-protocol)
-  (let* ((ai-flags AI-PASSIVE)
-         (ai-flags-offset 0)
-         (ai-family-offset (c-type-size 'int))
-         (ai-socktype-offset (* (c-type-size 'int) 2))
-         (ai-protocol-offset (* (c-type-size 'int) 3))
-         (addrinfo-hints
-           (let ((pointer (make-c-bytevector 128 0)))
-             (c-bytevector-set! pointer 'int ai-flags-offset ai-flags)
-             (c-bytevector-set! pointer 'int ai-family-offset ai-family)
-             (c-bytevector-set! pointer 'int ai-socktype-offset ai-socktype)
-             pointer))
-         (addrinfo (make-c-bytevector 128 0))
-         (addrinfo-result
-           (call-with-address-of
-             addrinfo
-             (lambda (addrinfo-address)
-               (call-with-address-of
-                 addrinfo-hints
-                 (lambda (addrinfo-hints-address)
-                   (c-getaddrinfo (string->c-utf8 "0.0.0.0")
-                                  (string->c-utf8 service)
-                                  addrinfo-hints
-                                  addrinfo-address))))))
-         (socket-file-descriptor
-           (c-socket
-             (c-bytevector-ref addrinfo 'int ai-family-offset)
-             (c-bytevector-ref addrinfo 'int ai-socktype-offset)
-             (c-bytevector-ref addrinfo 'int ai-protocol-offset)))
-         (option (let ((pointer (make-c-bytevector (c-type-size 'int))))
-                   (c-bytevector-set! pointer 'int 0 1)
-                   pointer))
-         (ai-addr-offset (* (c-type-size 'int) 6))
-         (ai-addr (c-bytevector-ref addrinfo 'pointer ai-addr-offset))
-         (ai-addrlen-offset (* (c-type-size 'int) 4))
-         (ai-addr-len (c-bytevector-ref addrinfo 'int ai-addrlen-offset)))
-    (when (< addrinfo-result 0)
-      (c-perror (string->c-utf8 "make-server-socket (addrinfo) error"))
-      (raise-continuable "make-server-socket (addrinfo) error"))
-    (when (< socket-file-descriptor 0)
-      (c-perror (string->c-utf8 "make-server-socket (socket) error"))
-      (raise-continuable "make-server-socket (socket) error"))
-    (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEADDR option (c-type-size 'int)) 0)
-      (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEADDR) error"))
-      (raise-continuable "make-server-socket (setsockopt SO-REUSEADDR) error"))
-    (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEPORT option (c-type-size 'int)) 0)
-      (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEPORT) error"))
-      (raise-continuable "make-server-socket (setsockopt SO-REUSEPORT) error"))
-    (when (< (c-bind socket-file-descriptor ai-addr ai-addr-len) 0)
-      (c-perror (string->c-utf8 "make-server-socket (bind) error"))
-      (raise-continuable "make-servever-socket (bind) error"))
-    (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))))
+    (let* ((ai-flags AI-PASSIVE)
+           (ai-flags-offset 0)
+           (ai-family-offset (c-type-size 'int))
+           (ai-socktype-offset (* (c-type-size 'int) 2))
+           (ai-protocol-offset (* (c-type-size 'int) 3))
+           (addrinfo-hints
+             (let ((pointer (make-c-bytevector 128 0)))
+               (c-bytevector-set! pointer 'int ai-flags-offset ai-flags)
+               (c-bytevector-set! pointer 'int ai-family-offset ai-family)
+               (c-bytevector-set! pointer 'int ai-socktype-offset ai-socktype)
+               pointer))
+           (addrinfo (make-c-bytevector 128 0))
+           (addrinfo-result
+             (call-with-address-of
+               addrinfo
+               (lambda (addrinfo-address)
+                 (call-with-address-of
+                   addrinfo-hints
+                   (lambda (addrinfo-hints-address)
+                     (c-getaddrinfo (string->c-utf8 "0.0.0.0")
+                                    (string->c-utf8 service)
+                                    addrinfo-hints
+                                    addrinfo-address))))))
+           (socket-file-descriptor
+             (c-socket
+               (c-bytevector-ref addrinfo 'int ai-family-offset)
+               (c-bytevector-ref addrinfo 'int ai-socktype-offset)
+               (c-bytevector-ref addrinfo 'int ai-protocol-offset)))
+           (option (let ((pointer (make-c-bytevector (c-type-size 'int))))
+                     (c-bytevector-set! pointer 'int 0 1)
+                     pointer))
+           (ai-addr-offset (* (c-type-size 'int) 6))
+           (ai-addr (c-bytevector-ref addrinfo 'pointer ai-addr-offset))
+           (ai-addrlen-offset (* (c-type-size 'int) 4))
+           (ai-addr-len (c-bytevector-ref addrinfo 'int ai-addrlen-offset)))
+      (when (< addrinfo-result 0)
+        (c-perror (string->c-utf8 "make-server-socket (addrinfo) error"))
+        (raise-continuable "make-server-socket (addrinfo) error"))
+      (when (< socket-file-descriptor 0)
+        (c-perror (string->c-utf8 "make-server-socket (socket) error"))
+        (raise-continuable "make-server-socket (socket) error"))
+      (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEADDR option (c-type-size 'int)) 0)
+        (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEADDR) error"))
+        (raise-continuable "make-server-socket (setsockopt SO-REUSEADDR) error"))
+      (when (< (c-setsockopt socket-file-descriptor SOL-SOCKET SO-REUSEPORT option (c-type-size 'int)) 0)
+        (c-perror (string->c-utf8 "make-server-socket (setsockopt SO-REUSEPORT) error"))
+        (raise-continuable "make-server-socket (setsockopt SO-REUSEPORT) error"))
+      (when (< (c-bind socket-file-descriptor ai-addr ai-addr-len) 0)
+        (c-perror (string->c-utf8 "make-server-socket (bind) error"))
+        (raise-continuable "make-server-socket (bind) error"))
+      (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 (socket-accept socket)
   (let* ((addrlen (let ((pointer (make-c-bytevector (c-type-size 'int))))
@@ -337,19 +304,19 @@
            ((symbol=? 'name 'inet6) *af-inet6*)
            ((symbol=? 'name 'unspec) *af-unspec*)
            ((symbol=? 'name 'unix) *af-unix*)
-           (else (error "address-family: Unrecognized name" name))))))
+           (else (error "address-family: Unrecognized name" 'name))))))
 
 (define-syntax address-info
   (syntax-rules ()
     ((_ names ...)
      (apply socket-merge-flags
             (map (lambda (name)
-                   (cond ((symbol=? name 'canoname) *ai-canoname*)
+                   (cond ((symbol=? name 'canonname) *ai-canonname*)
                          ((symbol=? name 'numerichost) *ai-numerichost*)
                          ((symbol=? name 'v4mapped) *ai-v4mapped*)
                          ((symbol=? name 'all) *ai-all*)
                          ((symbol=? name 'addrconfig) *ai-addrconfig*)
-                         (else (error "address-info: Unrecognized name" name))))
+                         (else (error "address-info: Unrecognized name" 'name))))
                  '(names ...))))))
 
 (define-syntax socket-domain
@@ -357,7 +324,7 @@
     ((_ name)
      (cond ((symbol=? 'name 'stream) *sock-stream*)
            ((symbol=? 'name 'datagram) *af-unix*)
-           (else (error "socket-domain: Unrecognized name" name))))))
+           (else (error "socket-domain: Unrecognized name" 'name))))))
 
 (define-syntax ip-protocol
   (syntax-rules ()
@@ -365,7 +332,7 @@
      (cond ((symbol=? 'name 'ip) *ipproto-ip*)
            ((symbol=? 'name 'tcp) *ipproto-tcp*)
            ((symbol=? 'name 'udp) *ipproto-udp*)
-           (else (error "ip-protocol: Unrecognized name" name))))))
+           (else (error "ip-protocol: Unrecognized name" 'name))))))
 
 (define-syntax shutdown-method
   (syntax-rules ()

srfi/106.sld

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

srfi/106/test.scm

@@ -1,33 +1,23 @@
 
-
-(display "HERE address-family: ")
-(write (address-family inet))
-(newline)
-
-(display "HERE address-info: ")
-(write (address-info v4mapped addrconfig))
-(newline)
-
-(display "HERE socket-domain:")
-(write (socket-domain stream))
-(newline)
-
-(display "HERE ip-protocol: ")
-(write (ip-protocol ip))
-(newline)
+(define sock1-port "3005")
+(define sock2-port "3006")
 
 (define-c-library libc `("stdlib.h") libc-name '((additional-versions ("0" "6"))))
 (define-c-procedure c-system libc 'system 'int '(pointer))
 
-(c-system (string->c-utf8 "echo \"lol\" | nc -l 3001 &"))
-
-(define sock1 (make-client-socket "127.0.0.1" "3001"))
-
-(display "HERE sock1: ")
-(write sock1)
+(display "Testing TCP socket")
 (newline)
 
-(display "HERE sock1 recv: ")
+;(debug (address-family inet))
+;(debug (address-info v4mapped addrconfig))
+;(debug (socket-domain stream))
+;(debug (ip-protocol ip))
+
+(c-system (string->c-utf8 (string-append "echo \"lol\" | nc -l " sock1-port "&")))
+
+(define sock1 (make-client-socket "127.0.0.1" sock1-port))
+
+;(debug sock1)
 (write (utf8->string (socket-recv sock1 3)))
 (newline)
 
@@ -36,43 +26,17 @@
 (socket-close sock1)
 
 
-(define sock2-port "3002")
 (define sock2 (make-server-socket sock2-port))
-(display "HERE sock2: ")
-(write sock2)
-(newline)
+;(debug sock2)
 
 (display (string-append "run: echo \"lol\" | nc 127.0.0.1 " sock2-port))
 (newline)
 
 (define client-sock1 (socket-accept sock2))
-(display "HERE client-sock1: ")
-(write client-sock1)
-(newline)
+;(debug client-sock1)
 
 (socket-send client-sock1 (string->utf8 "Hello from client-sock1\n"))
 
-(display "HERE client-sock1 recv: ")
 (write (utf8->string (socket-recv client-sock1 3)))
 (newline)
 
-
-
-#|
-(c-system (string->c-utf8 "echo \"lol\" | nc -l -U /tmp/demo.sock &"))
-
-(define sock2 (make-client-socket "/tmp/demo.sock" "3000" *af-unix*))
-
-
-(display "HERE sock2: ")
-(write (utf8->string (socket-recv sock2 3)))
-(newline)
-
-(socket-send sock2 (string->utf8 "Hello from sock2\n"))
-
-(socket-close sock2)
-|#
-
-
-
-

srfi/170.scm

@@ -176,11 +176,12 @@
   (letrec* ((looper (lambda (c index result)
                       (if (char=? c #\null)
                         (list->string (reverse result))
-                        (looper (c-bytevector-char-ref pointer
-                                                       (+ offset index))
+                        (looper (c-bytevector-ref pointer
+                                                  'char
+                                                  (+ offset index))
                                 (+ index 1)
                                 (cons c result))))))
-    (looper (c-bytevector-char-ref pointer offset) 1 (list))))
+    (looper (c-bytevector-ref pointer 'char offset) 1 (list))))
 
 ; struct dirent d_name offset on linux
 (define d-name-offset 19)
@@ -332,10 +333,10 @@
                  (+ count 1)
                  groups-pointer
                  (append result
-                         (list (c-bytevector-sint-ref groups-pointer
-                                                      (* (c-type-size 'int) count)
-                                                      (native-endianness)
-                                                      (c-type-size 'int)))))))
+                         (list (c-bytevector-ref groups-pointer
+                                                 'int
+                                                 (* (c-type-size 'int) count)
+                                                 ))))))
 
 (define (user-supplementary-gids)
   (let* ((group-count (c-getgroups 0 (make-c-null)))
@@ -357,26 +358,28 @@
   (let ((password-struct (if (number? uid/name)
                            (c-getpwuid uid/name)
                            (c-getpwnam (string->c-utf8 uid/name)))))
-    (make-user-info (c-utf8->string (c-bytevector-pointer-ref password-struct
-                                                              0))
-                    (c-bytevector-sint-ref password-struct
-                                           (* (c-type-size 'pointer) 2)
-                                           (native-endianness)
-                                           (c-type-size 'int))
-                    (c-bytevector-sint-ref password-struct
-                                           (+ (* (c-type-size 'pointer) 2)
-                                              (c-type-size 'int))
-                                           (native-endianness)
-                                           (c-type-size 'int))
-                    (c-utf8->string (c-bytevector-pointer-ref password-struct
-                                                              (+ (* (c-type-size 'pointer) 3)
-                                                                 (* (c-type-size 'int) 2))))
-                    (c-utf8->string (c-bytevector-pointer-ref password-struct
-                                                              (+ (* (c-type-size 'pointer) 4)
-                                                                 (* (c-type-size 'int) 2))))
-                    (c-utf8->string (c-bytevector-pointer-ref password-struct
-                                                              (+ (* (c-type-size 'pointer) 2)
-                                                                 (* (c-type-size 'int) 2)))))))
+    (make-user-info (c-utf8->string (c-bytevector-ref password-struct
+                                                      'pointer
+                                                      0))
+                    (c-bytevector-ref password-struct
+                                      'int
+                                      (* (c-type-size 'pointer) 2))
+                    (c-bytevector-ref password-struct
+                                      'int
+                                      (+ (* (c-type-size 'pointer) 2)
+                                         (c-type-size 'int)))
+                    (c-utf8->string (c-bytevector-ref password-struct
+                                                      'pointer
+                                                      (+ (* (c-type-size 'pointer) 3)
+                                                         (* (c-type-size 'int) 2))))
+                    (c-utf8->string (c-bytevector-ref password-struct
+                                                      'pointer
+                                                      (+ (* (c-type-size 'pointer) 4)
+                                                         (* (c-type-size 'int) 2))))
+                    (c-utf8->string (c-bytevector-ref password-struct
+                                                      'pointer
+                                                      (+ (* (c-type-size 'pointer) 2)
+                                                         (* (c-type-size 'int) 2)))))))
 
 
 (define-record-type <group-info>
@@ -390,11 +393,10 @@
                         (c-getgrgid gid/name)
                         (c-getgrnam (string->c-utf8 gid/name)))))
     (make-group-info
-      (c-utf8->string (c-bytevector-pointer-ref group-struct 0))
-      (c-bytevector-sint-ref group-struct
-                             (* (c-type-size 'pointer) 2)
-                             (native-endianness)
-                             (c-type-size 'int)))))
+      (c-utf8->string (c-bytevector-ref group-struct 'pointer 0))
+      (c-bytevector-ref group-struct
+                        'int
+                        (* (c-type-size 'pointer) 2)))))
 
 (define (set-environment-variable! name value)
   (c-setenv (string->c-utf8 name) (string->c-utf8 value) 1))

srfi/170/VERSION

@@ -1 +1 @@
-0.1.1
+0.1.2

srfi/srfi-106.scm

@@ -0,0 +1,46 @@
+(define-library
+  (srfi 106)
+  (import (scheme base)
+          (scheme write)
+          (scheme process-context)
+          (foreign c))
+  (export make-client-socket
+          make-server-socket
+          socket?
+          socket-accept
+          socket-send
+          socket-recv
+          socket-shutdown
+          socket-close
+          ;socket-input-port
+          ;socket-output-port
+          call-with-socket
+          address-family
+          address-info
+          socket-domain
+          ip-protocol
+          message-type
+          shutdown-method
+          socket-merge-flags
+          socket-purge-flags
+          *af-inet*
+          *af-inet6*
+          *af-unspec*
+          *sock-stream*
+          *sock-dgram*
+          *ai-canonname*
+          *ai-numerichost*
+          *ai-v4mapped*
+          *ai-all*
+          *ai-addrconfig*
+          *ipproto-ip*
+          *ipproto-tcp*
+          *ipproto-udp*
+          *msg-peek*
+          *msg-oob*
+          *msg-waitall*
+          *shut-rd*
+          *shut-wr*
+          *shut-rdwr*)
+  (include "106.scm"))
+