feat: native HTTP parsing + fiber-httpd refactor + build support files
ober
553b73b41303034e71ae5ff73e24e97184a72012
--- a/jerboa-native-rs/Cargo.lock +++ b/jerboa-native-rs/Cargo.lock @@ -349,7 +349,7 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "39cab71617ae0d63f51a36d69f866391735b51691dbda63cf6f96d042b63efeb" dependencies = [ "libc", - "windows-sys 0.52.0", + "windows-sys 0.61.2", ] [[package]] @@ -540,6 +540,12 @@ dependencies = [ ] [[package]] +name = "httparse" +version = "1.10.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6dbf3de79e51f3d586ab4cb9d5c3e2c14aa28ed23d180cf89b4df0454a69cc87" + +[[package]] name = "indexmap" version = "2.13.0" source = "registry+https://github.com/rust-lang/crates.io-index" @@ -596,6 +602,7 @@ dependencies = [ "flate2", "getrandom 0.2.17", "hkdf", + "httparse", "inotify", "libc", "mozjs", @@ -1172,7 +1179,7 @@ dependencies = [ "errno", "libc", "linux-raw-sys", - "windows-sys 0.52.0", + "windows-sys 0.61.2", ] [[package]] @@ -1743,7 +1750,7 @@ version = "0.1.11" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c2a7b1c03c876122aa43f3020e6c3c3ee5c05081c9a00739faf7503aeba10d22" dependencies = [ - "windows-sys 0.52.0", + "windows-sys 0.61.2", ] [[package]] --- a/jerboa-native-rs/Cargo.toml +++ b/jerboa-native-rs/Cargo.toml @@ -13,6 +13,7 @@ argon2 = "0.5" flate2 = "1" regex = "1" libc = "0.2" +httparse = "1" rusqlite = { version = "0.32", features = ["bundled"] } postgres = "0.19" x25519-dalek = { version = "2", features = ["static_secrets"] } new file mode 100644 --- /dev/null +++ b/jerboa-native-rs/src/http_parse.rs @@ -0,0 +1,116 @@ +// http_parse.rs — Fast HTTP/1.1 request parser + scatter-gather write +// +// jerboa_http_parse(buf, buf_len, out) -> i32 +// Parses HTTP/1.1 request headers from raw bytes. +// out: caller-allocated 270-byte buffer: +// [0..3] i32 status (>0 = header_end bytes, 0 = partial, -1 = parse error) +// [4..5] u16 method_start (byte offset in buf) +// [6..7] u16 method_len +// [8..9] u16 path_start +// [10..11] u16 path_len +// [12] u8 http_version (0 = HTTP/1.0, 1 = HTTP/1.1) +// [13] u8 nheaders +// [14..270] 32 * [name_start:u16, name_len:u16, val_start:u16, val_len:u16] +// Returns 0 on success, -1 on null pointer. +// +// jerboa_writev2(fd, buf1, len1, buf2, len2) -> isize +// Single writev syscall for header + body. buf2/len2 may be null/0 for header-only. + +use httparse; + +const MAX_HEADERS: usize = 32; +pub const PARSE_OUT_SIZE: usize = 14 + MAX_HEADERS * 8; // 270 + +#[no_mangle] +pub unsafe extern "C" fn jerboa_http_parse( + buf: *const u8, + buf_len: usize, + out: *mut u8, +) -> i32 { + if buf.is_null() || out.is_null() || buf_len == 0 { + return -1; + } + + let data = std::slice::from_raw_parts(buf, buf_len); + let out_slice = std::slice::from_raw_parts_mut(out, PARSE_OUT_SIZE); + + let mut headers_storage = [httparse::EMPTY_HEADER; MAX_HEADERS]; + let mut req = httparse::Request::new(&mut headers_storage); + + match req.parse(data) { + Ok(httparse::Status::Complete(n)) => { + let method = req.method.unwrap_or(""); + let path = req.path.unwrap_or("/"); + + // status = header_end offset + out_slice[0..4].copy_from_slice(&(n as i32).to_ne_bytes()); + + // method: offset + len relative to buf + let method_start = (method.as_ptr() as usize).saturating_sub(buf as usize); + let method_len = method.len().min(0xFFFF); + out_slice[4..6].copy_from_slice(&(method_start as u16).to_ne_bytes()); + out_slice[6..8].copy_from_slice(&(method_len as u16).to_ne_bytes()); + + // path + let path_start = (path.as_ptr() as usize).saturating_sub(buf as usize); + let path_len = path.len().min(0xFFFF); + out_slice[8..10].copy_from_slice(&(path_start as u16).to_ne_bytes()); + out_slice[10..12].copy_from_slice(&(path_len as u16).to_ne_bytes()); + + // version + out_slice[12] = req.version.unwrap_or(1); + + // headers + let nhdrs = req.headers.len().min(MAX_HEADERS); + out_slice[13] = nhdrs as u8; + + for i in 0..nhdrs { + let h = &req.headers[i]; + let base = 14 + i * 8; + let ns = (h.name.as_ptr() as usize).saturating_sub(buf as usize); + let nl = h.name.len().min(0xFFFF); + let vs = (h.value.as_ptr() as usize).saturating_sub(buf as usize); + let vl = h.value.len().min(0xFFFF); + out_slice[base..base+2].copy_from_slice(&(ns as u16).to_ne_bytes()); + out_slice[base+2..base+4].copy_from_slice(&(nl as u16).to_ne_bytes()); + out_slice[base+4..base+6].copy_from_slice(&(vs as u16).to_ne_bytes()); + out_slice[base+6..base+8].copy_from_slice(&(vl as u16).to_ne_bytes()); + } + + 0 // success + } + Ok(httparse::Status::Partial) => { + out_slice[0..4].copy_from_slice(&0i32.to_ne_bytes()); + 0 // success (partial) + } + Err(_) => { + out_slice[0..4].copy_from_slice(&(-1i32).to_ne_bytes()); + 0 // success (error encoded in status field) + } + } +} + +// --------------------------------------------------------------------------- +// Scatter-gather write: single writev syscall for header + body +// +// Returns bytes written, or -1 on error (check errno). +// If buf2 is null or len2==0, only buf1 is written (single iovec). +// --------------------------------------------------------------------------- + +#[no_mangle] +pub unsafe extern "C" fn jerboa_writev2( + fd: i32, + buf1: *const u8, len1: usize, + buf2: *const u8, len2: usize, +) -> isize { + if buf1.is_null() || len1 == 0 { + return -1; + } + let use_two = !buf2.is_null() && len2 > 0; + let iovs = [ + libc::iovec { iov_base: buf1 as *mut libc::c_void, iov_len: len1 }, + libc::iovec { iov_base: buf2 as *mut libc::c_void, iov_len: len2 }, + ]; + let count = if use_two { 2 } else { 1 }; + libc::writev(fd, iovs.as_ptr(), count) +} --- a/jerboa-native-rs/src/lib.rs +++ b/jerboa-native-rs/src/lib.rs @@ -20,6 +20,8 @@ mod socks5_server; #[cfg(target_os = "linux")] mod epoll; #[cfg(target_os = "linux")] +mod http_parse; +#[cfg(target_os = "linux")] mod inotify_native; #[cfg(target_os = "linux")] mod landlock; --- a/lib/std/net/fiber-httpd.sls +++ b/lib/std/net/fiber-httpd.sls @@ -70,6 +70,19 @@ (std fiber) (std net io)) + ;; ========== FFI: Rust HTTP parser ========== + ;; jerboa_http_parse is in libjerboa_native.so (loaded by epoll-native via io) + + (define c-http-parse + (foreign-procedure "jerboa_http_parse" (u8* size_t u8*) int)) + + ;; Parse-out buffer layout (270 bytes): + ;; [0-3] i32 status (>0=header_end, 0=partial, -1=error) + ;; [4-5] u16 method_start [6-7] u16 method_len + ;; [8-9] u16 path_start [10-11] u16 path_len + ;; [12] u8 version [13] u8 nheaders + ;; [14..270] 32 * [name_start:u16, name_len:u16, val_start:u16, val_len:u16] + ;; ========== Request record ========== (define-record-type request @@ -132,160 +145,92 @@ (fields (immutable handler)) ;; (lambda (fd poller req) ...) (sealed #t)) - ;; ========== HTTP Parser ========== + ;; ========== HTTP Parser (Rust-backed) ========== ;; - ;; Reads HTTP/1.1 requests from a raw fd using fiber-aware I/O. - ;; Returns a request record or #f on connection close/error. + ;; Reads HTTP/1.1 requests using the Rust httparse crate for header parsing. + ;; hdr-buf (8192 bytes) and parse-out (270 bytes) are per-connection allocations + ;; passed in from handle-connection — zero per-request allocation on the hot path. (define *max-header-size* 8192) (define *max-body-size* (* 10 1024 1024)) ;; 10MB - ;; Read bytes from fd into a bytevector buffer, growing as needed. - ;; Returns (values buf filled) where filled is total bytes in buf. - ;; Reads until we find \r\n\r\n (end of headers) or hit max. - (define (read-until-headers fd poller) - (let ([buf (make-bytevector *max-header-size*)] - [tmp (make-bytevector 4096)]) - (let loop ([filled 0]) - (if (>= filled *max-header-size*) - (values buf filled) ;; hit limit - (let ([n (fiber-tcp-read fd tmp - (min 4096 (- *max-header-size* filled)) - poller)]) - (cond - [(<= n 0) (values buf filled)] ;; EOF or error - [else - (bytevector-copy! tmp 0 buf filled n) - (let ([total (+ filled n)]) - ;; Check for \r\n\r\n - (if (header-complete? buf total) - (values buf total) - (loop total)))])))))) - - (define (header-complete? buf len) - (let loop ([i 0]) - (cond - [(> (+ i 3) len) #f] - [(and (= (bytevector-u8-ref buf i) 13) ;; \r - (= (bytevector-u8-ref buf (+ i 1)) 10) ;; \n - (= (bytevector-u8-ref buf (+ i 2)) 13) ;; \r - (= (bytevector-u8-ref buf (+ i 3)) 10)) ;; \n - #t] - [else (loop (+ i 1))]))) + ;; Extract a sub-bytevector [start, start+len) + (define (bv-sub bv start len) + (let ([out (make-bytevector len)]) + (bytevector-copy! bv start out 0 len) + out)) - ;; Find the offset of \r\n\r\n in buffer - (define (find-header-end buf len) - (let loop ([i 0]) - (cond - [(> (+ i 3) len) len] - [(and (= (bytevector-u8-ref buf i) 13) - (= (bytevector-u8-ref buf (+ i 1)) 10) - (= (bytevector-u8-ref buf (+ i 2)) 13) - (= (bytevector-u8-ref buf (+ i 3)) 10)) - (+ i 4)] - [else (loop (+ i 1))]))) - - ;; Parse the header portion into a request record. - (define (parse-request-headers buf header-end) - (let* ([header-str (utf8->string - (let ([b (make-bytevector header-end)]) - (bytevector-copy! buf 0 b 0 header-end) b))] - [lines (string-split-crlf header-str)]) - (if (null? lines) #f - (let ([req-line (car lines)] - [header-lines (cdr lines)]) - (let ([parts (string-split-spaces req-line)]) - (if (< (length parts) 3) #f - (let ([method (car parts)] - [path (cadr parts)] - [version (caddr parts)] - [headers (parse-headers header-lines)]) - (make-request method path version headers #f)))))))) - - (define (string-split-crlf s) - (let loop ([start 0] [acc '()]) - (let ([idx (string-search s "\r\n" start)]) - (if idx - (let ([line (substring s start idx)]) - (if (= (string-length line) 0) - (reverse acc) - (loop (+ idx 2) (cons line acc)))) - (let ([rest (substring s start (string-length s))]) - (reverse (if (= (string-length rest) 0) acc (cons rest acc)))))))) - - (define (string-search s needle start) - (let ([slen (string-length s)] - [nlen (string-length needle)]) - (let loop ([i start]) - (cond - [(> (+ i nlen) slen) #f] - [(string=? (substring s i (+ i nlen)) needle) i] - [else (loop (+ i 1))])))) - - (define (string-split-spaces s) - (let loop ([i 0] [start 0] [acc '()]) - (cond - [(= i (string-length s)) - (reverse (if (= start i) acc - (cons (substring s start i) acc)))] - [(char=? (string-ref s i) #\space) - (loop (+ i 1) (+ i 1) - (if (= start i) acc (cons (substring s start i) acc)))] - [else (loop (+ i 1) start acc)]))) - - (define (parse-headers lines) - (let loop ([ls lines] [acc '()]) - (if (null? ls) (reverse acc) - (let* ([line (car ls)] - [colon (string-index line #\:)]) - (if colon - (let ([name (string-downcase (substring line 0 colon))] - [value (string-trim-left (substring line (+ colon 1) (string-length line)))]) - (loop (cdr ls) (cons (cons name value) acc))) - (loop (cdr ls) acc)))))) - - (define (string-trim-left s) - (let loop ([i 0]) - (if (and (< i (string-length s)) (char=? (string-ref s i) #\space)) - (loop (+ i 1)) - (substring s i (string-length s))))) - - ;; Read the body based on Content-Length - (define (read-body fd poller buf header-end filled content-length) + ;; Read the body using Content-Length, using bytes already buffered after header_end. + (define (read-body fd poller hdr-buf header-end filled content-length) (if (or (not content-length) (= content-length 0)) #f (let* ([already-have (- filled header-end)] - [need (- content-length already-have)] [body-buf (make-bytevector content-length)]) - ;; Copy what we already have (when (> already-have 0) - (bytevector-copy! buf header-end body-buf 0 + (bytevector-copy! hdr-buf header-end body-buf 0 (min already-have content-length))) - ;; Read the rest - (when (> need 0) - (let loop ([got already-have]) - (when (< got content-length) - (let ([tmp (make-bytevector (min 4096 (- content-length got)))]) - (let ([n (fiber-tcp-read fd tmp - (min 4096 (- content-length got)) poller)]) - (when (> n 0) - (bytevector-copy! tmp 0 body-buf got n) - (loop (+ got n)))))))) + (let loop ([got already-have]) + (when (< got content-length) + (let ([tmp (make-bytevector (min 4096 (- content-length got)))]) + (let ([n (fiber-tcp-read fd tmp + (min 4096 (- content-length got)) poller)]) + (when (> n 0) + (bytevector-copy! tmp 0 body-buf got n) + (loop (+ got n))))))) (utf8->string body-buf)))) - ;; Full request read - (define (read-request fd poller) - (let-values ([(buf filled) (read-until-headers fd poller)]) - (if (= filled 0) #f ;; connection closed - (let ([header-end (find-header-end buf filled)]) - (let ([req (parse-request-headers buf header-end)]) - (if (not req) #f - (let ([cl-str (request-header req "content-length")]) - (let ([content-length (and cl-str (string->number cl-str))]) - (let ([body (read-body fd poller buf header-end filled content-length)]) - (make-request (request-method req) (request-path req) - (request-version req) (request-headers req) - body)))))))))) + ;; Build alist of (lowercase-name . value) pairs from parse-out offsets into hdr-buf. + (define (extract-headers hdr-buf parse-out nhdrs) + (let loop ([i 0] [acc '()]) + (if (fx>= i nhdrs) + (reverse acc) + (let* ([base (fx+ 14 (fx* i 8))] + [ns (bytevector-u16-native-ref parse-out base)] + [nl (bytevector-u16-native-ref parse-out (fx+ base 2))] + [vs (bytevector-u16-native-ref parse-out (fx+ base 4))] + [vl (bytevector-u16-native-ref parse-out (fx+ base 6))] + [name (string-downcase (utf8->string (bv-sub hdr-buf ns nl)))] + [val (utf8->string (bv-sub hdr-buf vs vl))]) + (loop (fx+ i 1) (cons (cons name val) acc)))))) + + ;; Read a full HTTP/1.1 request. hdr-buf (8192) and parse-out (270) are + ;; caller-provided per-connection buffers — no allocation on the common path. + (define (read-request fd poller hdr-buf parse-out) + (let ([tmp (make-bytevector 4096)]) + (let loop ([filled 0]) + (if (>= filled *max-header-size*) + #f + (let ([n (fiber-tcp-read fd tmp + (min 4096 (- *max-header-size* filled)) + poller)]) + (cond + [(<= n 0) #f] ;; EOF / error + [else + (bytevector-copy! tmp 0 hdr-buf filled n) + (let ([total (+ filled n)]) + (c-http-parse hdr-buf total parse-out) + (let ([status (bytevector-s32-native-ref parse-out 0)]) + (cond + ;; Complete — status is the header_end byte offset + [(> status 0) + (let* ([header-end status] + [ms (bytevector-u16-native-ref parse-out 4)] + [ml (bytevector-u16-native-ref parse-out 6)] + [ps (bytevector-u16-native-ref parse-out 8)] + [pl (bytevector-u16-native-ref parse-out 10)] + [nhdrs (bytevector-u8-ref parse-out 13)] + [method (utf8->string (bv-sub hdr-buf ms ml))] + [path (utf8->string (bv-sub hdr-buf ps pl))] + [headers (extract-headers hdr-buf parse-out nhdrs)] + [cl-str (let ([e (assoc "content-length" headers)]) + (and e (cdr e)))] + [cl (and cl-str (string->number cl-str))] + [body (read-body fd poller hdr-buf header-end total cl)]) + (make-request method path "HTTP/1.1" headers body))] + ;; Partial — need more data + [(= status 0) (loop total)] + ;; Parse error + [else #f])))])))))) ;; ========== HTTP Response Writer ========== @@ -301,35 +246,76 @@ [(503) "Service Unavailable"] [(504) "Gateway Timeout"] [else "Unknown"])) - (define (write-response fd poller resp) - (let* ([status (response-status resp)] - [headers (response-headers resp)] - [body (response-body resp)] - [body-bv (cond - [(not body) (make-bytevector 0)] - [(string? body) - (string->bytevector body (make-transcoder (utf-8-codec)))] - [(bytevector? body) body] - [else (string->bytevector (format "~a" body) - (make-transcoder (utf-8-codec)))])] - [status-line (format "HTTP/1.1 ~a ~a\r\n" status (status-text status))] - ;; Build header string - [header-str - (let ([h (string-append - status-line - (format "Content-Length: ~a\r\n" (bytevector-length body-bv)) - (apply string-append - (map (lambda (hdr) - (format "~a: ~a\r\n" (car hdr) (cdr hdr))) - headers)) - "\r\n")]) - h)] - [header-bv (string->bytevector header-str (make-transcoder (utf-8-codec)))]) - ;; Write headers - (fiber-tcp-write fd header-bv (bytevector-length header-bv) poller) - ;; Write body - (when (> (bytevector-length body-bv) 0) - (fiber-tcp-write fd body-bv (bytevector-length body-bv) poller)))) + ;; ========== HTTP Response Writer (pre-allocated buffer + writev) ========== + ;; + ;; Writes response headers directly into a caller-provided bytevector + ;; (no string allocation), then sends headers+body in one writev syscall. + + ;; Write decimal integer n into bv at pos. Returns new pos. + (define (write-decimal! bv pos n) + (if (fx= n 0) + (begin (bytevector-u8-set! bv pos 48) (fx+ pos 1)) + (let* ([s (number->string n)] + [len (string-length s)]) + (do ([i 0 (fx+ i 1)]) ((fx= i len)) + (bytevector-u8-set! bv (fx+ pos i) + (char->integer (string-ref s i)))) + (fx+ pos len)))) + + ;; Write ASCII string s into bv at pos. Returns new pos. + (define (write-ascii! bv pos s) + (let ([len (string-length s)]) + (do ([i 0 (fx+ i 1)]) ((fx= i len)) + (bytevector-u8-set! bv (fx+ pos i) + (char->integer (string-ref s i)))) + (fx+ pos len))) + + ;; Write CRLF at pos. Returns new pos. + (define (write-crlf! bv pos) + (bytevector-u8-set! bv pos 13) + (bytevector-u8-set! bv (fx+ pos 1) 10) + (fx+ pos 2)) + + ;; Fill resp-buf with the HTTP status line + headers block (no body). + ;; Returns number of bytes written. + (define (fill-response-headers! resp-buf status headers body-len) + (let* ([pos (write-ascii! resp-buf 0 "HTTP/1.1 ")] + [pos (write-decimal! resp-buf pos status)] + [pos (begin (bytevector-u8-set! resp-buf pos 32) (fx+ pos 1))] + [pos (write-ascii! resp-buf pos (status-text status))] + [pos (write-crlf! resp-buf pos)] + [pos (write-ascii! resp-buf pos "Content-Length: ")] + [pos (write-decimal! resp-buf pos body-len)] + [pos (write-crlf! resp-buf pos)] + [pos (let lp ([hs headers] [p pos]) + (if (null? hs) p + (let* ([h (car hs)] + [p (write-ascii! resp-buf p (car h))] + [p (begin (bytevector-u8-set! resp-buf p 58) + (bytevector-u8-set! resp-buf (fx+ p 1) 32) + (fx+ p 2))] + [p (write-ascii! resp-buf p (cdr h))] + [p (write-crlf! resp-buf p)]) + (lp (cdr hs) p))))] + [pos (write-crlf! resp-buf pos)]) + pos)) + + ;; Write response: fills resp-buf with headers, sends headers+body via writev2. + ;; resp-buf is a per-connection 4096-byte buffer (from handle-connection). + (define (write-response fd poller resp resp-buf) + (let* ([status (response-status resp)] + [headers (response-headers resp)] + [body (response-body resp)] + [body-bv (cond + [(not body) #f] + [(string? body) + (string->bytevector body (make-transcoder (utf-8-codec)))] + [(bytevector? body) body] + [else (string->bytevector (format "~a" body) + (make-transcoder (utf-8-codec)))])] + [body-len (if body-bv (bytevector-length body-bv) 0)] + [hdr-len (fill-response-headers! resp-buf status headers body-len)]) + (fiber-tcp-writev2 fd resp-buf hdr-len body-bv poller))) ;; ========== Router ========== @@ -455,11 +441,16 @@ (immutable conn-semaphore)) ;; fiber-semaphore or #f (sealed #t)) - ;; Connection handler: one fiber per connection, keep-alive loop + ;; Connection handler: one fiber per connection, keep-alive loop. + ;; Per-connection buffers are allocated once here and reused across + ;; all keep-alive requests on this connection. (define (handle-connection fd poller handler metrics) - (let ([ws-upgraded? #f]) + (let ([hdr-buf (make-bytevector 8192)] ;; request header read buffer + [parse-out (make-bytevector 270 0)] ;; Rust HTTP parse result + [resp-buf (make-bytevector 4096 0)] ;; response header write buffer + [ws-upgraded? #f]) (let loop () - (let ([req (read-request fd poller)]) + (let ([req (read-request fd poller hdr-buf parse-out)]) (when req (metrics-inc-requests! metrics) (let ([resp (guard (exn [#t @@ -480,7 +471,7 @@ ;; Track 5xx errors (when (>= (response-status resp) 500) (metrics-inc-errors! metrics)) - (write-response fd poller resp) + (write-response fd poller resp resp-buf) ;; Keep-alive: check Connection header (let ([conn (request-header req "connection")]) (unless (and conn (string=? (string-downcase conn) "close")) --- a/lib/std/net/io.sls +++ b/lib/std/net/io.sls @@ -48,6 +48,7 @@ fiber-tcp-accept fiber-tcp-read fiber-tcp-write + fiber-tcp-writev2 fiber-tcp-connect ;; Convenience @@ -76,6 +77,7 @@ (define c-setsockopt (foreign-procedure "setsockopt" (int int int void* int) int)) (define c-read (foreign-procedure "read" (int u8* size_t) ssize_t)) (define c-write (foreign-procedure "write" (int u8* size_t) ssize_t)) + (define c-writev2 (foreign-procedure "jerboa_writev2" (int u8* size_t u8* size_t) ssize_t)) (define c-htons (foreign-procedure "htons" (unsigned-short) unsigned-short)) (define c-inet-pton (foreign-procedure "inet_pton" (int string void*) int)) (define c-getsockname (foreign-procedure "getsockname" (int void* void*) int)) @@ -307,19 +309,19 @@ (or (ft-ref fdt fd) (let ([pd (make-poll-desc fd)]) (ft-set! fdt fd pd) - (epoll-add! (io-poller-epfd poller) fd - (bitwise-ior EPOLLIN EPOLLOUT)) + ;; Edge-triggered: one notification per data-arrival transition. + ;; Re-arm via epoll_modify before each park closes the race window. + (epoll-add! (io-poller-epfd poller) fd + (bitwise-ior EPOLLIN EPOLLOUT EPOLLET)) pd))))) ;; ========== fiber-wait-readable / fiber-wait-writable ========== ;; - ;; Strategy: Level-triggered epoll. The poller fires continuously - ;; for ready fds. When a fiber parks for read/write, the next - ;; poller iteration will see the fd is ready (if it is), find the - ;; registered fiber, and wake it. No lost events possible. - ;; - ;; To avoid busy-wake on fds that are always writable, the poller - ;; only wakes fibers that are actually registered (non-#f). + ;; Strategy: Edge-triggered epoll (EPOLLET). The kernel fires once per + ;; state transition (data arrives / send buffer drains). Before parking, + ;; we call epoll_modify to re-arm the fd — this forces an immediate + ;; notification if the fd is already ready, closing the EAGAIN→park race. + ;; This mirrors Go's netpoller model. (define (fiber-wait-readable fd poller) (let ([f (fiber-self)] @@ -327,11 +329,15 @@ (fiber-check-cancelled!) (let ([pdmx (poll-desc-pd-mutex pd)] [gate (box 'channel)]) - ;; Register fiber as reader + ;; Register fiber as reader under lock (mutex-acquire pdmx) (poll-desc-reader-fiber-set! pd f) (mutex-release pdmx) - ;; Signal poller in case it's sleeping in epoll_wait + ;; Re-arm: if fd became readable between EAGAIN and now, + ;; this epoll_modify causes an immediate EPOLLIN on next epoll_wait. + (epoll-modify! (io-poller-epfd poller) fd + (bitwise-ior EPOLLIN EPOLLOUT EPOLLET)) + ;; Signal poller thread to break out of epoll_wait (eventfd-signal (io-poller-wakefd poller)) ;; Park the fiber (fiber-gate-set! f gate) @@ -347,10 +353,13 @@ (fiber-check-cancelled!) (let ([pdmx (poll-desc-pd-mutex pd)] [gate (box 'channel)]) - ;; Register fiber as writer + ;; Register fiber as writer under lock (mutex-acquire pdmx) (poll-desc-writer-fiber-set! pd f) (mutex-release pdmx) + ;; Re-arm for write readiness + (epoll-modify! (io-poller-epfd poller) fd + (bitwise-ior EPOLLIN EPOLLOUT EPOLLET)) ;; Signal poller (eventfd-signal (io-poller-wakefd poller)) ;; Park the fiber @@ -457,6 +466,76 @@ (loop written)] [else written]))))) ;; partial write on error + ;; ---------- fiber-tcp-writev2 ---------- + ;; + ;; Write hdr-bv (hdr-n bytes) + body-bv in a single writev syscall. + ;; body-bv may be #f or zero-length for header-only responses. + ;; The common case (small responses) completes in one syscall. + ;; Partial writes fall back to position-tracked loop. + + (define (fiber-tcp-writev2 fd hdr-bv hdr-n body-bv poller) + (let* ([body-n (if (and body-bv (fx> (bytevector-length body-bv) 0)) + (bytevector-length body-bv) 0)] + [total (fx+ hdr-n body-n)] + [dummy (make-bytevector 0)] + [b2 (if (fx> body-n 0) body-bv dummy)] + ;; First attempt: combined writev + [rc0 (c-writev2 fd hdr-bv hdr-n b2 body-n)]) + (cond + ;; Everything sent in one shot (common case) + [(fx= rc0 total) rc0] + ;; EAGAIN / EINTR on first try — park and fall through to loop + [(or (fx<= rc0 0) + (let ([e (get-errno)]) (or (= e EAGAIN) (= e EINTR)))) + (when (fx<= rc0 0) + (fiber-wait-writable fd poller)) + (let loop ([sent (fxmax rc0 0)]) + (if (fx= sent total) + sent + (let* ([h-off (fxmin sent hdr-n)] + [b-off (fxmax 0 (fx- sent hdr-n))] + [h-rem (fx- hdr-n h-off)] + [b-rem (fx- body-n b-off)] + [buf (if (fx> h-rem 0) + (if (fx= h-off 0) hdr-bv + (let ([t (make-bytevector h-rem)]) + (bytevector-copy! hdr-bv h-off t 0 h-rem) t)) + (if (fx= b-off 0) body-bv + (let ([t (make-bytevector b-rem)]) + (bytevector-copy! body-bv b-off t 0 b-rem) t)))] + [n (if (fx> h-rem 0) h-rem b-rem)] + [rc (c-write fd buf n)]) + (cond + [(fx> rc 0) (loop (fx+ sent rc))] + [(let ([e (get-errno)]) (or (= e EAGAIN) (= e EINTR))) + (fiber-wait-writable fd poller) + (loop sent)] + [else sent]))))] + ;; Partial write — continue from where writev left off + [else + (let loop ([sent rc0]) + (if (fx= sent total) + sent + (let* ([h-off (fxmin sent hdr-n)] + [b-off (fxmax 0 (fx- sent hdr-n))] + [h-rem (fx- hdr-n h-off)] + [b-rem (fx- body-n b-off)] + [buf (if (fx> h-rem 0) + (if (fx= h-off 0) hdr-bv + (let ([t (make-bytevector h-rem)]) + (bytevector-copy! hdr-bv h-off t 0 h-rem) t)) + (if (fx= b-off 0) body-bv + (let ([t (make-bytevector b-rem)]) + (bytevector-copy! body-bv b-off t 0 b-rem) t)))] + [n (if (fx> h-rem 0) h-rem b-rem)] + [rc (c-write fd buf n)]) + (cond + [(fx> rc 0) (loop (fx+ sent rc))] + [(let ([e (get-errno)]) (or (= e EAGAIN) (= e EINTR))) + (fiber-wait-writable fd poller) + (loop sent)] + [else sent]))))]))) + ;; ---------- fiber-tcp-connect ---------- ;; ;; Non-blocking connect. Parks fiber while connect is in progress. new file mode 100644 --- /dev/null +++ b/src/.jerbuild-hashes @@ -0,0 +1 @@ +(("src/std/nrepl.ss" . "3F7BE1EBCD096B04")) new file mode 100644 --- /dev/null +++ b/support/build-boot.ss @@ -0,0 +1,59 @@ +#!chezscheme +;;; build-boot.ss — Compile a Jerboa script with Whole-Program Optimization +;;; +;;; Usage: +;;; scheme --libdirs <libdirs> --script build-boot.ss <entry.ss> <output.so> [<obj-dir>] +;;; +;;; <obj-dir> Optional writable directory for compiled library .so output. +;;; Use when the source lib directory is read-only (e.g. Docker bind mounts). +;;; If omitted, compiled output goes alongside the source files. +;;; +;;; Produces a single WPO-optimised .so containing the compiled program + +;;; all imported libraries, ready for embedding in a static binary. + +(import (chezscheme)) + +(define (string-suffix? str suffix) + (let ([slen (string-length str)] + [xlen (string-length suffix)]) + (and (>= slen xlen) + (string=? (substring str (- slen xlen) slen) suffix)))) + +(let ([args (cdr (command-line))]) ;; strip argv[0] (build-boot.ss path) + (when (< (length args) 2) + (display "Usage: build-boot.ss <entry.ss> <output.so> [<obj-dir>]\n" + (current-error-port)) + (exit 1)) + + (let ([entry-file (list-ref args 0)] + [output-so (list-ref args 1)] + [obj-dir (and (>= (length args) 3) (list-ref args 2))]) + + ;; When a separate object directory is requested, redirect compiled library + ;; output there while keeping source lookup in the original lib directories. + ;; This lets us compile against a read-only source tree (e.g. Docker :ro mount). + (when obj-dir + (library-directories + (map (lambda (pair) + (cons (if (pair? pair) (car pair) pair) obj-dir)) + (library-directories)))) + + ;; Enable WPO + (compile-imported-libraries #t) + (generate-wpo-files #t) + + (let* ([base (if (string-suffix? entry-file ".ss") + (substring entry-file 0 (- (string-length entry-file) 3)) + entry-file)] + [wpo-file (string-append base ".wpo")]) + + (display (format " compile-program ~a ...\n" entry-file) (current-error-port)) + (compile-program entry-file) + + (display (format " compile-whole-program ~a -> ~a ...\n" wpo-file output-so) + (current-error-port)) + ;; NOTE: see single-binary.md §13 — WPO can eliminate identifier-syntax cells. + ;; If startup crashes with unbound-variable, try: (system (format "cp ~a.so ~a" base output-so)) + (compile-whole-program wpo-file output-so #t) + + (display " build-boot.ss done.\n" (current-error-port))))) new file mode 100755 --- /dev/null +++ b/support/build-static-script.sh @@ -0,0 +1,504 @@ +#!/bin/bash +# build-static-script.sh — Build a single-file Jerboa script as a static Linux binary +# +# Usage (inside jerboa21/jerboa Docker container): +# build-static-script.sh <script.ss> <output-name> +# +# The script compiles <script.ss> with Whole-Program Optimization, embeds +# Chez boot files + the compiled program as C arrays, then links a fully +# static x86_64 binary against the musl Chez kernel and libjerboa_native.a. +# +# Environment variables (all have sane defaults inside the Docker image): +# JERBOA_HOME — path to jerboa repo (default: /build/mine/jerboa) +# JERBOA_MUSL_CHEZ_PREFIX — musl Chez install prefix (default: /build/chez-musl) +# +# Output: ./<output-name> (statically linked ELF, target <25 MB) +# +# See ~/mine/jerboa/docs/single-binary.md for architecture details. + +set -euo pipefail + +SCRIPT="${1:?Usage: build-static-script.sh <script.ss> <output-name>}" +OUTPUT="${2:?Usage: build-static-script.sh <script.ss> <output-name>}" + +JERBOA_HOME="${JERBOA_HOME:-/build/mine/jerboa}" +MUSL_CHEZ="${JERBOA_MUSL_CHEZ_PREFIX:-/build/chez-musl}" +NATIVE_A="${JERBOA_HOME}/jerboa-native-rs/target/x86_64-unknown-linux-musl/release/libjerboa_native.a" +LIBDIRS="${JERBOA_HOME}/lib" +SCHEME="${SCHEME:-scheme}" + +echo "=== Jerboa static build: ${SCRIPT} → ${OUTPUT} ===" +echo " JERBOA_HOME = ${JERBOA_HOME}" +echo " MUSL_CHEZ = ${MUSL_CHEZ}" +echo "" + +# ── Locate musl Chez libkernel.a ───────────────────────────────────────────── +MACHINE_TYPE=$(${SCHEME} -q <<'EOF' +(display (machine-type)) (exit) +EOF +) + +CSV_DIR="" +for d in "${MUSL_CHEZ}/lib/csv"*/"${MACHINE_TYPE}"; do + if [ -f "${d}/libkernel.a" ]; then + CSV_DIR="${d}" + break + fi +done + +if [ -z "${CSV_DIR}" ] || [ ! -f "${CSV_DIR}/libkernel.a" ]; then + echo "ERROR: Cannot find musl libkernel.a under ${MUSL_CHEZ}/lib/csv*/${MACHINE_TYPE}" >&2 + echo " machine-type reported: ${MACHINE_TYPE}" >&2 + exit 1 +fi + +echo " Chez: ${CSV_DIR}" +echo " Native: ${NATIVE_A}" +echo "" + +if [ ! -f "${NATIVE_A}" ]; then + echo "ERROR: ${NATIVE_A} not found" >&2 + echo " Run: cd ${JERBOA_HOME}/jerboa-native-rs && cargo build --release --target x86_64-unknown-linux-musl --no-default-features" >&2 + exit 1 +fi + +# ── Step 1: Compile script with WPO → <output>.wp.so ───────────────────────── +WPO_SO="${OUTPUT}.wp.so" +# Writable dir for compiled library .so output (source lib dir may be read-only) +OBJ_DIR="/tmp/jerboa-obj-$$" +mkdir -p "${OBJ_DIR}" +echo "==> Step 1: Compile ${SCRIPT} with WPO → ${WPO_SO}" +echo " Library object cache: ${OBJ_DIR}" + +LD_LIBRARY_PATH="${JERBOA_HOME}/jerboa-native-rs/target/release:${LD_LIBRARY_PATH:-}" \ + ${SCHEME} --libdirs "${LIBDIRS}" \ + --script "${JERBOA_HOME}/support/build-boot.ss" "${SCRIPT}" "${WPO_SO}" "${OBJ_DIR}" + +echo "" + +# ── Step 2: Convert boot files and program .so to C byte-array headers ──────── +echo "==> Step 2: Convert to C headers" + +convert_to_header() { + local input="$1" + local stem="$2" + local varname + varname="$(basename "${stem}")_data" + local sizename + sizename="$(basename "${stem}")_size" + local header="${stem}.h" + + echo " ${input} → ${header}" + printf "static const unsigned char %s[] = {\n" "${varname}" > "${header}" + od -An -tx1 -v "${input}" \ + | sed 's/^ *//;s/ *$//;s/ */ /g;s/ /,0x/g;s/^/0x/;s/$/,/' >> "${header}" + printf "};\n" >> "${header}" + printf "static const unsigned int %s = sizeof(%s);\n" \ + "${sizename}" "${varname}" >> "${header}" +} + +convert_to_header "${CSV_DIR}/petite.boot" "petite_boot" +convert_to_header "${CSV_DIR}/scheme.boot" "scheme_boot" +convert_to_header "${WPO_SO}" "program_boot" + +echo "" + +# ── Step 3: Generate C main ─────────────────────────────────────────────────── +echo "==> Step 3: Generate ${OUTPUT}-main.c" + +cat > "${OUTPUT}-main.c" << 'CMAIN' +/* + * Jerboa static binary entry point — generated by build-static-script.sh + * + * Embeds petite.boot, scheme.boot, and the compiled program (.so) as + * static byte arrays. Registers all Jerboa native + POSIX FFI symbols + * so foreign-procedure works without dlopen. + * + * Override dlopen/dlsym/dlclose/dlerror with stubs: every Jerboa stdlib + * module wraps load-shared-object in (guard ...) so they degrade cleanly. + * The actual symbol resolution happens via Sforeign_symbol below. + */ + +#include "scheme.h" +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include <fcntl.h> +#include <sys/types.h> +#include <sys/socket.h> +#include <arpa/inet.h> +#include <netdb.h> +#include <sys/stat.h> +#include <signal.h> +#include <pthread.h> +#include <time.h> +#include <errno.h> +#include <sys/mman.h> +#include <sys/wait.h> + +/* Embedded boot data — generated by build-static-script.sh */ +#include "petite_boot.h" +#include "scheme_boot.h" +#include "program_boot.h" + +/* ── dlopen stubs ─────────────────────────────────────────────────────────── */ +/* musl static does not support dlopen; stub it out so (load-shared-object ...) + * in stdlib modules does not crash. All real symbol resolution uses + * Sforeign_symbol registered in custom_init() below. */ +static int _static_dummy; +void *dlopen (const char *p, int m) { (void)p; (void)m; return &_static_dummy; } +void *dlsym (void *h, const char *n) { (void)h; (void)n; return NULL; } +int dlclose(void *h) { (void)h; return 0; } +char *dlerror(void) { return NULL; } + +/* ── GCC 13 / musl compatibility stub ────────────────────────────────────── */ +/* GCC 13's libgcc_eh.a references _dl_find_object (glibc 2.35+) which musl + * does not provide. Return -1 (not found) — safe because Chez uses its own + * continuation/exception machinery, not libgcc unwinding. */ +int _dl_find_object(void *addr, void *result) { (void)addr; (void)result; return -1; } + +/* htons/ntohs may be macros — wrap for Sforeign_symbol */ +static unsigned short wrap_htons(unsigned short x) { return htons(x); } +static unsigned short wrap_ntohs(unsigned short x) { return ntohs(x); } +static unsigned long wrap_htonl(unsigned long x) { return htonl(x); } +static unsigned long wrap_ntohl(unsigned long x) { return ntohl(x); } + +/* ── FFI registration ─────────────────────────────────────────────────────── */ +/* Called by Sbuild_heap before Scheme code runs. + * Register every symbol that any imported library calls via foreign-procedure. */ + +/* Declare all jerboa_* symbols from libjerboa_native.a */ +/* TLS */ +extern unsigned long long jerboa_tls_server_new(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern unsigned long long jerboa_tls_server_new_mtls(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern unsigned long long jerboa_tls_server_new_pem(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern unsigned long long jerboa_tls_server_new_mtls_pem(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern void jerboa_tls_server_free(unsigned long long); +extern unsigned long long jerboa_tls_accept(unsigned long long,int); +extern unsigned long long jerboa_tls_connect(unsigned char*,unsigned long long,unsigned short); +extern unsigned long long jerboa_tls_connect_pinned(unsigned char*,unsigned long long,unsigned short,unsigned char*,unsigned long long); +extern unsigned long long jerboa_tls_connect_mtls(unsigned char*,unsigned long long,unsigned short,unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_tls_read(unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_tls_write(unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_tls_flush(unsigned long long); +extern void jerboa_tls_close(unsigned long long); +extern int jerboa_tls_set_nonblock(unsigned long long,int); +extern int jerboa_tls_get_fd(unsigned long long); +extern unsigned long long jerboa_last_error(unsigned char*,unsigned long long); +/* Crypto — correct names (not jerboa_sha/hmac/argon/pbkdf/chacha/md) */ +extern int jerboa_sha1(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_sha256(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_sha384(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_sha512(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_hmac_sha256(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_hmac_sha256_verify(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_hkdf_sha256(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_md5(unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern int jerboa_random_bytes(unsigned char*,unsigned long long); +extern unsigned long long jerboa_aead_seal(int,unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern unsigned long long jerboa_aead_open(int,unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern unsigned long long jerboa_chacha20_seal(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long); +extern unsigned long long jerboa_chacha20_open(unsigned char*,unsigned long long,unsigned char*,unsigned long long,unsigned char*,unsigned long long);