russell@unturf.com
dd961d2133
Ships examples/http-static-server.lsp — ~65 lines of portable Scheme
that reads files from a docroot (default ./www) and serves them over
HTTP/1.0 with MIME dispatch, path-traversal rejection, heap-snapshot
per request. Runs in any tier; target deployment is asm-gc for the
27 KB stripped binary + bounded memory backstop.
Required one asm fix first: heap_grow was mmap'ing fixed HEAP_SIZE
chunks, so any single allocation larger than a chunk (notably the
2.67 MB whitepaper PDF read via file->string) loop-looped through
.ha_overflow forever. Now heap_grow rounds required bytes up to
HEAP_SIZE multiples on oversize alloc, so a big request carves its
own big chunk in one go. Small allocs still land in standard-sized
chunks.
Two new benches:
tests/bench-lumbda-www.sh — drive N small + M large requests against
asm-gc, verify PDF round-trip, sample peak RSS. At 1000/100: 331 req/s
small, 120 req/s large (304 MiB/s), peak 15.5 MB.
tests/bench-www-race.sh — adjacent A/B vs caddy v2.5.1 on the same
docroot. Numbers on this laptop, concurrency 8, 2000 small + 200 large:
small req/s PDF req/s PDF MiB/s peak RSS binary
lumbda-www (asm-gc) 375 137 349 7–16 MB 27 KB
caddy file-server 358 231 588 38 MB 38 MB
Reading: lumbda edges caddy on small files (less per-request overhead),
caddy wins 1.7x on large files (sendfile zero-copy; we allocate the
whole file into a string and write it with one syscall). Both byte-
identical on the PDF. Memory: lumbda 2.5-5x less at steady state.
Binary size: 1400x smaller (27 KB vs 38 MB).
Feature gap: caddy has HTTPS, HTTP/2, range, middleware, etc. lumbda
has none of that yet — but for the specific job of serving lumbda.com's
six-file docroot it is viable right now.
Makefile adds `bench-lumbda-www` and `bench-www-race` targets.
137 asm no-GC + 137 asm GC tests still pass.
124 lines
4.6 KiB
Text
124 lines
4.6 KiB
Text
;;; http-static-server.lsp — serve lumbda.com's docroot from pure Scheme.
|
|
;;;
|
|
;;; Runs in any tier that has file->string + the tcp-* family: Python,
|
|
;;; C, and both asm builds. The asm-gc build is the target deployment
|
|
;;; (~27 KB binary, bounded memory via heap-snapshot per request).
|
|
;;;
|
|
;;; ./asm/lumbda-gc < examples/http-static-server.lsp
|
|
;;;
|
|
;;; Serves GET requests under *docroot*. Default docroot is "www" —
|
|
;;; run from the repo root so the relative path resolves.
|
|
|
|
(define *port* 8080)
|
|
(define *docroot* "www")
|
|
(define *max-requests* 100000)
|
|
|
|
(define *crlf* "\r\n")
|
|
(define *crlf-crlf* "\r\n\r\n")
|
|
|
|
;;; ── HTTP helpers ────────────────────────────────────────────
|
|
|
|
(define (http-response status ctype body)
|
|
(string-append
|
|
"HTTP/1.0 " status *crlf*
|
|
"Content-Type: " ctype *crlf*
|
|
"Content-Length: " (number->string (string-length body)) *crlf*
|
|
"Connection: close" *crlf-crlf*
|
|
body))
|
|
|
|
(define SPACE 32)
|
|
(define DOT 46)
|
|
(define (char-at s i) (char->integer (string-ref s i)))
|
|
|
|
;;; Pull the URL path out of the request line "GET /path HTTP/1.0\r\n..."
|
|
(define (second-token s)
|
|
(let ((len (string-length s)))
|
|
(let loop1 ((i 0))
|
|
(cond
|
|
((= i len) "/")
|
|
((= (char-at s i) SPACE)
|
|
(let loop2 ((j (+ i 1)))
|
|
(cond
|
|
((= j len) (substring s (+ i 1) len))
|
|
((= (char-at s j) SPACE) (substring s (+ i 1) j))
|
|
(else (loop2 (+ j 1))))))
|
|
(else (loop1 (+ i 1)))))))
|
|
|
|
;;; ── Path safety ─────────────────────────────────────────────
|
|
|
|
;;; Reject any path containing ".." — keeps requests under docroot.
|
|
(define (has-dotdot? s)
|
|
(let ((n (string-length s)))
|
|
(let loop ((i 0))
|
|
(cond
|
|
((>= (+ i 1) n) #f)
|
|
((and (= (char-at s i) DOT) (= (char-at s (+ i 1)) DOT)) #t)
|
|
(else (loop (+ i 1)))))))
|
|
|
|
;;; ── MIME dispatch ───────────────────────────────────────────
|
|
|
|
(define (ends-with? s suffix)
|
|
(let ((ns (string-length s)) (nf (string-length suffix)))
|
|
(if (< ns nf) #f
|
|
(string=? suffix (substring s (- ns nf) ns)))))
|
|
|
|
(define (mime-of path)
|
|
(cond
|
|
((ends-with? path ".html") "text/html; charset=utf-8")
|
|
((ends-with? path ".css") "text/css; charset=utf-8")
|
|
((ends-with? path ".pdf") "application/pdf")
|
|
((ends-with? path ".txt") "text/plain; charset=utf-8")
|
|
((ends-with? path ".js") "application/javascript")
|
|
((ends-with? path ".png") "image/png")
|
|
((ends-with? path ".jpg") "image/jpeg")
|
|
((ends-with? path ".svg") "image/svg+xml")
|
|
((ends-with? path ".ico") "image/x-icon")
|
|
(else "application/octet-stream")))
|
|
|
|
;;; ── File resolution ─────────────────────────────────────────
|
|
|
|
(define (resolve-fs-path url-path)
|
|
(cond
|
|
((string=? url-path "/") (string-append *docroot* "/index.html"))
|
|
(else (string-append *docroot* url-path))))
|
|
|
|
(define (serve-file url-path)
|
|
(cond
|
|
((has-dotdot? url-path)
|
|
(http-response "403 Forbidden" "text/plain" "forbidden\n"))
|
|
(else
|
|
(let ((fs-path (resolve-fs-path url-path)))
|
|
(let ((body (file->string fs-path)))
|
|
(if body
|
|
(http-response "200 OK" (mime-of fs-path) body)
|
|
(let ((nf (file->string (string-append *docroot* "/404.html"))))
|
|
(http-response "404 Not Found" "text/html; charset=utf-8"
|
|
(if nf nf "not found\n")))))))))
|
|
|
|
(define (handle-request req)
|
|
(let ((path (second-token req)))
|
|
(serve-file path)))
|
|
|
|
;;; ── Main loop ───────────────────────────────────────────────
|
|
|
|
(define server (tcp-listen *port*))
|
|
|
|
(define (server-loop n snap)
|
|
(if (>= n *max-requests*)
|
|
(begin
|
|
(display "request cap reached, exiting\n")
|
|
(tcp-close server))
|
|
(begin
|
|
(let ((client (tcp-accept server)))
|
|
(let ((req (tcp-recv client 4096)))
|
|
(if (and req (> (string-length req) 0))
|
|
(tcp-send client (handle-request req))
|
|
#f))
|
|
(tcp-close client))
|
|
;; Rewind per-request allocations on asm; no-op on Python/C.
|
|
(heap-restore snap)
|
|
(server-loop (+ n 1) snap))))
|
|
|
|
(display "lumbda-www on :") (display *port*)
|
|
(display " serving ") (display *docroot*) (newline)
|
|
(server-loop 0 (heap-snapshot))
|