Commitf578388cRecorded1 Jun 2026Repositorysigil-socket

Use async DNS when a scheduler is active

Message

Wrap resolve-hostname and tcp-connect so scheduler-backed callers offload DNS through the new resolver fd natives, wait with the existing fd readiness protocol, and connect by numeric address. Non-async callers continue to use the synchronous native path.

The async resolver path uses dynamic-wind to cancel outstanding native jobs if the continuation exits before taking the result.

Verification: guix shell -m manifest.scm -- make test in the Sigil monorepo with this checkout redirected as sigil-socket.

Changed
 src/sigil/socket.sgl | 63 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 59 insertions(+), 4 deletions(-)
Diff
src/sigil/socket.sglmodified
@@ -35,7 +35,8 @@
35
;;; ```
36
37
(define-library (sigil socket)
−38
(import (sigil string))
+38
(import (sigil async scheduler)
+39
(sigil string))
40
41
(export
42
;; Type predicate
@@ -91,6 +92,60 @@
92
93
(begin
94
+95
(define-native (%tcp-connect-sync host port)
+96
(: string? integer? -> (maybe socket?)))
+97
+98
(define-native (%tcp-connect-ip ip port)
+99
(: string? integer? -> (maybe socket?)))
+100
+101
(define-native (%resolve-hostname-sync host)
+102
(: string? -> (maybe list?)))
+103
+104
(define-native (%resolve-start host)
+105
(: string? -> (maybe integer?)))
+106
+107
(define-native (%resolve-take fd)
+108
(: integer? -> (maybe list?)))
+109
+110
(define-native (%resolve-cancel fd)
+111
(: integer? -> boolean?))
+112
+113
(define (%await-readable-fd fd)
+114
(: integer? -> any?)
+115
(if (current-scheduler)
+116
(abort-to-prompt async-prompt-tag 'io-read-fd fd #f)
+117
(fd-select (list fd) '() #f)))
+118
+119
(define (resolve-hostname host)
+120
(: string? -> (maybe list?))
+121
(if (current-scheduler)
+122
(let ((fd (%resolve-start host)))
+123
(if fd
+124
(dynamic-wind
+125
(lambda () #t)
+126
(lambda ()
+127
(%await-readable-fd fd)
+128
(%resolve-take fd))
+129
(lambda ()
+130
(%resolve-cancel fd)))
+131
#f))
+132
(%resolve-hostname-sync host)))
+133
+134
(define (tcp-connect host port)
+135
(: string? integer? -> (maybe socket?))
+136
(if (current-scheduler)
+137
(let ((ips (resolve-hostname host)))
+138
(let loop ((remaining ips))
+139
(cond
+140
((not remaining) #f)
+141
((null? remaining) #f)
+142
(else
+143
(let ((sock (%tcp-connect-ip (car remaining) port)))
+144
(if sock
+145
sock
+146
(loop (cdr remaining))))))))
+147
(%tcp-connect-sync host port)))
+148
149
;; ========== Native Procedure Documentation ==========
150
151
;;; Check if a value is a socket object.
@@ -252,13 +307,13 @@
307
(%set-docstring! gethostname)
308
(%set-spec! gethostname '(-> string?))
309
−255
;;; Resolve a hostname to an IP address.
+310
;;; Resolve a hostname to IP addresses.
311
;;;
312
;;; ```scheme
−258
;;; (resolve-hostname "localhost") ; => "127.0.0.1"
+313
;;; (resolve-hostname "localhost") ; => ("127.0.0.1")
314
;;; ```
315
(%set-docstring! resolve-hostname)
−261
(%set-spec! resolve-hostname '(string? -> (maybe string?)))
+316
(%set-spec! resolve-hostname '(string? -> (maybe list?)))
317
318
;;; Get the local address and port of a socket.
319
;;;