security: httpd total request-read deadline (slowloris mitigation)
ober
7ed2b65aa780429d8a7b007ec2a222d904f82b64
--- a/lib/jerboa-https/httpd.sls +++ b/lib/jerboa-https/httpd.sls @@ -31,7 +31,7 @@ (jerboa-ssl)) (def *config* (vector 4 8192 32768 60 120 1048576 128 100 #f 4 #f 10 #f 8 - 30)) + 30 30000)) (def (cfg-ref i) (vector-ref *config* i)) (def (httpd-config . args) (let loop ([args args]) @@ -71,8 +71,16 @@ (vector-set! *config* 13 val)] [(eq? key 'keep-alive-timeout:) (vector-set! *config* 14 val)] + [(eq? key 'request-timeout-ms:) + (vector-set! *config* 15 val)] [else (error 'httpd-config "unknown option" key)]) (loop (cddr args)))))) + (def (monotonic-seconds) + (let ([now (current-time 'time-monotonic)]) + (+ (time-second now) + (/ (time-nanosecond now) 1000000000.0)))) + (def (make-request-deadline) + (+ (monotonic-seconds) (/ (cfg-ref 15) 1000.0))) (def (string-index str ch) (let ([len (string-length str)]) (let loop ([i 0]) @@ -242,13 +250,17 @@ [(_ buf) (with-mutex *output-pool-mutex* (set! *output-pool* (cons buf *output-pool*)))])) - (def (make-reader conn buf) (vector conn buf 0 0)) + (def (make-reader conn buf) (vector conn buf 0 0 #f #f)) (def (reader-conn r) (vector-ref r 0)) (def (reader-buf r) (vector-ref r 1)) (def (reader-pos r) (vector-ref r 2)) (def (reader-end r) (vector-ref r 3)) + (def (reader-deadline r) (vector-ref r 4)) + (def (reader-timed-out? r) (vector-ref r 5)) (def (reader-pos-set! r v) (vector-set! r 2 v)) (def (reader-end-set! r v) (vector-set! r 3 v)) + (def (reader-deadline-set! r v) (vector-set! r 4 v)) + (def (reader-timeout-set! r v) (vector-set! r 5 v)) (def (reader-available r) (- (reader-end r) (reader-pos r))) (def (reader-compact! r) (let ([pos (reader-pos r)] @@ -266,11 +278,25 @@ [cap (bytevector-length buf)] [space (- cap end)]) (when (<= space 0) (error 'reader-fill! "buffer overflow")) + (let ([deadline (reader-deadline r)]) + (when deadline + (let ([remaining (- deadline (monotonic-seconds))]) + (when (<= remaining 0) + (reader-timeout-set! r #t) + (error 'reader-fill! + "total request-read deadline exceeded")) + (ssl-set-timeout + (reader-conn r) + (inexact->exact + (max 1 (min (cfg-ref 3) (ceiling remaining)))) + (cfg-ref 4))))) (let ([tmp (make-bytevector space)]) (let ([n (conn-read (reader-conn r) tmp space)]) (when (> n 0) (bytevector-copy! tmp 0 buf end n) - (reader-end-set! r (+ end n))) + (reader-end-set! r (+ end n)) + (unless (reader-deadline r) + (reader-deadline-set! r (make-request-deadline)))) n)))) (def (reader-read-byte r) (when (= (reader-pos r) (reader-end r)) @@ -407,6 +433,8 @@ (vector-ref r 4))]) (and pair (cdr pair)))) (def (read-request reader client-addr) + (reader-deadline-set! reader #f) + (reader-timeout-set! reader #f) (let ([request-line (reader-read-line reader)]) (if (not request-line) #f @@ -832,6 +860,9 @@ (let ([req (try (read-request reader client-addr) (catch (e) 'bad-request))]) (cond + [(reader-timed-out? reader) + (try (http-respond-error writer 408) + (catch (e) (void)))] [(eq? req 'bad-request) (try (http-respond-error writer 400) (catch (e) (void)))] --- a/src/jerboa-https/httpd.ss +++ b/src/jerboa-https/httpd.ss @@ -62,6 +62,7 @@ #f ;; 12: global pre-auth cap (#f = workers + queue) 8 ;; 13: per-IP pre-auth cap 30 ;; 14: keep-alive idle timeout (seconds) + 30000 ;; 15: total request-read deadline (milliseconds) )) (def (cfg-ref i) (vector-ref *config* i)) @@ -95,9 +96,17 @@ [(eq? key 'tls-max-preauth:) (vector-set! *config* 12 val)] [(eq? key 'tls-max-preauth-per-ip:) (vector-set! *config* 13 val)] [(eq? key 'keep-alive-timeout:) (vector-set! *config* 14 val)] + [(eq? key 'request-timeout-ms:) (vector-set! *config* 15 val)] [else (error 'httpd-config "unknown option" key)]) (loop (cddr args)))))) + (def (monotonic-seconds) + (let ([now (current-time 'time-monotonic)]) + (+ (time-second now) (/ (time-nanosecond now) 1000000000.0)))) + + (def (make-request-deadline) + (+ (monotonic-seconds) (/ (cfg-ref 15) 1000.0))) + ;; ================================================================ ;; String / bytevector utilities ;; ================================================================ @@ -272,16 +281,23 @@ ;; Buffered reader — cursor-based, wraps a conn handle ;; ================================================================ - ;; Reader: #(conn buf pos end) + ;; Reader: #(conn buf pos end deadline timed-out?) + ;; deadline is the monotonic-seconds bound for reading the current request, or + ;; #f before the first byte of a request arrives. The keep-alive idle wait is + ;; bounded by the socket idle timeout, not the per-request deadline. (def (make-reader conn buf) - (vector conn buf 0 0)) + (vector conn buf 0 0 #f #f)) (def (reader-conn r) (vector-ref r 0)) (def (reader-buf r) (vector-ref r 1)) (def (reader-pos r) (vector-ref r 2)) (def (reader-end r) (vector-ref r 3)) + (def (reader-deadline r) (vector-ref r 4)) + (def (reader-timed-out? r) (vector-ref r 5)) (def (reader-pos-set! r v) (vector-set! r 2 v)) (def (reader-end-set! r v) (vector-set! r 3 v)) + (def (reader-deadline-set! r v) (vector-set! r 4 v)) + (def (reader-timeout-set! r v) (vector-set! r 5 v)) (def (reader-available r) (- (reader-end r) (reader-pos r))) (def (reader-compact! r) @@ -300,7 +316,10 @@ (def (reader-fill-from-conn! r) ;; Read more data into the reader buffer. - ;; Returns bytes read (0 = EOF, -1 = error). + ;; Returns bytes read (0 = EOF, -1 = error). Each per-read idle timeout is + ;; clamped to the time remaining on the current request's total deadline, so + ;; a client dribbling one byte per idle interval cannot hold a worker past + ;; the deadline (slowloris). Once the deadline passes we fail closed. (reader-compact! r) (let* ([buf (reader-buf r)] [end (reader-end r)] @@ -309,11 +328,25 @@ (when (<= space 0) ;; Buffer is full after compaction — shouldn't happen with proper sizing (error 'reader-fill! "buffer overflow")) + (let ([deadline (reader-deadline r)]) + (when deadline + (let ([remaining (- deadline (monotonic-seconds))]) + (when (<= remaining 0) + (reader-timeout-set! r #t) + (error 'reader-fill! "total request-read deadline exceeded")) + (ssl-set-timeout (reader-conn r) + (inexact->exact (max 1 (min (cfg-ref 3) (ceiling remaining)))) + (cfg-ref 4))))) (let ([tmp (make-bytevector space)]) (let ([n (conn-read (reader-conn r) tmp space)]) (when (> n 0) (bytevector-copy! tmp 0 buf end n) - (reader-end-set! r (+ end n))) + (reader-end-set! r (+ end n)) + ;; Arm the deadline on the first byte of the request so the idle wait + ;; before it stays governed by the socket idle timeout, while the + ;; headers+body read is bounded by request-timeout-ms. + (unless (reader-deadline r) + (reader-deadline-set! r (make-request-deadline)))) n)))) (def (reader-read-byte r) @@ -490,7 +523,11 @@ (def (read-request reader client-addr) ;; Parse an HTTP request from the reader. - ;; Returns http-request or #f on connection close. + ;; Returns http-request or #f on connection close. The per-request deadline + ;; is reset here so each request on a kept-alive connection gets a fresh + ;; total read budget; it is armed on the first byte in reader-fill-from-conn!. + (reader-deadline-set! reader #f) + (reader-timeout-set! reader #f) (let ([request-line (reader-read-line reader)]) (if (not request-line) #f ;; connection closed @@ -961,6 +998,11 @@ (let ([req (try (read-request reader client-addr) (catch (e) 'bad-request))]) (cond + [(reader-timed-out? reader) + ;; Total request-read deadline exceeded — fail closed with a + ;; 408 and do not keep the connection alive. + (try (http-respond-error writer 408) + (catch (e) (void)))] [(eq? req 'bad-request) (try (http-respond-error writer 400) (catch (e) (void)))] --- a/tests/httpd-test.ss +++ b/tests/httpd-test.ss @@ -378,6 +378,120 @@ (check (+ i 1))))))) ;; ================================================================ +;; Request-read deadline (slowloris) tests — dedicated server with a +;; small total request-timeout-ms so the tests run fast. +;; ================================================================ + +(define (mono-seconds) + (let ([now (current-time 'time-monotonic)]) + (+ (time-second now) (/ (time-nanosecond now) 1000000000.0)))) + +(define (head-content-length head) + (let ([len (string-length head)] + [needle "content-length"]) + (let loop ([i 0]) + (cond + [(> (+ i (string-length needle)) len) 0] + [(string-ci=? (substring head i (+ i (string-length needle))) needle) + (let ([colon (string-index-of head #\: i)]) + (if colon + (let scan ([j (+ colon 1)] [acc 0]) + (cond + [(>= j len) acc] + [(char=? (string-ref head j) #\space) (scan (+ j 1) acc)] + [(char<=? #\0 (string-ref head j) #\9) + (scan (+ j 1) + (+ (* acc 10) (- (char->integer (string-ref head j)) 48)))] + [else acc])) + 0))] + [else (loop (+ i 1))])))) + +(define (ka-read-response conn) + ;; Read one Content-Length-framed HTTP response. Returns (status . body) or #f. + (let loop ([chunks '()]) + (let* ([buf (make-bytevector 4096)] + [n (conn-read conn buf 4096)]) + (and (> n 0) + (let* ([chunk (let ([c (make-bytevector n)]) + (bytevector-copy! buf 0 c 0 n) c)] + [flat (apply bytevector-append (append chunks (list chunk)))] + [raw (utf8->string flat)] + [body-start (find-body-start raw (string-length raw))]) + (if (not body-start) + (loop (append chunks (list chunk))) + (let* ([head (substring raw 0 body-start)] + [cl (head-content-length head)] + [have (- (string-length raw) body-start)]) + (if (>= have cl) + (parse-http-response (substring raw 0 (+ body-start cl))) + (loop (append chunks (list chunk))))))))))) + +(display "\n--- Request Deadline (Slowloris) Tests ---\n") +(define deadline-port 18099) +(httpd-config 'request-timeout-ms: 1000) +(define deadline-server (httpd-start deadline-port)) +(sleep (make-time 'time-duration 100000000 0)) + +(test "fast request completes under a small total deadline" + (lambda () + (let ([r (http-request "GET" "/" deadline-port)]) + (assert-equal (car r) 200 "status") + (assert-true (string-contains? (cdr r) "Hello World") "body")))) + +(test "keep-alive: deadline resets so one connection serves multiple requests" + (lambda () + (let* ([fd (tcp-connect "127.0.0.1" deadline-port)] + [_to (tcp-set-timeout fd 5 5)] + [conn (conn-wrap fd)]) + (dynamic-wind + void + (lambda () + (conn-write-string conn + "GET / HTTP/1.1\r\nHost: 127.0.0.1\r\nConnection: keep-alive\r\n\r\n") + (let ([r1 (ka-read-response conn)]) + (assert-true r1 "first response received") + (assert-equal (car r1) 200 "first status")) + ;; Idle longer than the per-request deadline: the idle wait between + ;; requests is governed by the keep-alive idle timeout, and the total + ;; deadline must reset for the second request rather than accumulate. + (sleep (make-time 'time-duration 500000000 1)) + (conn-write-string conn + "GET /json HTTP/1.1\r\nHost: 127.0.0.1\r\nConnection: keep-alive\r\n\r\n") + (let ([r2 (ka-read-response conn)]) + (assert-true r2 "second response received") + (assert-equal (car r2) 200 "second status") + (assert-true (string-contains? (cdr r2) "\"status\":\"ok\"") "second body"))) + (lambda () (ssl-close conn)))))) + +(test "slowloris: total request-read deadline closes a dribbling client" + (lambda () + (let* ([fd (tcp-connect "127.0.0.1" deadline-port)] + [_to (tcp-set-timeout fd 2 2)] + [conn (conn-wrap fd)] + [start (mono-seconds)] + [closed-at (box #f)]) + (dynamic-wind + void + (lambda () + (guard (e [#t (unless (unbox closed-at) + (set-box! closed-at (- (mono-seconds) start)))]) + (let loop ([i 0]) + (when (< i 200) + ;; Dribble one byte well under the per-read idle timeout so only + ;; the TOTAL deadline can close us. + (conn-write conn (bytevector 65)) + (sleep (make-time 'time-duration 50000000 0)) + (loop (+ i 1)))))) + (lambda () (ssl-close conn))) + (assert-true (unbox closed-at) + "server closed the dribbling connection at the total deadline") + (assert-true (< (unbox closed-at) 8) + "connection was bounded, not held forever")))) + +(httpd-stop deadline-server) +(httpd-config 'request-timeout-ms: 30000) + +;; ================================================================ ;; Cleanup & summary ;; ================================================================