perf: httpd reader/writer hot paths
ober
a48de02334527749794e9c7240f92212abd03883
--- a/lib/jerboa-https/httpd.sls +++ b/lib/jerboa-https/httpd.sls @@ -90,16 +90,24 @@ [path-len (string-length path)]) (and (<= plen path-len) (string=? prefix (substring path 0 plen))))) - (def (string-ci-contains? haystack needle) - (let* ([h (string-downcase haystack)] - [n (string-downcase needle)] - [nlen (string-length n)] - [hlen (string-length h)]) + (def (string-contains? haystack needle) + (let ([hlen (string-length haystack)] + [nlen (string-length needle)]) (let loop ([i 0]) (cond [(> (+ i nlen) hlen) #f] - [(string=? n (substring h i (+ i nlen))) #t] + [(let match ([j 0]) + (or (= j nlen) + (and (char=? + (string-ref haystack (+ i j)) + (string-ref needle j)) + (match (+ j 1)))))] [else (loop (+ i 1))])))) + (def (string-ci-contains? haystack needle) + (and (string-contains? + (string-downcase haystack) + (string-downcase needle)) + #t)) (def (string-trim-left str) (let ([len (string-length str)]) (let loop ([i 0]) @@ -274,43 +282,49 @@ (reader-pos-set! r (+ (reader-pos r) 1)) b))) (def (reader-read-line r) - (let loop ([acc #f]) - (let ([pos (reader-pos r)] [end (reader-end r)]) - (if (= pos end) - (let ([n (reader-fill-from-conn! r)]) - (if (<= n 0) acc (loop acc))) - (let scan ([i pos]) - (cond - [(>= i (- end 1)) - (let* ([chunk-len (- end pos)] - [chunk-bv (make-bytevector chunk-len)]) - (when (> (+ (if acc (string-length acc) 0) chunk-len) - (cfg-ref 1)) - (error 'reader-read-line "line too long")) - (bytevector-copy! (reader-buf r) pos chunk-bv 0 - chunk-len) - (reader-pos-set! r end) - (let ([chunk-str (utf8->string chunk-bv)] - [n (reader-fill-from-conn! r)]) - (let ([new-acc (if acc - (string-append acc chunk-str) - chunk-str)]) - (if (<= n 0) - (if (= (string-length new-acc) 0) #f new-acc) - (loop new-acc)))))] - [(and (= (bytevector-u8-ref (reader-buf r) i) 13) - (= (bytevector-u8-ref (reader-buf r) (+ i 1)) 10)) - (let* ([line-len (- i pos)] - [line-bv (make-bytevector line-len)]) - (when (> (+ (if acc (string-length acc) 0) line-len) - (cfg-ref 1)) - (error 'reader-read-line "line too long")) - (bytevector-copy! (reader-buf r) pos line-bv 0 - line-len) - (reader-pos-set! r (+ i 2)) - (let ([chunk-str (utf8->string line-bv)]) - (if acc (string-append acc chunk-str) chunk-str)))] - [else (scan (+ i 1))])))))) + (let ([max-len (cfg-ref 1)] [buf (reader-buf r)]) + (letrec ([copy-slice (lambda (bv start len) + (let ([out (make-bytevector len)]) + (bytevector-copy! bv start out 0 len) + out))] + [finish (lambda (chunks) + (utf8->string + (bytevector-concat-list (reverse chunks))))]) + (let loop ([chunks '()] [total 0]) + (let ([pos (reader-pos r)] [end (reader-end r)]) + (if (= pos end) + (let ([n (reader-fill-from-conn! r)]) + (if (<= n 0) + (if (null? chunks) #f (finish chunks)) + (loop chunks total))) + (let scan ([i pos]) + (cond + [(>= i (- end 1)) + (let* ([chunk-len (- end pos)] + [new-total (+ total chunk-len)]) + (when (> new-total max-len) + (error 'reader-read-line "line too long")) + (let ([chunks (cons + (copy-slice buf pos chunk-len) + chunks)]) + (reader-pos-set! r end) + (let ([n (reader-fill-from-conn! r)]) + (if (<= n 0) + (finish chunks) + (loop chunks new-total)))))] + [(and (= (bytevector-u8-ref buf i) 13) + (= (bytevector-u8-ref buf (+ i 1)) 10)) + (let ([line-len (- i pos)]) + (when (> (+ total line-len) max-len) + (error 'reader-read-line "line too long")) + (reader-pos-set! r (+ i 2)) + (if (null? chunks) + (utf8->string (copy-slice buf pos line-len)) + (finish + (cons + (copy-slice buf pos line-len) + chunks))))] + [else (scan (+ i 1))])))))))) (def (reader-read-bytes r n) (let ([result (make-bytevector n)]) (let loop ([offset 0]) @@ -331,12 +345,14 @@ (def (writer-pos w) (vector-ref w 2)) (def (writer-pos-set! w v) (vector-set! w 2 v)) (def (writer-flush! w) - (let ([pos (writer-pos w)]) + (let ([pos (writer-pos w)] [buf (writer-buf w)]) (when (> pos 0) - (let ([bv (make-bytevector pos)]) - (bytevector-copy! (writer-buf w) 0 bv 0 pos) - (conn-write (writer-conn w) bv) - (writer-pos-set! w 0))))) + (if (= pos (bytevector-length buf)) + (conn-write (writer-conn w) buf) + (let ([bv (make-bytevector pos)]) + (bytevector-copy! buf 0 bv 0 pos) + (conn-write (writer-conn w) bv))) + (writer-pos-set! w 0)))) (def (writer-write-byte! w b) (let ([pos (writer-pos w)] [buf (writer-buf w)]) (when (= pos (bytevector-length buf)) @@ -522,9 +538,10 @@ (if (or (not (string? rel)) (= (string-length rel) 0) (string-prefix? "/" rel) - (string-ci-contains? rel "%2e") - (string-ci-contains? rel "%2f") - (string-ci-contains? rel "%5c") + (let ([rel-lc (string-downcase rel)]) + (or (string-contains? rel-lc "%2e") + (string-contains? rel-lc "%2f") + (string-contains? rel-lc "%5c"))) (let loop ([i 0]) (and (< i (string-length rel)) (let ([c (string-ref rel i)]) --- a/src/jerboa-https/httpd.ss +++ b/src/jerboa-https/httpd.ss @@ -122,17 +122,21 @@ (and (<= plen path-len) (string=? prefix (substring path 0 plen))))) - (def (string-ci-contains? haystack needle) - (let* ([h (string-downcase haystack)] - [n (string-downcase needle)] - [nlen (string-length n)] - [hlen (string-length h)]) + (def (string-contains? haystack needle) + (let ([hlen (string-length haystack)] + [nlen (string-length needle)]) (let loop ([i 0]) (cond [(> (+ i nlen) hlen) #f] - [(string=? n (substring h i (+ i nlen))) #t] + [(let match ([j 0]) + (or (= j nlen) + (and (char=? (string-ref haystack (+ i j)) (string-ref needle j)) + (match (+ j 1)))))] [else (loop (+ i 1))])))) + (def (string-ci-contains? haystack needle) + (and (string-contains? (string-downcase haystack) (string-downcase needle)) #t)) + (def (string-trim-left str) (let ([len (string-length str)]) (let loop ([i 0]) @@ -325,47 +329,49 @@ (def (reader-read-line r) ;; Read a line terminated by \r\n. Returns string or #f on EOF. - ;; Scans the buffer for \r\n, filling as needed. - (let loop ([acc #f]) - (let ([pos (reader-pos r)] - [end (reader-end r)]) - (if (= pos end) - ;; Buffer empty — try to fill - (let ([n (reader-fill-from-conn! r)]) - (if (<= n 0) - acc ;; EOF — return accumulated string or #f - (loop acc))) - ;; Scan buffer for \r\n - (let scan ([i pos]) - (cond - [(>= i (- end 1)) - ;; Reached end without finding \r\n — save what we have, fill more - (let* ([chunk-len (- end pos)] - [chunk-bv (make-bytevector chunk-len)]) - (when (> (+ (if acc (string-length acc) 0) chunk-len) - (cfg-ref 1)) - (error 'reader-read-line "line too long")) - (bytevector-copy! (reader-buf r) pos chunk-bv 0 chunk-len) - (reader-pos-set! r end) - (let ([chunk-str (utf8->string chunk-bv)] - [n (reader-fill-from-conn! r)]) - (let ([new-acc (if acc (string-append acc chunk-str) chunk-str)]) - (if (<= n 0) - (if (= (string-length new-acc) 0) #f new-acc) - (loop new-acc)))))] - [(and (= (bytevector-u8-ref (reader-buf r) i) 13) - (= (bytevector-u8-ref (reader-buf r) (+ i 1)) 10)) - ;; Found \r\n - (let* ([line-len (- i pos)] - [line-bv (make-bytevector line-len)]) - (when (> (+ (if acc (string-length acc) 0) line-len) - (cfg-ref 1)) - (error 'reader-read-line "line too long")) - (bytevector-copy! (reader-buf r) pos line-bv 0 line-len) - (reader-pos-set! r (+ i 2)) - (let ([chunk-str (utf8->string line-bv)]) - (if acc (string-append acc chunk-str) chunk-str)))] - [else (scan (+ i 1))])))))) + ;; Scans the buffer in a tight loop; accumulates raw bytes across + ;; fills and decodes UTF-8 exactly once. + (let ([max-len (cfg-ref 1)] + [buf (reader-buf r)]) + (letrec ([copy-slice + (lambda (bv start len) + (let ([out (make-bytevector len)]) + (bytevector-copy! bv start out 0 len) + out))] + [finish + (lambda (chunks) + (utf8->string (bytevector-concat-list (reverse chunks))))]) + (let loop ([chunks '()] [total 0]) + (let ([pos (reader-pos r)] + [end (reader-end r)]) + (if (= pos end) + (let ([n (reader-fill-from-conn! r)]) + (if (<= n 0) + (if (null? chunks) #f (finish chunks)) + (loop chunks total))) + (let scan ([i pos]) + (cond + [(>= i (- end 1)) + ;; Fewer than two bytes left — cannot test for a CRLF + ;; pair, so accumulate the slice and refill. + (let* ([chunk-len (- end pos)] + [new-total (+ total chunk-len)]) + (when (> new-total max-len) + (error 'reader-read-line "line too long")) + (let ([chunks (cons (copy-slice buf pos chunk-len) chunks)]) + (reader-pos-set! r end) + (let ([n (reader-fill-from-conn! r)]) + (if (<= n 0) (finish chunks) (loop chunks new-total)))))] + [(and (= (bytevector-u8-ref buf i) 13) + (= (bytevector-u8-ref buf (+ i 1)) 10)) + (let ([line-len (- i pos)]) + (when (> (+ total line-len) max-len) + (error 'reader-read-line "line too long")) + (reader-pos-set! r (+ i 2)) + (if (null? chunks) + (utf8->string (copy-slice buf pos line-len)) + (finish (cons (copy-slice buf pos line-len) chunks))))] + [else (scan (+ i 1))])))))))) (def (reader-read-bytes r n) ;; Read exactly n bytes. Returns bytevector or #f on premature EOF. @@ -398,12 +404,16 @@ (def (writer-pos-set! w v) (vector-set! w 2 v)) (def (writer-flush! w) - (let ([pos (writer-pos w)]) + (let ([pos (writer-pos w)] + [buf (writer-buf w)]) (when (> pos 0) - (let ([bv (make-bytevector pos)]) - (bytevector-copy! (writer-buf w) 0 bv 0 pos) - (conn-write (writer-conn w) bv) - (writer-pos-set! w 0))))) + (if (= pos (bytevector-length buf)) + ;; Whole buffer is live — hand it to the transport without a copy. + (conn-write (writer-conn w) buf) + (let ([bv (make-bytevector pos)]) + (bytevector-copy! buf 0 bv 0 pos) + (conn-write (writer-conn w) bv))) + (writer-pos-set! w 0)))) (def (writer-write-byte! w b) (let ([pos (writer-pos w)] @@ -617,9 +627,10 @@ (if (or (not (string? rel)) (= (string-length rel) 0) (string-prefix? "/" rel) - (string-ci-contains? rel "%2e") - (string-ci-contains? rel "%2f") - (string-ci-contains? rel "%5c") + (let ([rel-lc (string-downcase rel)]) + (or (string-contains? rel-lc "%2e") + (string-contains? rel-lc "%2f") + (string-contains? rel-lc "%5c"))) (let loop ([i 0]) (and (< i (string-length rel)) (let ([c (string-ref rel i)])