diff --git a/client/connection.lisp b/client/connection.lisp index e2a4b4fc..85ef84d5 100644 --- a/client/connection.lisp +++ b/client/connection.lisp @@ -21,6 +21,7 @@ max-connection-age clock-function lock + (generation 0) (clear-callbacks nil) (entries nil)) @@ -227,19 +228,22 @@ be used concurrently from multiple threads." (remove oldest entries :test #'eq)) (%pool-close pool (%http-pooled-connection-stream oldest)))))) -(defun %pool-retain (pool key stream opened-at last-used) +(defun %pool-retain (pool key stream opened-at last-used generation) (let ((max-idle (%http-connection-pool-max-idle pool))) - (if (zerop max-idle) - (%pool-close pool stream) - (progn - (when (>= (length (%http-connection-pool-entries pool)) max-idle) - (%pool-evict-oldest pool)) - (push (%make-http-pooled-connection - :key key - :stream stream - :opened-at opened-at - :last-used last-used) - (%http-connection-pool-entries pool))))) + (cond + ((/= generation (%http-connection-pool-generation pool)) + (%pool-close pool stream)) + ((zerop max-idle) + (%pool-close pool stream)) + (t + (when (>= (length (%http-connection-pool-entries pool)) max-idle) + (%pool-evict-oldest pool)) + (push (%make-http-pooled-connection + :key key + :stream stream + :opened-at opened-at + :last-used last-used) + (%http-connection-pool-entries pool))))) pool) (defun %pool-open (pool request &key timeout deadline proxy-plan proxy) @@ -270,12 +274,13 @@ be used concurrently from multiple threads." (%http-connection-pool-max-connection-age pool)))) (defun http-connection-pool-clear (pool) - "Close and remove every idle connection in POOL, returning its count." + "Close idle entries in POOL and invoke its clear callbacks. Return the number of idle entries removed." (%pool-ensure-pool pool) (let ((entries nil) (callbacks nil) (callback-error nil)) (%with-client-lock ((%http-connection-pool-lock pool)) + (incf (%http-connection-pool-generation pool)) (setf entries (%http-connection-pool-entries pool) callbacks (copy-list (%http-connection-pool-clear-callbacks pool)) @@ -315,6 +320,7 @@ be used concurrently from multiple threads." :cause condition)))) (stream nil) (opened-at nil) + (generation nil) (retained-p nil)) (handler-case (with-http-deadline @@ -322,10 +328,11 @@ be used concurrently from multiple threads." :inherited deadline :clock-function #'%pool-monotonic-time) (let ((entry - (unless *client-preopened-http-stream* - (%with-client-lock ((%http-connection-pool-lock pool)) - (%pool-purge-expired pool) - (%pool-take pool key))))) + (%with-client-lock ((%http-connection-pool-lock pool)) + (setf generation (%http-connection-pool-generation pool)) + (unless *client-preopened-http-stream* + (%pool-purge-expired pool) + (%pool-take pool key))))) (cond (*client-preopened-http-stream* (setf stream (prog1 *client-preopened-http-stream* @@ -349,7 +356,7 @@ be used concurrently from multiple threads." (error '%http-client-alpn-handoff :stream opened-stream)) ((or (null negotiated-alpn) - (equal negotiated-alpn "http/1.1")) + (equal negotiated-alpn "http/1.1")) nil) (t (%pool-protocol-error @@ -376,24 +383,25 @@ be used concurrently from multiple threads." (if reusable-p (progn (%with-client-lock ((%http-connection-pool-lock pool)) - (%pool-retain pool key stream opened-at (%pool-now pool))) + (%pool-retain pool key stream opened-at (%pool-now pool) + generation)) (setf retained-p t)) - (%pool-close pool stream)) + (%pool-close pool stream)) (setf stream nil) response))) (%http-client-alpn-handoff (condition) - (error condition)) + (error condition)) (http-error (condition) - (unless retained-p - (%pool-close pool stream)) - (error condition)) + (unless retained-p + (%pool-close pool stream)) + (error condition)) (error (condition) - (unless retained-p - (%pool-close pool stream)) - (error 'http-connection-error - :message "The pooled HTTP exchange signaled an error." - :operation :transport - :cause condition))))) + (unless retained-p + (%pool-close pool stream)) + (error 'http-connection-error + :message "The pooled HTTP exchange signaled an error." + :operation :transport + :cause condition))))) (defun http-connection-pool-send (pool request &key key timeout deadline max-header-bytes max-fields max-body-bytes diff --git a/client/data.lisp b/client/data.lisp index 83fb6cc6..ab684225 100644 --- a/client/data.lisp +++ b/client/data.lisp @@ -328,6 +328,7 @@ character in that range is a decimal digit, apart from an optional sign when ;; plus :ALTERNATIVE-SERVICE. http3-transport-function connection-pool + clear-connections-function (default-headers nil) cookie-jar cookie-partition-key diff --git a/docs/src/project/changelog.md b/docs/src/project/changelog.md index abbd3d12..0c4519b7 100644 --- a/docs/src/project/changelog.md +++ b/docs/src/project/changelog.md @@ -14,6 +14,15 @@ historical release behavior, not the current API contract; see the See the [WebSocket and SSE migration guide](migration.md#websocket-and-sse-api-migration). +### HTTP/2 + +- report malformed PING frames received while awaiting an acknowledgement as + `http-protocol-error` with `:http2-client` operation and the received frame + as detail. +- document `:http2-read` detail for DATA on a never-opened HTTP/2 client stream: + the stream ID while another request is in progress and has not failed, + otherwise a list with `0` (the DATA frame type) followed by the stream ID. + ## 0.4.1 - require certificate-chain, hostname, and trust verification by default on diff --git a/docs/src/reference/api.md b/docs/src/reference/api.md index c21df2b0..bdc4b7d6 100644 --- a/docs/src/reference/api.md +++ b/docs/src/reference/api.md @@ -442,6 +442,10 @@ The condition type for malformed or contradictory protocol data. ### `http-protocol-error-detail` Return structured protocol detail. +For `:http2-read` errors caused by DATA on a client stream that has never been +opened, the detail is the stream ID when another request on the connection is +still in progress and has not failed; otherwise it is a two-element list with +`0` (the DATA frame type) first and the stream ID second. ### `http-invalid-uri` @@ -557,6 +561,9 @@ per decoded header or trailer section is 256. `cancel-http2-stream` emits `RST_STREAM` for an opened client stream. `ping-http2-connection` sends a PING and waits for the matching acknowledgement. +If it receives a malformed PING while waiting, it signals +`HTTP-PROTOCOL-ERROR` with operation `:http2-client` and the received frame as +detail. `send-http2-priority-update` emits an RFC 9218 priority update. `send-http2-goaway` and its convenience alias `graceful-shutdown-http2-connection` make the connection drain without @@ -612,9 +619,16 @@ also clamps peer HPACK table settings to 4096 bytes by default through `&key open-connection max-connections idle-timeout max-connection-age clock-function on-evict on-transient-close`. `max-connections` defaults to `8` and limits retained cache entries; request-scoped connections do not count -toward that limit. On SBCL, the manager synchronizes its entry state for -concurrent callers and leases each retained connection to at most one manager -call at a time. +toward that limit, so the total number of open connections can exceed it. On +SBCL, the manager synchronizes its entry state for concurrent callers. Ordinary +single-request calls with the same key can share one retained connection; its +scheduler assigns distinct stream IDs and observes the peer's concurrent-stream +and flow-control limits. A batch call holds an exclusive lease on its selected +connection. A concurrent call that cannot share an active entry uses a +request-scoped connection. +There is no separate cap on total open connections. Enforcing one would require +the manager to define how concurrent calls wait or fail when all sockets are in +use, so `max-connections` remains a retained-cache limit. By default, the cache key includes the request scheme, host, port, proxy plan, and proxy. Supplying `connection-key` to a send function replaces that default; keys are @@ -626,11 +640,10 @@ Each invocation passes `:timeout` and `:deadline`; proxy-routed requests also pass `:proxy-plan` and `:proxy`. Caller-supplied `open-connection`, `clock-function`, `on-evict`, and `on-transient-close` functions may run concurrently with manager calls, so they must synchronize any shared state -they use. A request for a key whose retained connection is busy uses a -request-scoped connection. For a different key, the manager can create a -retained entry while below the cap, or evict the least-recently-used idle -entry at capacity. If the cache is full and every retained entry is active, -it uses a request-scoped connection. +they use. For a different key, the manager can create a retained entry while +below the cap, or evict the least-recently-used idle entry at capacity. If the +cache is full and every retained entry is active, a request for another key +uses a request-scoped connection. `idle-timeout`, `max-connection-age`, and `on-evict` default to `nil`. Idle expiry is based on the time since the last completed manager call; maximum age @@ -667,7 +680,17 @@ session multiplexes the streams. `make-http2-connection-manager-transport` adapts a manager to the high-level client transport protocol. The two send functions and the function returned by `make-http2-connection-manager-transport` each accept and forward the per-section -`max-fields` limit. +`max-fields` limit. Per-request `max-header-bytes`, `max-fields`, and +`max-body-bytes` values can tighten the selected connection's limits; they +cannot raise them. + +While dispatching received response frames, malformed headers and body-limit +violations fail the connection and every active request on it. RFC 9113 +ยง5.4.1 permits treating a stream error as a connection error. A per-request +timeout, callback error, explicit stream cancellation, or peer `RST_STREAM` +uses the stream-level handling path. If writing a required `RST_STREAM` fails, +the connection also fails. + `clear-http2-connection-manager` is idempotent. It retires all retained connections without closing the manager and returns it on success. A call whose connection was still opening when clear began may finish using diff --git a/http2/transport-connection.lisp b/http2/transport-connection.lisp index ba4de1d9..53e66f04 100644 --- a/http2/transport-connection.lisp +++ b/http2/transport-connection.lisp @@ -1,5 +1,12 @@ (in-package #:http-kit/http2) +(defmacro %h2-with-scheduler-lock ((connection) &body body) + #+sbcl + `(sb-thread:with-mutex ((%http2-connection-scheduler-lock ,connection)) + ,@body) + #-sbcl + `(progn ,@body)) + (defun http2-client-connection (client) (and (http2-client-p client) (%http2-connection client))) @@ -7,7 +14,8 @@ (defun %h2-peer-stream-reset-condition-p (condition) (and (typep condition 'http-kit:http-connection-error) (let ((cause (http-kit:http-connection-error-cause condition))) - (and (consp cause) (eq (first cause) :rst-stream))))) + (and (consp cause) + (member (first cause) '(:rst-stream :goaway)))))) (defun make-http2-connection (&key stream close-stream @@ -113,12 +121,22 @@ SETTINGS, stream identifiers, HPACK decoder state, and control frames." :message "CLOSE-HTTP2-CONNECTION requires an HTTP2-CONNECTION." :operation :http2-client :detail (type-of connection))) - (unless (%http2-connection-closed-p connection) - (setf (%http2-connection-closed-p connection) t) - (http-kit::%with-http-cleanup - (funcall (%http2-connection-close-stream connection) - (%http2-connection-stream connection)))) - connection) + (let ((close-p nil)) + #+sbcl + (%h2-with-scheduler-lock (connection) + (unless (%http2-connection-closed-p connection) + (setf (%http2-connection-closed-p connection) t + close-p t)) + (%h2-scheduler-broadcast connection)) + #-sbcl + (unless (%http2-connection-closed-p connection) + (setf (%http2-connection-closed-p connection) t + close-p t)) + (when close-p + (http-kit::%with-http-cleanup + (funcall (%http2-connection-close-stream connection) + (%http2-connection-stream connection)))) + connection)) (defun %h2-control-octets (value name) (unless (and value @@ -170,7 +188,8 @@ are rejected after this function marks the connection draining." (clock (or clock-function (%http2-connection-clock-function connection))) (error-code (%h2-control-error-code error-code)) - (last-stream-id (%h2-control-stream-id connection last-stream-id)) + (last-stream-id (when last-stream-id + (%h2-control-stream-id connection last-stream-id))) (debug-data (%h2-control-octets (or debug-data (make-array 0 @@ -186,15 +205,6 @@ are rejected after this function marks the connection draining." :message "The HTTP/2 connection is already closed." :operation :http2-client :detail :goaway-after-close)) - (let ((previous-last-stream-id - (%http2-connection-local-goaway-last-stream-id connection))) - (when (and previous-last-stream-id - (> last-stream-id previous-last-stream-id)) - (error 'http-kit:http-protocol-error - :message "A subsequent HTTP/2 GOAWAY last-stream identifier must not increase." - :operation :http2-client - :detail (list :previous previous-last-stream-id - :new last-stream-id)))) (when (> (+ 8 (length debug-data)) (%http2-connection-peer-max-frame-size connection)) (error 'http-kit:http-protocol-error @@ -206,20 +216,36 @@ are rejected after this function marks the connection draining." (let ((payload (make-array (+ 8 (length debug-data)) :element-type '(unsigned-byte 8))) (writer nil)) - (%h2-put-u32 payload 0 last-stream-id) - (%h2-put-u32 payload 4 error-code) (replace payload debug-data :start1 8) - ;; Record the state before writing so a re-entrant caller cannot open a - ;; stream while the GOAWAY bytes are still in the writer. - (setf (%http2-connection-local-goaway-last-stream-id connection) - last-stream-id - (%http2-connection-draining-p connection) t - writer (%h2-writer stream nil nil)) + (%h2-with-scheduler-lock (connection) + (unless last-stream-id + (setf last-stream-id (%h2-control-stream-id connection nil))) + (let ((previous-last-stream-id + (%http2-connection-local-goaway-last-stream-id connection))) + (when (and previous-last-stream-id + (> last-stream-id previous-last-stream-id)) + (error 'http-kit:http-protocol-error + :message "A subsequent HTTP/2 GOAWAY last-stream identifier must not increase." + :operation :http2-client + :detail (list :previous previous-last-stream-id + :new last-stream-id)))) + (%h2-put-u32 payload 0 last-stream-id) + (%h2-put-u32 payload 4 error-code) + ;; Record the state before writing so a re-entrant caller cannot open a + ;; stream while the GOAWAY bytes are still in the writer. + (setf (%http2-connection-local-goaway-last-stream-id connection) + last-stream-id + (%http2-connection-draining-p connection) t + writer (%h2-writer stream nil nil + #+sbcl (%http2-connection-writer-lock connection) + #-sbcl nil))) (handler-case (http-kit:with-http-deadline (absolute-deadline timeout :inherited deadline :clock-function clock) - (setf writer (%h2-writer stream absolute-deadline clock)) + (setf writer (%h2-writer stream absolute-deadline clock + #+sbcl (%http2-connection-writer-lock connection) + #-sbcl nil)) (%h2-send-control writer +http2-goaway-type+ 0 0 payload)) (error (condition) (close-http2-connection connection) @@ -289,8 +315,7 @@ are rejected after this function marks the connection draining." (http-kit:with-http-deadline (absolute-deadline timeout :inherited deadline :clock-function clock) - (%h2-send-control (%h2-writer (%http2-connection-stream connection) - absolute-deadline clock) + (%h2-send-control (%h2-writer (%http2-connection-stream connection) absolute-deadline clock #+sbcl (%http2-connection-writer-lock connection) #-sbcl nil) +http2-priority-update-type+ 0 0 payload)) (error (condition) (close-http2-connection connection) @@ -311,18 +336,13 @@ are rejected after this function marks the connection draining." (defun ping-http2-connection (connection &key payload timeout deadline clock-function) - "Send an HTTP/2 PING and wait for its matching ACK. - -PAYLOAD must be exactly eight octets when supplied. Control frames received -while waiting are processed; a non-control frame is a protocol error because -this operation has no response stream to associate with it." + "Send an HTTP/2 PING and return its payload after a matching ACK." (let* ((connection (if (http2-connection-p connection) connection (error 'http-kit:http-protocol-error :message "PING-HTTP2-CONNECTION requires an HTTP2-CONNECTION." :operation :http2-client :detail (type-of connection)))) - (stream (%http2-connection-stream connection)) (clock (or clock-function (%http2-connection-clock-function connection))) (payload (%h2-control-octets @@ -350,7 +370,12 @@ this operation has no response stream to associate with it." (http-kit:with-http-deadline (absolute-deadline timeout :inherited deadline :clock-function clock) - (let* ((reader (%h2-reader-for stream)) + #+sbcl + (%h2-scheduler-ping + connection payload absolute-deadline clock) + #-sbcl + (let* ((stream (%http2-connection-stream connection)) + (reader (%h2-reader-for stream)) (writer (%h2-writer stream absolute-deadline clock))) (%h2-send-control writer +http2-ping-type+ 0 0 payload) (loop @@ -451,69 +476,158 @@ this operation has no response stream to associate with it." (connection reader writer stream-id body request-body-function expected-body-length max-body-bytes local-max-frame-size trailer-fields deadline clock-function read-initial-settings-p - huffman-p) + huffman-p &key scheduler-p flow-wait-function scheduler-entry) (let ((position 0) (pending-frames '()) (first-settings-p read-initial-settings-p) (body-length (length body))) - (labels ((read-while-blocked () - (let ((frame (%h2-read-frame - reader - (%http2-connection-max-frame-size connection) - deadline clock-function))) - (when (eq frame :eof) + (labels ((check-scheduler-entry-under-lock () + (when scheduler-entry + (when (%h2-batch-entry-error scheduler-entry) + (error (%h2-batch-entry-error scheduler-entry))) + (when (%h2-batch-entry-request-body-abandoned-p + scheduler-entry) + (return-from %h2-connection-send-request-body nil)) + (unless (member scheduler-entry + (%http2-connection-scheduler-entries connection) + :test #'eq) (error 'http-kit:http-connection-error - :message "The HTTP/2 peer closed while upload flow control was blocked." - :operation :http2-read - :cause :eof)) - (when first-settings-p - (unless (and (= (%h2-frame-type frame) - +http2-settings-type+) - (zerop (%h2-frame-stream-id frame)) - (zerop (logand (%h2-frame-flags frame) - +http2-ack-flag+))) - (error 'http-kit:http-protocol-error - :message "The first HTTP/2 peer frame must be a non-ACK SETTINGS frame." - :operation :http2-read - :detail (list (%h2-frame-type frame) - (%h2-frame-stream-id frame) - (%h2-frame-flags frame)))) - (setf first-settings-p nil)) - (if (%h2-control-frame-p (%h2-frame-type frame)) - (%h2-connection-control-handler - connection frame writer stream-id) - (push frame pending-frames)))) + :message "The HTTP/2 request stream is no longer active." + :operation :http2-write + :cause (list :stream-inactive stream-id))))) + (check-scheduler-entry () + (when scheduler-entry + (%h2-with-scheduler-lock (connection) + (check-scheduler-entry-under-lock)))) + (read-while-blocked () + (if flow-wait-function + (progn + (funcall flow-wait-function connection stream-id + deadline clock-function) + (check-scheduler-entry)) + (let ((frame (%h2-read-frame + reader + (%http2-connection-max-frame-size connection) + deadline clock-function))) + (when (eq frame :eof) + (error 'http-kit:http-connection-error + :message "The HTTP/2 peer closed while upload flow control was blocked." + :operation :http2-read + :cause :eof)) + (when first-settings-p + (unless (and (= (%h2-frame-type frame) + +http2-settings-type+) + (zerop (%h2-frame-stream-id frame)) + (zerop (logand (%h2-frame-flags frame) + +http2-ack-flag+))) + (error 'http-kit:http-protocol-error + :message "The first HTTP/2 peer frame must be a non-ACK SETTINGS frame." + :operation :http2-read + :detail (list (%h2-frame-type frame) + (%h2-frame-stream-id frame) + (%h2-frame-flags frame)))) + (setf first-settings-p nil)) + (if (%h2-control-frame-p (%h2-frame-type frame)) + (%h2-connection-control-handler + connection frame writer stream-id) + (push frame pending-frames))))) (write-data (payload end-stream-p) - (let ((size (length payload))) - (%h2-write-wire - (%http2-connection-stream connection) - (%h2-frame-wire - +http2-data-type+ - (if end-stream-p +http2-end-stream-flag+ 0) - stream-id payload) - deadline clock-function) - (when (plusp size) - (decf (%http2-connection-peer-connection-window-size - connection) - size) - (let ((entry (assoc stream-id - (%http2-connection-peer-stream-windows - connection)))) - (decf (cdr entry) size)) - (incf position size)))) + (let ((payload-size (length payload))) + (if scheduler-p + (%h2-with-scheduler-lock (connection) + (check-scheduler-entry-under-lock) + (let* ((size + (min payload-size + (effective-max-frame-size))) + (frame-payload + (if (= size payload-size) + payload + (subseq payload 0 size))) + (wire + (%h2-frame-wire + +http2-data-type+ + (if (and end-stream-p + (= size payload-size)) + +http2-end-stream-flag+ + 0) + stream-id frame-payload)) + (stream-window + (%h2-connection-stream-window + connection stream-id)) + (connection-window + (%http2-connection-peer-connection-window-size + connection))) + (when (or (zerop size) + (>= (min stream-window connection-window) + size)) + (funcall writer wire) + (when (plusp size) + (decf + (%http2-connection-peer-connection-window-size + connection) + size) + (decf + (cdr (assoc + stream-id + (%http2-connection-peer-stream-windows + connection))) + size) + (incf position size)) + size))) + (let* ((size payload-size) + (wire + (%h2-frame-wire + +http2-data-type+ + (if end-stream-p +http2-end-stream-flag+ 0) + stream-id payload))) + (funcall writer wire) + (when (plusp size) + (decf + (%http2-connection-peer-connection-window-size + connection) + size) + (let ((entry + (assoc + stream-id + (%http2-connection-peer-stream-windows + connection)))) + (decf (cdr entry) size)) + (incf position size)) + size)))) (effective-max-frame-size () (min local-max-frame-size (%http2-connection-peer-max-frame-size connection))) (write-trailers () (when trailer-fields - (%h2-write-wire - (%http2-connection-stream connection) - (%h2-concat - (%h2-header-frames - (%h2-encode-header-block trailer-fields - :huffman-p huffman-p) - t (effective-max-frame-size) stream-id)) - deadline clock-function)))) + (if scheduler-p + (%h2-with-scheduler-lock (connection) + (check-scheduler-entry-under-lock) + (funcall + writer + (%h2-concat + (%h2-header-frames + (%h2-encode-header-block trailer-fields + :huffman-p huffman-p) + t (effective-max-frame-size) stream-id)))) + (funcall + writer + (%h2-concat + (%h2-header-frames + (%h2-encode-header-block trailer-fields + :huffman-p huffman-p) + t (effective-max-frame-size) stream-id)))))) + (window-available-size (frame-size) + (if scheduler-p + (%h2-with-scheduler-lock (connection) + (min frame-size + (%h2-connection-stream-window + connection stream-id) + (%http2-connection-peer-connection-window-size + connection))) + (min frame-size + (%h2-connection-stream-window connection stream-id) + (%http2-connection-peer-connection-window-size + connection))))) (if request-body-function (let ((pending-chunk nil) (pending-offset 0) @@ -521,6 +635,7 @@ this operation has no response stream to associate with it." (loop (when (and (null pending-chunk) (not producer-done-p)) + (check-scheduler-entry) (let* ((producer-max-frame-size (effective-max-frame-size)) (chunk (funcall request-body-function @@ -545,14 +660,8 @@ this operation has no response stream to associate with it." (return)) (t (let* ((max-frame-size (effective-max-frame-size)) - (stream-window - (%h2-connection-stream-window - connection stream-id)) - (connection-window - (%http2-connection-peer-connection-window-size - connection)) (available - (min max-frame-size stream-window connection-window)) + (window-available-size max-frame-size)) (remaining (- (length pending-chunk) pending-offset))) (when (and expected-body-length @@ -571,37 +680,34 @@ this operation has no response stream to associate with it." expected-body-length)))) (http-kit::%check-limit :body (+ position size) max-body-bytes) - (write-data - (subseq pending-chunk - pending-offset (+ pending-offset size)) - end-stream-p) - (incf pending-offset size) - (when (= pending-offset (length pending-chunk)) - (setf pending-chunk nil - pending-offset 0)) - (when end-stream-p - (return))) + (let ((written-size + (write-data + (subseq pending-chunk + pending-offset + (+ pending-offset size)) + end-stream-p))) + (when written-size + (incf pending-offset written-size) + (when (= pending-offset (length pending-chunk)) + (setf pending-chunk nil + pending-offset 0)) + (when (and end-stream-p + (= written-size size)) + (return))))) (read-while-blocked))))))) (loop while (< position body-length) do (let* ((max-frame-size (effective-max-frame-size)) - (stream-window - (%h2-connection-stream-window - connection stream-id)) - (connection-window - (%http2-connection-peer-connection-window-size - connection)) (size (min max-frame-size (- body-length position) - stream-window - connection-window))) + (window-available-size + max-frame-size)))) (if (plusp size) (write-data (subseq body position (+ position size)) (and (= (+ position size) body-length) (null trailer-fields))) (read-while-blocked))))) - (when trailer-fields - (write-trailers)) + (when trailer-fields (write-trailers)) (values (nreverse pending-frames) first-settings-p)))) (defun %h2-connection-note-window-update (connection frame expected-stream-id) @@ -781,22 +887,10 @@ this operation has no response stream to associate with it." :message "CANCEL-HTTP2-STREAM requires an HTTP2-CONNECTION." :operation :http2-client :detail (type-of connection))) - (unless (http2-connection-open-p connection) - (error 'http-kit:http-connection-error - :message "The HTTP/2 connection is closed." - :operation :http2-client - :cause :closed)) - (unless (and (integerp stream-id) - (plusp stream-id) - (oddp stream-id) - (< stream-id (%http2-connection-next-stream-id connection))) - (error 'http-kit:http-protocol-error - :message "STREAM-ID must identify an opened client HTTP/2 stream." - :operation :http2-write - :detail stream-id)) (let ((clock (or clock-function (%http2-connection-clock-function connection))) - (error-code (%h2-control-error-code error-code))) + (error-code (%h2-control-error-code error-code)) + (entry nil)) (unless (functionp clock) (error 'http-kit:http-protocol-error :message "An HTTP/2 cancellation clock must be callable." @@ -805,13 +899,41 @@ this operation has no response stream to associate with it." (http-kit:with-http-deadline (absolute-deadline timeout :inherited deadline :clock-function clock) - (%h2-send-rst-stream - (%h2-writer (%http2-connection-stream connection) - absolute-deadline clock) - stream-id error-code))) - t) + (%h2-with-scheduler-lock (connection) + (unless (http2-connection-open-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection is closed." + :operation :http2-client + :cause :closed)) + (unless (and (integerp stream-id) + (plusp stream-id) + (oddp stream-id) + (< stream-id (%http2-connection-next-stream-id connection))) + (error 'http-kit:http-protocol-error + :message "STREAM-ID must identify an opened client HTTP/2 stream." + :operation :http2-write + :detail stream-id)) + #+sbcl + (setf entry (%h2-scheduler-entry-for-stream connection stream-id)) + (unless entry + (%h2-send-rst-stream + (%h2-writer (%http2-connection-stream connection) + absolute-deadline clock + #+sbcl (%http2-connection-writer-lock connection) + #-sbcl nil) + stream-id error-code))) + #+sbcl + (when entry + (%h2-scheduler-retire-entry + connection entry + (make-condition 'http-kit:http-connection-error + :message "The HTTP/2 stream was cancelled locally." + :operation :http2-write + :cause (list :local-cancel stream-id error-code)) + clock 0 error-code))) + t)) -(defun send-http2-request-over-connection +(defun %h2-send-http2-request-over-connection-serial (connection request &key timeout deadline max-header-bytes max-fields max-body-bytes clock-function request-body-function request-body-length @@ -855,12 +977,16 @@ concurrent streams should use SEND-HTTP2-REQUESTS-OVER-CONNECTION." :detail collect-body-p)) (let* ((clock (or clock-function (%http2-connection-clock-function connection))) - (header-limit (or max-header-bytes - (%http2-connection-max-header-bytes connection))) + (header-limit + (min (or max-header-bytes + (%http2-connection-max-header-bytes connection)) + (%http2-connection-max-header-bytes connection))) (field-limit (min (or max-fields most-positive-fixnum) (%http2-connection-max-fields connection))) - (body-limit (or max-body-bytes - (%http2-connection-max-body-bytes connection))) + (body-limit + (min (or max-body-bytes + (%http2-connection-max-body-bytes connection)) + (%http2-connection-max-body-bytes connection))) (stream-id nil)) (http-kit:with-http-deadline (absolute-deadline timeout :inherited deadline @@ -1028,7 +1154,10 @@ concurrent streams should use SEND-HTTP2-REQUESTS-OVER-CONNECTION." (defstruct (%h2-batch-entry (:constructor %make-h2-batch-entry (&key request stream-id body request-body-function - expected-body-length outgoing-frame-size trailer-fields))) + expected-body-length outgoing-frame-size trailer-fields + max-header-bytes max-fields max-body-bytes + on-body-chunk on-information collect-body-p + deadline clock-function))) request stream-id body @@ -1036,6 +1165,20 @@ concurrent streams should use SEND-HTTP2-REQUESTS-OVER-CONNECTION." expected-body-length outgoing-frame-size trailer-fields + max-header-bytes + max-fields + max-body-bytes + on-body-chunk + on-information + (collect-body-p t) + deadline + clock-function + body-sent-p + request-body-abandoned-p + error + local-retired-p + callback-events + callback-events-tail (body-position 0) status headers @@ -1046,6 +1189,12 @@ concurrent streams should use SEND-HTTP2-REQUESTS-OVER-CONNECTION." (body-length 0) response) +(defstruct (%h2-scheduler-ping-waiter + (:constructor %make-h2-scheduler-ping-waiter (payload))) + payload + acknowledged-p + failure) + (defun %h2-batch-entry-for-stream (entries stream-id) (find stream-id entries :key #'%h2-batch-entry-stream-id @@ -1153,6 +1302,12 @@ CONTINUATION frames must still be consumed contiguously from that queue." :message "An informational HTTP/2 response cannot end the stream." :operation :http2-read :detail candidate-status)) + (when (%h2-batch-entry-on-information entry) + (funcall (%h2-batch-entry-on-information entry) + (http-kit:make-http-response + :status candidate-status + :headers candidate-headers + :protocol-version "HTTP/2"))) (values nil nil nil)) (values candidate-status candidate-headers (when end-stream @@ -1160,6 +1315,1036 @@ CONTINUATION frames must still be consumed contiguously from that queue." candidate-status candidate-headers nil body request-method :body-length body-length))))))))) +#+sbcl +(progn + (defun %h2-scheduler-writer (connection deadline clock-function) + (%h2-writer (%http2-connection-stream connection) + deadline clock-function + (%http2-connection-writer-lock connection))) + + (defun %h2-scheduler-condition-wait (connection deadline clock-function) + (http-kit::%check-deadline deadline clock-function :read) + (let* ((lock (%http2-connection-scheduler-lock connection)) + (timeout (and deadline + (max 0 (- deadline (funcall clock-function)))))) + (sb-thread:condition-wait + (%http2-connection-scheduler-condition connection) + lock + :timeout timeout) + (unless (sb-thread:holding-mutex-p lock) + (sb-sys:without-interrupts + (sb-sys:allow-with-interrupts + (sb-thread:grab-mutex lock)))) + (http-kit::%check-deadline deadline clock-function :read))) + + (defun %h2-scheduler-broadcast (connection) + (sb-thread:condition-broadcast + (%http2-connection-scheduler-condition connection))) + + (defun %h2-scheduler-entry-ready-p (entry) + (or (%h2-batch-entry-error entry) + (%h2-batch-entry-callback-events entry) + (and (%h2-batch-entry-response entry) + (%h2-batch-entry-body-sent-p entry)))) + + (defun %h2-scheduler-control-writer (connection clock-function) + (%h2-writer (%http2-connection-stream connection) + nil clock-function + (%http2-connection-writer-lock connection))) + + (defun %h2-scheduler-return-flow-credit + (connection stream-id increment clock-function &optional connection-only-p) + (let ((writer (%h2-scheduler-control-writer connection clock-function))) + (unless connection-only-p + (%h2-send-window-update writer stream-id increment)) + (%h2-send-window-update writer 0 increment))) + + (defun %h2-scheduler-queue-callback (connection entry event) + (let ((queued-p nil) + (overflow-condition nil) + (max-pending-information-events 16)) + (%h2-with-scheduler-lock (connection) + (unless (or (%h2-batch-entry-local-retired-p entry) + (%h2-batch-entry-error entry)) + (if (and (eq (first event) :information) + (>= (count :information + (%h2-batch-entry-callback-events entry) + :key (function first) + :test (function eq)) + max-pending-information-events)) + (setf overflow-condition + (make-condition + (quote http-kit:http-protocol-error) + :message + "The peer exceeded the pending informational response callback limit." + :operation :http2-read + :detail + (list :information-callback-queue + (%h2-batch-entry-stream-id entry) + max-pending-information-events)) + (%h2-batch-entry-error entry) overflow-condition) + (let ((cell (list event)) + (tail (%h2-batch-entry-callback-events-tail entry))) + (if tail + (setf (cdr tail) cell) + (setf (%h2-batch-entry-callback-events entry) cell)) + (setf (%h2-batch-entry-callback-events-tail entry) cell + queued-p t))) + (%h2-scheduler-broadcast connection))) + (when overflow-condition + (%h2-scheduler-retire-entry + connection entry overflow-condition + (%http2-connection-clock-function connection))) + queued-p)) + + (defun %h2-scheduler-pop-callback (connection entry) + (%h2-with-scheduler-lock (connection) + (let ((events (%h2-batch-entry-callback-events entry))) + (when events + (setf (%h2-batch-entry-callback-events entry) (cdr events)) + (unless (%h2-batch-entry-callback-events entry) + (setf (%h2-batch-entry-callback-events-tail entry) nil)) + (car events))))) + + (defun %h2-scheduler-retire-entry + (connection entry condition clock-function &optional (flow-credit 0) + (reset-error-code 8)) + (let ((reset-p nil) + (connection-credit flow-credit)) + (%h2-with-scheduler-lock (connection) + (unless (or (%h2-batch-entry-local-retired-p entry) + (%h2-peer-stream-reset-condition-p + (%h2-batch-entry-error entry))) + (setf (%h2-batch-entry-local-retired-p entry) t) + (unless (%h2-batch-entry-error entry) + (setf (%h2-batch-entry-error entry) condition)) + (setf reset-p + (member entry (%http2-connection-scheduler-entries connection) + :test #'eq)) + (%h2-scheduler-remove-entry connection entry) + (loop for event in (%h2-batch-entry-callback-events entry) + when (eq (first event) :body) + do (incf connection-credit (fourth event))) + (setf (%h2-batch-entry-callback-events entry) nil + (%h2-batch-entry-callback-events-tail entry) nil + (%h2-batch-entry-body-vector entry) + (make-array 0 :element-type '(unsigned-byte 8) + :adjustable t :fill-pointer 0) + (%h2-batch-entry-body-length entry) 0 + (%h2-batch-entry-response entry) nil) + (%h2-scheduler-broadcast connection))) + (handler-case + (progn + (when (plusp connection-credit) + (%h2-scheduler-return-flow-credit + connection 0 connection-credit clock-function t)) + (when reset-p + (%h2-send-rst-stream + (%h2-scheduler-control-writer connection clock-function) + (%h2-batch-entry-stream-id entry) reset-error-code))) + (error (reset-condition) + (%h2-scheduler-fail-connection connection reset-condition) + (error reset-condition))))) + + (defun %h2-scheduler-run-entry-callbacks + (connection entry clock-function) + (loop for event = (%h2-scheduler-pop-callback connection entry) + while event + do (let ((entry-error + (%h2-with-scheduler-lock (connection) + (%h2-batch-entry-error entry)))) + (ecase (first event) + (:information + (unless entry-error + (handler-case + (funcall (second event) (third event)) + (error (condition) + (%h2-scheduler-retire-entry + connection entry condition clock-function) + (error condition))))) + (:body + (if entry-error + (%h2-scheduler-return-flow-credit + connection 0 (fourth event) clock-function t) + (progn + (handler-case + (funcall (second event) (third event)) + (error (condition) + (%h2-scheduler-retire-entry + connection entry condition clock-function + (fourth event)) + (error condition))) + (%h2-scheduler-return-flow-credit + connection + (%h2-batch-entry-stream-id entry) + (fourth event) + clock-function + (%h2-with-scheduler-lock (connection) + (or (%h2-batch-entry-local-retired-p entry) + (%h2-batch-entry-error entry) + (%h2-batch-entry-response entry) + (fifth event))))))))))) + + (defun %h2-scheduler-entry-for-stream (connection stream-id) + (%h2-batch-entry-for-stream + (%http2-connection-scheduler-entries connection) stream-id)) + + (defun %h2-scheduler-has-non-error-entry-p (connection) + (some (lambda (entry) + (not (%h2-batch-entry-error entry))) + (%http2-connection-scheduler-entries connection))) + + (defun %h2-scheduler-remove-entry (connection entry) + (setf (%http2-connection-scheduler-entries connection) + (delete entry (%http2-connection-scheduler-entries connection) + :test #'eq))) + + (defun %h2-scheduler-close-goaway-retired-if-idle (connection) + (let ((close-p nil)) + (%h2-with-scheduler-lock (connection) + (when (and (not (%http2-connection-closed-p connection)) + (%http2-connection-goaway-last-stream-id connection) + (null (%http2-connection-scheduler-entries connection))) + (setf (%http2-connection-closed-p connection) t + close-p t) + (%h2-scheduler-broadcast connection))) + (when close-p + (http-kit::%with-http-cleanup + (funcall (%http2-connection-close-stream connection) + (%http2-connection-stream connection)))))) + + (defun %h2-scheduler-mark-response (connection entry response) + (%h2-with-scheduler-lock (connection) + (if (%h2-batch-entry-local-retired-p entry) + (setf (%h2-batch-entry-response entry) nil) + (setf (%h2-batch-entry-response entry) response)) + (when (or (%h2-batch-entry-body-sent-p entry) + (%h2-batch-entry-local-retired-p entry)) + (%h2-scheduler-remove-entry connection entry)) + (%h2-scheduler-broadcast connection))) + + (defun %h2-scheduler-mark-body-sent (connection entry) + (%h2-with-scheduler-lock (connection) + (setf (%h2-batch-entry-body-sent-p entry) t) + (when (%h2-batch-entry-response entry) + (%h2-scheduler-remove-entry connection entry)) + (%h2-scheduler-broadcast connection))) + + (defun %h2-scheduler-window-available-p (connection stream-id) + (and (plusp (%http2-connection-peer-connection-window-size connection)) + (plusp (%h2-connection-stream-window connection stream-id)))) + + (defun %h2-scheduler-capacity-available-p (connection) + (let ((limit (%http2-connection-peer-max-concurrent-streams connection))) + (and (not (eql limit 0)) + (or (null limit) + (< (count-if-not #'%h2-batch-entry-error + (%http2-connection-scheduler-entries + connection)) + limit))))) + + (defun %h2-scheduler-control-frame (connection frame writer) + (let* ((type (%h2-frame-type frame)) + (stream-id (%h2-frame-stream-id frame)) + (payload (%h2-frame-payload frame))) + (%h2-client-control-budget-check connection frame writer) + (cond + ((= type +http2-settings-type+) + (%h2-connection-note-settings connection frame writer)) + ((= type +http2-ping-type+) + (unless (and (zerop stream-id) (= (length payload) 8)) + (if (some (lambda (waiter) + (and (not (%h2-scheduler-ping-waiter-acknowledged-p + waiter)) + (not (%h2-scheduler-ping-waiter-failure waiter)))) + (%http2-connection-scheduler-ping-waiters connection)) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 PING frame is invalid." + :operation :http2-client + :detail frame) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 PING must be an eight-byte stream-zero frame." + :operation :http2-control + :detail (list stream-id (length payload))))) + (if (/= 0 (logand (%h2-frame-flags frame) +http2-ack-flag+)) + (let ((waiter + (find-if + (lambda (candidate) + (and (not (%h2-scheduler-ping-waiter-acknowledged-p + candidate)) + (equalp payload + (%h2-scheduler-ping-waiter-payload + candidate)))) + (%http2-connection-scheduler-ping-waiters connection)))) + (when waiter + (setf (%h2-scheduler-ping-waiter-acknowledged-p waiter) t))) + (%h2-send-control writer +http2-ping-type+ +http2-ack-flag+ + 0 payload))) + ((= type +http2-window-update-type+) + (when (and (plusp stream-id) + (>= stream-id (%http2-connection-next-stream-id connection))) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 WINDOW_UPDATE targeted an idle stream." + :operation :http2-control + :detail stream-id)) + (%h2-connection-note-window-update + connection frame (if (zerop stream-id) 1 stream-id)) + (%h2-handle-control-frame + frame writer (if (zerop stream-id) 1 stream-id))) + ((= type +http2-goaway-type+) + (unless (and (zerop stream-id) (>= (length payload) 8)) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 GOAWAY frame is invalid." + :operation :http2-control + :detail (list stream-id (length payload)))) + (let ((last-stream-id (%h2-u32 payload 0))) + (when (/= 0 (logand last-stream-id #x80000000)) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 GOAWAY last-stream identifier is invalid." + :operation :http2-control + :detail last-stream-id)) + (setf (%http2-connection-goaway-last-stream-id connection) + last-stream-id) + (dolist (entry + (copy-list + (%http2-connection-scheduler-entries connection))) + (when (> (%h2-batch-entry-stream-id entry) last-stream-id) + (unless (%h2-batch-entry-error entry) + (setf (%h2-batch-entry-error entry) + (make-condition + 'http-kit:http-connection-error + :message "The HTTP/2 peer rejected the active stream with GOAWAY." + :operation :http2-control + :cause (list :goaway last-stream-id + (%h2-u32 payload 4))))) + (when (%h2-batch-entry-local-retired-p entry) + (%h2-scheduler-remove-entry connection entry)))))) + ((= type +http2-rst-stream-type+) + (unless (and (plusp stream-id) (= (length payload) 4)) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 RST_STREAM frame is invalid." + :operation :http2-control + :detail (list stream-id (length payload)))) + (when (>= stream-id (%http2-connection-next-stream-id connection)) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 RST_STREAM targeted an idle stream." + :operation :http2-control + :detail stream-id)) + (let ((entry (%h2-scheduler-entry-for-stream connection stream-id))) + (when entry + (cond + ((and (null (%h2-batch-entry-error entry)) + (= (%h2-u32 payload 0) +http2-no-error+) + (%h2-batch-entry-response entry)) + (setf (%h2-batch-entry-request-body-abandoned-p entry) t)) + ((null (%h2-batch-entry-error entry)) + (setf (%h2-batch-entry-error entry) + (make-condition + 'http-kit:http-connection-error + :message "The HTTP/2 peer reset the response stream." + :operation :http2-control + :cause (list :rst-stream stream-id + (%h2-u32 payload 0)))))) + (when (%h2-batch-entry-local-retired-p entry) + (%h2-scheduler-remove-entry connection entry))))) + (t + (%h2-handle-control-frame frame writer + (max 1 (%http2-connection-next-stream-id + connection))))) + (%h2-scheduler-broadcast connection)))) + + (defun %h2-scheduler-dispatch-retired-data + (connection entry frame clock-function) + (%h2-data-payload frame) + (%h2-scheduler-return-flow-credit + connection 0 (length (%h2-frame-payload frame)) clock-function t) + (when (and entry + (/= 0 (logand (%h2-frame-flags frame) + +http2-end-stream-flag+))) + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-remove-entry connection entry) + (%h2-scheduler-broadcast connection)))) + + (defun %h2-scheduler-previously-opened-client-stream-p + (connection stream-id) + (%h2-with-scheduler-lock (connection) + (and (plusp stream-id) + (oddp stream-id) + (<= stream-id + (%http2-connection-scheduler-last-opened-stream-id connection))))) + + (defun %h2-scheduler-discard-closed-headers + (connection frame reader deadline clock-function) + (multiple-value-bind (block end-stream-p) + (%h2-batch-read-header-block + frame + (lambda () + (%h2-read-frame reader + (%http2-connection-max-frame-size connection) + deadline clock-function)) + (%http2-connection-max-frame-size connection) + (%http2-connection-max-header-bytes connection)) + (declare (ignore end-stream-p)) + (%h2-decode-header-block + block + (%http2-connection-hpack-context connection) + :max-header-bytes (%http2-connection-max-header-bytes connection) + :max-fields (%http2-connection-max-fields connection)))) + + (defun %h2-scheduler-dispatch-frame + (connection frame reader writer deadline clock-function) + (declare (ignore writer)) + (when (%http2-connection-scheduler-first-peer-frame-p connection) + (unless (and (= (%h2-frame-type frame) +http2-settings-type+) + (zerop (%h2-frame-stream-id frame)) + (zerop (logand (%h2-frame-flags frame) +http2-ack-flag+))) + (error 'http-kit:http-protocol-error + :message "The first HTTP/2 peer frame must be a non-ACK SETTINGS frame." + :operation :http2-read + :detail (list (%h2-frame-type frame) + (%h2-frame-stream-id frame) + (%h2-frame-flags frame)))) + (setf (%http2-connection-scheduler-first-peer-frame-p connection) nil)) + (let ((type (%h2-frame-type frame)) + (stream-id (%h2-frame-stream-id frame)) + (control-writer (%h2-scheduler-control-writer connection + clock-function))) + (cond + ((%h2-control-frame-p type) + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-control-frame connection frame control-writer))) + ((= type +http2-headers-type+) + (let ((entry + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-entry-for-stream connection stream-id)))) + (unless entry + (if (%h2-scheduler-previously-opened-client-stream-p + connection stream-id) + (%h2-scheduler-discard-closed-headers + connection frame reader deadline clock-function) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 scheduler received HEADERS for an unknown stream." + :operation :http2-read + :detail stream-id))) + (when entry + (when (%h2-batch-entry-response entry) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 scheduler received HEADERS after stream completion." + :operation :http2-read + :detail stream-id)) + (let* ((retired-p (%h2-batch-entry-local-retired-p entry)) + (processing-entry (copy-%h2-batch-entry entry)) + (on-information + (and (not retired-p) + (%h2-batch-entry-on-information entry)))) + (setf (%h2-batch-entry-on-information processing-entry) + (when on-information + (lambda (response) + (%h2-scheduler-queue-callback + connection entry + (list :information on-information response))))) + (multiple-value-bind (status headers response) + (%h2-batch-process-headers-frame + processing-entry frame + (lambda () + (%h2-read-frame reader + (%http2-connection-max-frame-size connection) + deadline clock-function)) + (%http2-connection-max-frame-size connection) + (%h2-batch-entry-max-header-bytes entry) + (%h2-batch-entry-max-fields entry) + (%http2-connection-hpack-context connection) + (http-kit:http-request-method + (%h2-batch-entry-request entry))) + (when status + (setf (%h2-batch-entry-status entry) status + (%h2-batch-entry-headers entry) headers)) + (when response + (if retired-p + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-remove-entry connection entry) + (%h2-scheduler-broadcast connection)) + (%h2-scheduler-mark-response + connection entry response)))))))) + ((= type +http2-data-type+) + (let ((entry nil) + (non-error-entry-p nil) + (pending-ping-p nil)) + (%h2-with-scheduler-lock (connection) + (setf entry (%h2-scheduler-entry-for-stream connection stream-id) + non-error-entry-p (%h2-scheduler-has-non-error-entry-p connection) + pending-ping-p + (some (lambda (waiter) + (and (not (%h2-scheduler-ping-waiter-acknowledged-p waiter)) + (not (%h2-scheduler-ping-waiter-failure waiter)))) + (%http2-connection-scheduler-ping-waiters connection)))) + (unless entry + (if (%h2-scheduler-previously-opened-client-stream-p + connection stream-id) + (if (and pending-ping-p (not non-error-entry-p)) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 PING received an unexpected frame." + :operation :http2-client + :detail frame) + (%h2-scheduler-dispatch-retired-data + connection nil frame clock-function)) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 scheduler received DATA for an unknown stream." + :operation :http2-read + :detail (if non-error-entry-p + stream-id + (list type stream-id))))) + (when entry + (if (%h2-batch-entry-local-retired-p entry) + (%h2-scheduler-dispatch-retired-data + connection entry frame clock-function) + (progn + (when (%h2-batch-entry-response entry) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 scheduler received DATA after stream completion." + :operation :http2-read + :detail stream-id)) + (let* ((callback (%h2-batch-entry-on-body-chunk entry)) + (callback-queued-p nil) + (flow-controlled-length + (length (%h2-frame-payload frame))) + (body-vector (%h2-batch-entry-body-vector entry)) + (collect-body-p (%h2-batch-entry-collect-body-p entry)) + (queue-callback + (when callback + (lambda (payload) + (setf callback-queued-p + (%h2-scheduler-queue-callback + connection entry + (list :body callback payload flow-controlled-length + (/= 0 (logand (%h2-frame-flags frame) + +http2-end-stream-flag+))))))))) + (multiple-value-bind (end-stream-p body-length payload-length) + (%h2-append-data-frame* + frame + (%h2-batch-entry-status entry) + body-vector + (%h2-batch-entry-body-length entry) + (http-kit:http-request-method + (%h2-batch-entry-request entry)) + (%h2-batch-entry-max-body-bytes entry) + queue-callback + collect-body-p + stream-id) + (let ((retired-p + (%h2-with-scheduler-lock (connection) + (or (%h2-batch-entry-local-retired-p entry) + (%h2-batch-entry-error entry))))) + (if retired-p + (when collect-body-p + (setf (fill-pointer body-vector) 0)) + (setf (%h2-batch-entry-body-length entry) body-length)) + (unless callback-queued-p + (%h2-with-scheduler-lock (connection) + (unless (%http2-connection-closed-p connection) + (%h2-scheduler-return-flow-credit + connection stream-id payload-length clock-function + (or retired-p end-stream-p)))))) + (when end-stream-p + (%h2-scheduler-mark-response + connection entry + (%h2-finish-request-response + (%h2-batch-entry-status entry) + (%h2-batch-entry-headers entry) + nil + body-vector + (http-kit:http-request-method + (%h2-batch-entry-request entry)) + :body-length body-length)))))))))) + ((= type +http2-continuation-type+) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 CONTINUATION arrived without HEADERS." + :operation :http2-headers + :detail stream-id)) + ((= type +http2-push-promise-type+) + (error 'http-kit:http-protocol-error + :message "The peer sent HTTP/2 PUSH_PROMISE after server push was disabled." + :operation :http2-read + :detail :protocol-error)) + (t nil)))) + + (defun %h2-scheduler-pump-until + (connection predicate reader writer deadline clock-function) + (loop + (when (%h2-with-scheduler-lock (connection) + (or (%http2-connection-closed-p connection) + (funcall predicate))) + (return)) + (let ((frame (%h2-read-frame + reader (%http2-connection-max-frame-size connection) + deadline clock-function))) + (when (eq frame :eof) + (error 'http-kit:http-connection-error + :message "The HTTP/2 peer closed during a scheduled request." + :operation :http2-read + :cause :eof)) + (%h2-scheduler-dispatch-frame + connection frame reader writer deadline clock-function)))) + + (defun %h2-scheduler-wait-until + (connection predicate reader writer deadline clock-function + &optional entry) + (handler-case + (loop + (http-kit::%check-deadline deadline clock-function :read) + (let ((run-pump-p nil) + (finished-p nil)) + (%h2-with-scheduler-lock (connection) + (setf finished-p + (or (%http2-connection-closed-p connection) + (funcall predicate))) + (unless finished-p + (if (%http2-connection-scheduler-reader-active-p connection) + (%h2-scheduler-condition-wait + connection deadline clock-function) + (setf (%http2-connection-scheduler-reader-active-p connection) + t + run-pump-p t)))) + (when finished-p + (return)) + (when run-pump-p + (unwind-protect + (handler-case + (%h2-scheduler-pump-until + connection predicate reader writer deadline clock-function) + (http-kit:http-timeout (condition) + (when entry + (%h2-scheduler-retire-entry + connection entry condition clock-function)) + (error condition)) + (error (condition) + (%h2-scheduler-fail-connection connection condition) + (error condition))) + (%h2-with-scheduler-lock (connection) + (setf (%http2-connection-scheduler-reader-active-p connection) + nil) + (%h2-scheduler-broadcast connection)))))) + (http-kit:http-timeout (condition) + (when entry + (%h2-scheduler-retire-entry + connection entry condition clock-function)) + (error condition)))) + + (defun %h2-scheduler-ping + (connection payload deadline clock-function) + (let* ((reader (%h2-reader-for (%http2-connection-stream connection))) + (writer (%h2-scheduler-writer connection deadline clock-function)) + (waiter (%make-h2-scheduler-ping-waiter payload))) + (%h2-with-scheduler-lock (connection) + (unless (http2-connection-open-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection closed before PING." + :operation :http2-control + :cause :closed)) + (push waiter (%http2-connection-scheduler-ping-waiters connection))) + (unwind-protect + (progn + (handler-case + (progn + (handler-case + (%h2-send-control writer +http2-ping-type+ 0 0 payload) + (error (condition) + (let ((failure + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-ping-waiter-failure waiter)))) + (error (or failure condition))))) + (%h2-scheduler-wait-until + connection + (lambda () + (%h2-scheduler-ping-waiter-acknowledged-p waiter)) + reader writer deadline clock-function) + (let ((failure + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-ping-waiter-failure waiter)))) + (when failure + (error failure)))) + (http-kit:http-connection-error (condition) + (if (and (eq :http2-read (http-kit:http-error-operation condition)) + (eq :eof (http-kit:http-connection-error-cause condition))) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 peer closed while awaiting PING ACK." + :operation :http2-client + :detail :eof) + (error condition)))) + (%h2-with-scheduler-lock (connection) + (unless (http2-connection-open-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection closed while awaiting PING ACK." + :operation :http2-control + :cause :closed)) + payload)) + (%h2-with-scheduler-lock (connection) + (setf (%http2-connection-scheduler-ping-waiters connection) + (delete waiter + (%http2-connection-scheduler-ping-waiters connection) + :test #'eq)) + (%h2-scheduler-broadcast connection))))) + + (defun %h2-scheduler-wait-for-window + (connection stream-id deadline clock-function) + (let ((reader (%h2-reader-for (%http2-connection-stream connection))) + (writer (%h2-scheduler-writer connection deadline clock-function))) + (loop + (let ((entry (%h2-with-scheduler-lock (connection) + (%h2-scheduler-entry-for-stream connection stream-id)))) + (%h2-scheduler-wait-until + connection + (lambda () + (let ((active-entry + (%h2-scheduler-entry-for-stream connection stream-id))) + (or (null active-entry) + (%h2-batch-entry-error active-entry) + (%h2-batch-entry-request-body-abandoned-p active-entry) + (%h2-batch-entry-callback-events active-entry) + (%h2-scheduler-window-available-p connection stream-id)))) + reader writer deadline clock-function entry) + (when entry + (%h2-scheduler-run-entry-callbacks + connection entry clock-function)) + (%h2-with-scheduler-lock (connection) + (let ((active-entry + (%h2-scheduler-entry-for-stream connection stream-id))) + (let ((entry-error + (or (and entry (%h2-batch-entry-error entry)) + (and active-entry + (%h2-batch-entry-error active-entry))))) + (when entry-error + (error entry-error))) + (when (and active-entry + (%h2-batch-entry-request-body-abandoned-p active-entry)) + (return-from %h2-scheduler-wait-for-window nil)) + (when (or (%http2-connection-closed-p connection) + (null active-entry)) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection closed while request flow control was blocked." + :operation :http2-write + :cause :closed)) + (when (%h2-scheduler-window-available-p connection stream-id) + (return)))))))) + + (defun %h2-scheduler-wait-for-capacity + (connection reader writer deadline clock-function) + (%h2-scheduler-wait-until + connection + (lambda () + (or (%http2-connection-goaway-last-stream-id connection) + (%h2-scheduler-capacity-available-p connection))) + reader writer deadline clock-function) + (%h2-with-scheduler-lock (connection) + (when (%http2-connection-goaway-last-stream-id connection) + (%h2-connection-next-stream-id connection)) + (unless (%h2-scheduler-capacity-available-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection closed while streams were paused." + :operation :http2-write + :cause :closed)))) + + (defun %h2-scheduler-fail-connection (connection condition) + (let ((close-p nil)) + (%h2-with-scheduler-lock (connection) + (unless (%http2-connection-closed-p connection) + (setf (%http2-connection-closed-p connection) t + close-p t)) + (dolist (entry (%http2-connection-scheduler-entries connection)) + (unless (%h2-batch-entry-error entry) + (setf (%h2-batch-entry-error entry) condition))) + (dolist (waiter (%http2-connection-scheduler-ping-waiters connection)) + (unless (or (%h2-scheduler-ping-waiter-acknowledged-p waiter) + (%h2-scheduler-ping-waiter-failure waiter)) + (setf (%h2-scheduler-ping-waiter-failure waiter) condition))) + (setf (%http2-connection-scheduler-entries connection) nil) + (%h2-scheduler-broadcast connection)) + (when close-p + (http-kit::%with-http-cleanup + (funcall (%http2-connection-close-stream connection) + (%http2-connection-stream connection)))))) + + (defun %h2-scheduler-open-entry + (connection request body-function body-length header-limit field-limit + body-limit deadline clock-function huffman-p on-body-chunk + on-information collect-body-p reader writer) + (loop + (unless (%h2-with-scheduler-lock (connection) + (%h2-scheduler-capacity-available-p connection)) + (%h2-scheduler-wait-for-capacity + connection reader writer deadline clock-function)) + (let ((entry nil)) + (%h2-with-scheduler-lock (connection) + (unless (http2-connection-open-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection is closed." + :operation :http2-client + :cause :closed)) + (when (%h2-scheduler-capacity-available-p connection) + (let ((session-started-p + (%http2-connection-session-started-p connection))) + (when (and (http-kit:http-request-protocol request) + (not session-started-p)) + (%h2-connection-start-for-extended-connect + connection reader writer deadline clock-function) + (setf session-started-p t + (%http2-connection-scheduler-first-peer-frame-p + connection) nil)) + (when (and (http-kit:http-request-protocol request) + (not (%http2-connection-peer-enable-connect-protocol-p + connection))) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 peer did not enable extended CONNECT." + :operation :http2-write + :detail :protocol-error)) + (let* ((stream-id (%h2-connection-next-stream-id connection)) + (header-wire nil) + (body nil) + (outgoing-frame-size nil) + (expected-body-length nil) + (trailer-fields nil)) + (multiple-value-setq + (header-wire body outgoing-frame-size + expected-body-length trailer-fields) + (%h2-request-header-wire + request + (%http2-connection-max-frame-size connection) + header-limit body-limit + :stream-id stream-id + :include-session-p (not session-started-p) + :peer-max-frame-size + (%http2-connection-peer-max-frame-size connection) + :peer-max-header-list-size + (%http2-connection-peer-max-header-list-size connection) + :request-body-function body-function + :request-body-length body-length + :huffman-p huffman-p)) + (setf entry + (%make-h2-batch-entry + :request request + :stream-id stream-id + :body body + :request-body-function body-function + :expected-body-length expected-body-length + :outgoing-frame-size outgoing-frame-size + :trailer-fields trailer-fields + :max-header-bytes header-limit + :max-fields field-limit + :max-body-bytes body-limit + :on-body-chunk on-body-chunk + :on-information on-information + :collect-body-p collect-body-p + :deadline deadline + :clock-function clock-function)) + (push entry (%http2-connection-scheduler-entries connection)) + (incf (%http2-connection-next-stream-id connection) 2) + (handler-case + (funcall writer header-wire) + (http-kit:http-timeout (condition) + (%h2-scheduler-remove-entry connection entry) + (%h2-scheduler-broadcast connection) + (error condition)) + (error (condition) + (%h2-scheduler-remove-entry connection entry) + (%h2-scheduler-broadcast connection) + (error condition))) + (setf (%http2-connection-scheduler-last-opened-stream-id + connection) + stream-id + (%http2-connection-session-started-p connection) t))))) + (when entry + (return entry))))) + + (defun %h2-send-http2-request-over-connection-scheduled + (connection request + &key timeout deadline max-header-bytes max-fields max-body-bytes + clock-function request-body-function request-body-length + on-body-chunk on-information on-stream-open + (collect-body-p t) (huffman-p nil)) + (unless (http2-connection-p connection) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 request requires an HTTP2-CONNECTION." + :operation :http2-client + :detail (type-of connection))) + (unless (http2-connection-open-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection is closed." + :operation :http2-client + :cause :closed)) + (http-kit::%check-http-request request) + (%h2-validate-request-body-options + request request-body-function request-body-length) + (when (and on-body-chunk (not (functionp on-body-chunk))) + (error 'http-kit:http-protocol-error + :message "ON-BODY-CHUNK must be a function or NIL." + :operation :http2-client + :detail on-body-chunk)) + (when (and on-information (not (functionp on-information))) + (error 'http-kit:http-protocol-error + :message "ON-INFORMATION must be a function or NIL." + :operation :http2-client + :detail on-information)) + (when (and on-stream-open (not (functionp on-stream-open))) + (error 'http-kit:http-protocol-error + :message "ON-STREAM-OPEN must be a function or NIL." + :operation :http2-client + :detail on-stream-open)) + (unless (member collect-body-p '(nil t)) + (error 'http-kit:http-protocol-error + :message "COLLECT-BODY-P must be NIL or T." + :operation :http2-client + :detail collect-body-p)) + (let* ((clock (or clock-function + (%http2-connection-clock-function connection))) + (header-limit + (min (or max-header-bytes + (%http2-connection-max-header-bytes connection)) + (%http2-connection-max-header-bytes connection))) + (field-limit (min (or max-fields most-positive-fixnum) + (%http2-connection-max-fields connection))) + (body-limit + (min (or max-body-bytes + (%http2-connection-max-body-bytes connection)) + (%http2-connection-max-body-bytes connection))) + (reader (%h2-reader-for (%http2-connection-stream connection))) + (entry nil)) + (unless (functionp clock) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 request clock must be callable." + :operation :http2-client + :detail clock)) + (http-kit:with-http-deadline (absolute-deadline timeout + :inherited deadline + :clock-function clock) + (%h2-validate-limit :max-header-bytes header-limit) + (%h2-validate-limit :max-fields field-limit) + (%h2-validate-limit :max-body-bytes body-limit :allow-zero t) + (http-kit::%with-http-error-translation + ("The HTTP/2 connection request failed." :http2-connection) + (handler-case + (let ((writer (%h2-scheduler-writer + connection absolute-deadline clock))) + (setf entry + (%h2-scheduler-open-entry + connection request request-body-function + request-body-length header-limit field-limit body-limit + absolute-deadline clock huffman-p on-body-chunk + on-information collect-body-p reader writer)) + (when on-stream-open + (funcall on-stream-open + (%h2-batch-entry-stream-id entry) + (lambda (&rest cancel-arguments) + (apply (lambda (&key error-code) error-code) + cancel-arguments) + (cancel-http2-stream + connection (%h2-batch-entry-stream-id entry) + :error-code (getf cancel-arguments :error-code 8) + :deadline absolute-deadline + :clock-function clock)))) + (let ((entry-error + (%h2-with-scheduler-lock (connection) + (%h2-batch-entry-error entry)))) + (when entry-error + (error entry-error))) + (%h2-connection-send-request-body + connection reader writer + (%h2-batch-entry-stream-id entry) + (%h2-batch-entry-body entry) + request-body-function + (%h2-batch-entry-expected-body-length entry) + body-limit + (%h2-batch-entry-outgoing-frame-size entry) + (%h2-batch-entry-trailer-fields entry) + absolute-deadline clock nil huffman-p + :scheduler-p t + :flow-wait-function #'%h2-scheduler-wait-for-window + :scheduler-entry entry) + (%h2-scheduler-mark-body-sent connection entry) + (loop + (%h2-scheduler-wait-until + connection + (lambda () (%h2-scheduler-entry-ready-p entry)) + reader writer absolute-deadline clock entry) + (%h2-scheduler-run-entry-callbacks + connection entry clock) + (let ((response + (%h2-with-scheduler-lock (connection) + (when (%h2-batch-entry-error entry) + (error (%h2-batch-entry-error entry))) + (when (%http2-connection-closed-p connection) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection closed before the response completed." + :operation :http2-read + :cause :closed)) + (when (and (%h2-batch-entry-response entry) + (%h2-batch-entry-body-sent-p entry) + (null (%h2-batch-entry-callback-events entry))) + (%h2-batch-entry-response entry))))) + (when response + (return response))))) + (error (condition) + (let ((timeout-p (typep condition 'http-kit:http-timeout)) + (peer-reset-p + (%h2-peer-stream-reset-condition-p condition))) + (when entry + (cond + (timeout-p + (%h2-scheduler-retire-entry + connection entry condition clock)) + (peer-reset-p + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-remove-entry connection entry))) + ((%h2-batch-entry-local-retired-p entry) + nil) + (t + (%h2-with-scheduler-lock (connection) + (%h2-scheduler-remove-entry connection entry))))) + (%h2-scheduler-close-goaway-retired-if-idle connection) + (unless (or timeout-p peer-reset-p + (and entry (%h2-batch-entry-local-retired-p entry))) + (%h2-scheduler-fail-connection connection condition)) + (error condition))))))) +) + +(defun send-http2-request-over-connection + (connection request + &key timeout deadline max-header-bytes max-fields max-body-bytes + clock-function request-body-function request-body-length + on-body-chunk on-information on-stream-open + (collect-body-p t) (huffman-p nil)) + #+sbcl + (%h2-send-http2-request-over-connection-scheduled + connection request + :timeout timeout + :deadline deadline + :max-header-bytes max-header-bytes + :max-fields max-fields + :max-body-bytes max-body-bytes + :clock-function clock-function + :request-body-function request-body-function + :request-body-length request-body-length + :on-body-chunk on-body-chunk + :on-information on-information + :on-stream-open on-stream-open + :collect-body-p collect-body-p + :huffman-p huffman-p) + #-sbcl + (%h2-send-http2-request-over-connection-serial + connection request + :timeout timeout + :deadline deadline + :max-header-bytes max-header-bytes + :max-fields max-fields + :max-body-bytes max-body-bytes + :clock-function clock-function + :request-body-function request-body-function + :request-body-length request-body-length + :on-body-chunk on-body-chunk + :on-information on-information + :on-stream-open on-stream-open + :collect-body-p collect-body-p + :huffman-p huffman-p)) + (defun %h2-batch-list-length (value) (handler-case (list-length value) (type-error () nil))) @@ -1240,12 +2425,16 @@ sent in successive multiplexed waves under the same deadline." :detail collect-body-p)) (let* ((clock (or clock-function (%http2-connection-clock-function connection))) - (header-limit (or max-header-bytes - (%http2-connection-max-header-bytes connection))) + (header-limit + (min (or max-header-bytes + (%http2-connection-max-header-bytes connection)) + (%http2-connection-max-header-bytes connection))) (field-limit (min (or max-fields most-positive-fixnum) (%http2-connection-max-fields connection))) - (body-limit (or max-body-bytes - (%http2-connection-max-body-bytes connection)))) + (body-limit + (min (or max-body-bytes + (%http2-connection-max-body-bytes connection)) + (%http2-connection-max-body-bytes connection)))) (http-kit:with-http-deadline (absolute-deadline timeout :inherited deadline :clock-function clock) @@ -1351,7 +2540,11 @@ sent in successive multiplexed waves under the same deadline." header-writes (nreverse header-writes)) (dolist (write header-writes) (%h2-write-wire (%http2-connection-stream connection) - (first write) absolute-deadline clock)) + (first write) absolute-deadline clock) + (%h2-with-scheduler-lock (connection) + (setf (%http2-connection-scheduler-last-opened-stream-id connection) + (max (%http2-connection-scheduler-last-opened-stream-id connection) + (third write))))) (let ((pending-head nil) (pending-tail nil) (first-settings-p (not session-started-p)) @@ -1393,7 +2586,9 @@ sent in successive multiplexed waves under the same deadline." :detail (list (%h2-frame-type frame) (%h2-frame-stream-id frame) (%h2-frame-flags frame)))) - (setf first-settings-p nil)) + (setf first-settings-p nil + (%http2-connection-session-started-p connection) t + (%http2-connection-scheduler-first-peer-frame-p connection) nil)) frame)) (next-frame () (or (dequeue) (read-network-frame))) @@ -1564,8 +2759,9 @@ sent in successive multiplexed waves under the same deadline." collect-body-p stream-id) (setf (%h2-batch-entry-body-length entry) new-body-length) - (%h2-send-window-update writer stream-id - payload-length) + (unless end-stream-p + (%h2-send-window-update writer stream-id + payload-length)) (%h2-send-window-update writer 0 payload-length) (when end-stream-p @@ -1595,8 +2791,14 @@ sent in successive multiplexed waves under the same deadline." (setf (%http2-connection-session-started-p connection) t) (mapcar #'%h2-batch-entry-response entries))) (error (condition) - (unless (%h2-peer-stream-reset-condition-p condition) - (close-http2-connection connection)) + (let ((stream-reset-p + (and (%h2-peer-stream-reset-condition-p condition) + (eq (first + (http-kit:http-connection-error-cause + condition)) + :rst-stream)))) + (unless stream-reset-p + (close-http2-connection connection))) (error condition)))))))) (defun send-http2-requests-over-connection/cps diff --git a/http2/transport-declarations.lisp b/http2/transport-declarations.lisp index dcd14596..137ac56b 100644 --- a/http2/transport-declarations.lisp +++ b/http2/transport-declarations.lisp @@ -59,7 +59,18 @@ (closed-p nil) (max-control-frames 100) (max-control-window 1.0d0) - (control-frame-times nil)) + (control-frame-times nil) + #+sbcl (scheduler-lock (sb-thread:make-mutex :name "HTTP/2 scheduler")) + #-sbcl (scheduler-lock nil) + #+sbcl (writer-lock (sb-thread:make-mutex :name "HTTP/2 writer")) + #-sbcl (writer-lock nil) + #+sbcl (scheduler-condition (sb-thread:make-waitqueue)) + #-sbcl (scheduler-condition nil) + (scheduler-reader-active-p nil) + (scheduler-first-peer-frame-p t) + (scheduler-last-opened-stream-id 0) + (scheduler-ping-waiters nil) + (scheduler-entries nil)) (defun http2-connection-open-p (connection) (and (http2-connection-p connection) diff --git a/http2/transport-manager.lisp b/http2/transport-manager.lisp index fa8cced7..115d0934 100644 --- a/http2/transport-manager.lisp +++ b/http2/transport-manager.lisp @@ -3,7 +3,7 @@ (defstruct (%http2-managed-connection (:constructor %make-http2-managed-connection (&key key connection opened-at last-used last-used-at - active-count transient-p retired-p close-started-p))) + active-count transient-p exclusive-p retired-p close-started-p))) key connection opened-at @@ -11,27 +11,35 @@ last-used-at (active-count 0) transient-p + exclusive-p retired-p close-started-p) -(defstruct (http2-connection-manager - (:conc-name %http2-connection-manager-) - (:constructor %make-http2-connection-manager - (&key open-connection max-connections idle-timeout - max-connection-age clock-function on-evict - on-transient-close lock))) - open-connection - max-connections - idle-timeout - max-connection-age - clock-function - on-evict - on-transient-close - lock - (entries nil) - (sequence 0) - (clear-generation 0) - (closed-p nil)) +(progn + (defstruct (%h2-manager-opening + (:constructor %make-h2-manager-opening (owner waitqueue))) + owner + waitqueue) + + (defstruct (http2-connection-manager + (:conc-name %http2-connection-manager-) + (:constructor %make-http2-connection-manager + (&key open-connection max-connections idle-timeout + max-connection-age clock-function on-evict + on-transient-close lock))) + open-connection + max-connections + idle-timeout + max-connection-age + clock-function + on-evict + on-transient-close + lock + (entries nil) + (openings (make-hash-table :test #'equal)) + (sequence 0) + (clear-generation 0) + (closed-p nil))) #+sbcl (defun %h2-manager-make-lock () @@ -58,11 +66,14 @@ OPEN-CONNECTION receives the request and must return an HTTP2-CONNECTION. The manager always passes TIMEOUT and DEADLINE; proxy-routed requests also pass PROXY-PLAN and PROXY. By default, the cache key includes the request scheme, host, port, proxy plan, and proxy. MAX-CONNECTIONS bounds retained cache -entries, not transient connections. A request for a key whose retained -connection is busy uses a request-scoped connection. At capacity, if every -retained entry is busy, requests for other keys also use request-scoped -connections. Otherwise a new key can use a newly retained entry or replace -the least-recently-used idle entry. +entries, not total open connections; request-scoped connections do not count +toward it. Concurrent single-request calls for the same key share a retained +connection. Its scheduler assigns streams and enforces peer concurrent-stream +and flow-control limits. A batch call holds an exclusive lease because the +batch operation is cooperative rather than thread-safe. If an incompatible +operation is already using the same key, the manager uses a request-scoped +connection. At capacity, requests for other keys use a request-scoped +connection when every retained entry is active. IDLE-TIMEOUT retires entries after the configured time without a completed manager call. MAX-CONNECTION-AGE retires entries after the configured time from @@ -81,10 +92,9 @@ from either callback propagate after required close and retirement actions have been attempted. OPEN-CONNECTION, CLOCK-FUNCTION, and both callbacks may run concurrently with other manager calls, so they must synchronize shared state they use. Errors from OPEN-CONNECTION and CLOCK-FUNCTION propagate to the call. -On SBCL, manager operations protect entry state for concurrent callers, and a -retained connection is leased to at most one manager call at a time. Use -SEND-HTTP2-REQUESTS-OVER-CONNECTION-MANAGER when one manager call needs several -concurrent streams on that connection. Use CLEAR-HTTP2-CONNECTION-MANAGER to +On SBCL, manager operations protect entry state for concurrent callers. Use +SEND-HTTP2-REQUESTS-OVER-CONNECTION-MANAGER when one manager call needs a batch +of concurrent streams on one connection. Use CLEAR-HTTP2-CONNECTION-MANAGER to clear retained entries while keeping the manager usable; CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." (unless (functionp open-connection) @@ -286,11 +296,14 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." (setf actions (%h2-manager-prune-locked manager now))) (%h2-manager-run-retirements manager actions))) -(defun %h2-manager-entry-for-key-locked (manager key) +(defun %h2-manager-entry-for-key-locked + (manager key &optional share-active-p) (reduce (lambda (latest entry) (if (and (equal key (%http2-managed-connection-key entry)) - (zerop (%http2-managed-connection-active-count entry)) - (%h2-manager-entry-usable-p entry)) + (%h2-manager-entry-usable-p entry) + (or (zerop (%http2-managed-connection-active-count entry)) + (and share-active-p + (not (%http2-managed-connection-exclusive-p entry))))) (if (or (null latest) (> (%http2-managed-connection-last-used entry) (%http2-managed-connection-last-used latest))) @@ -318,32 +331,34 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." (%http2-connection-manager-entries manager)) :initial-value nil)) -(defun %h2-manager-select-entry (manager key now) +(defun %h2-manager-select-entry (manager key now &optional (share-active-p nil)) (%h2-manager-with-lock (manager) - (when (%http2-connection-manager-closed-p manager) - (error 'http-kit:http-connection-error - :message "The HTTP/2 connection manager is closed." - :operation :http2-manager - :cause :closed)) - (let ((entry (%h2-manager-entry-for-key-locked manager key)) - (same-key (%h2-manager-same-key-entry-locked manager key)) - (actions nil) - (request-scoped-p nil)) - (cond - (entry - (incf (%http2-managed-connection-active-count entry)) - (%h2-manager-touch-locked manager entry now)) - (same-key - (setf request-scoped-p t)) - ((>= (length (%http2-connection-manager-entries manager)) - (%http2-connection-manager-max-connections manager)) - (let ((oldest (%h2-manager-oldest-idle-entry-locked manager))) - (if oldest - (setf actions - (list (%h2-manager-retire-entry-locked manager oldest))) - (setf request-scoped-p t))))) - (values entry request-scoped-p actions - (%http2-connection-manager-clear-generation manager))))) + (when (%http2-connection-manager-closed-p manager) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection manager is closed." + :operation :http2-manager + :cause :closed)) + (let ((entry (%h2-manager-entry-for-key-locked manager key share-active-p)) + (same-key (%h2-manager-same-key-entry-locked manager key)) + (actions nil) + (request-scoped-p nil)) + (cond + (entry + (incf (%http2-managed-connection-active-count entry)) + (setf (%http2-managed-connection-exclusive-p entry) + (not share-active-p)) + (%h2-manager-touch-locked manager entry now)) + (same-key + (setf request-scoped-p t)) + ((>= (length (%http2-connection-manager-entries manager)) + (%http2-connection-manager-max-connections manager)) + (let ((oldest (%h2-manager-oldest-idle-entry-locked manager))) + (if oldest + (setf actions + (list (%h2-manager-retire-entry-locked manager oldest))) + (setf request-scoped-p t))))) + (values entry request-scoped-p actions + (%http2-connection-manager-clear-generation manager))))) (defun %h2-manager-open-connection (manager request timeout deadline proxy-plan proxy) @@ -359,7 +374,7 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." :timeout timeout :deadline deadline))) -(defun %h2-manager-new-entry (key connection now transient-p) +(defun %h2-manager-new-entry (key connection now transient-p exclusive-p) (%make-http2-managed-connection :key key :connection connection @@ -367,110 +382,253 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." :last-used 0 :last-used-at now :active-count 1 - :transient-p transient-p)) + :transient-p transient-p + :exclusive-p exclusive-p)) -(defun %h2-manager-connection-for - (manager request connection-key connection-key-supplied-p timeout deadline - proxy-plan proxy) - (unless (http2-connection-manager-p manager) - (error 'http-kit:http-protocol-error - :message "An HTTP/2 request requires an HTTP2-CONNECTION-MANAGER." - :operation :http2-manager - :detail (type-of manager))) - (http-kit::%check-http-request request) - (let ((key (if connection-key-supplied-p - connection-key - (%h2-manager-request-key request proxy-plan proxy)))) - (%h2-manager-prune manager) - (multiple-value-bind (entry request-scoped-p actions clear-generation) - (%h2-manager-select-entry manager key (%h2-manager-now manager)) - (%h2-manager-run-retirements manager actions) - (when entry - (return-from %h2-manager-connection-for - (values (%http2-managed-connection-connection entry) entry))) - (let ((connection - (%h2-manager-open-connection - manager request timeout deadline proxy-plan proxy))) - (unless (http2-connection-p connection) - (error 'http-kit:http-protocol-error - :message "The HTTP/2 manager open callback returned a non-connection." - :operation :http2-manager - :detail (type-of connection))) - (let ((close-new-p t) - (result-entry nil) - (result-connection nil) - (closed-during-open-p nil) - (retirement-actions nil)) - (unwind-protect - (let ((opened-at (%h2-manager-now manager))) - (%h2-manager-prune manager) - (%h2-manager-with-lock (manager) - (if (%http2-connection-manager-closed-p manager) - (setf closed-during-open-p t) - (let ((existing - (%h2-manager-entry-for-key-locked - manager key)) - (same-key - (%h2-manager-same-key-entry-locked - manager key)) - (transient-p - (or request-scoped-p - (/= clear-generation - (%http2-connection-manager-clear-generation - manager))))) - (cond - (existing - (incf - (%http2-managed-connection-active-count - existing)) - (%h2-manager-touch-locked - manager existing opened-at) - (setf result-entry existing - result-connection - (%http2-managed-connection-connection - existing))) - (same-key - (setf transient-p t)) - ((>= - (length - (%http2-connection-manager-entries manager)) - (%http2-connection-manager-max-connections - manager)) - (let ((oldest - (%h2-manager-oldest-idle-entry-locked - manager))) - (if oldest - (setf retirement-actions - (list - (%h2-manager-retire-entry-locked - manager oldest))) - (setf transient-p t))))) - (unless result-entry - (setf result-entry - (%h2-manager-new-entry - key connection opened-at transient-p) - result-connection connection) - (unless transient-p - (push result-entry - (%http2-connection-manager-entries - manager))) - (%h2-manager-touch-locked - manager result-entry opened-at))))) - (when closed-during-open-p - (error 'http-kit:http-connection-error - :message "The HTTP/2 connection manager is closed." - :operation :http2-manager - :cause :closed)) - (setf close-new-p (not (eq result-connection connection))) - (handler-case - (%h2-manager-run-retirements - manager retirement-actions) - (error (condition) - (%h2-manager-finish-entry manager result-entry) - (error condition))) - (values result-connection result-entry)) - (when close-new-p - (%h2-manager-close-connection connection)))))))) +(progn + #+sbcl + (defun %h2-manager-claim-opening (manager key) + (%h2-manager-with-lock (manager) + (when (%http2-connection-manager-closed-p manager) + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection manager is closed." + :operation :http2-manager + :cause :closed)) + (multiple-value-bind (opening present-p) + (gethash key (%http2-connection-manager-openings manager)) + (if present-p + (values opening + nil + (eq (%h2-manager-opening-owner opening) + sb-thread:*current-thread*)) + (let ((opening + (%make-h2-manager-opening + sb-thread:*current-thread* + (sb-thread:make-waitqueue + :name "HTTP/2 manager cold open")))) + (setf (gethash key (%http2-connection-manager-openings manager)) + opening) + (values opening t nil)))))) + + #-sbcl + (defun %h2-manager-claim-opening (manager key) + (declare (ignore manager key)) + (values nil t nil)) + + #+sbcl + (defun %h2-manager-release-opening (manager key opening) + (%h2-manager-with-lock (manager) + (when (eq (gethash key (%http2-connection-manager-openings manager)) + opening) + (remhash key (%http2-connection-manager-openings manager)) + (sb-thread:condition-broadcast + (%h2-manager-opening-waitqueue opening)))) + opening) + #+sbcl + (defun %h2-manager-recover-wait-lock (lock) + (unless (sb-thread:holding-mutex-p lock) + (sb-sys:without-interrupts + (sb-sys:allow-with-interrupts + (sb-thread:grab-mutex lock))))) + + #-sbcl + (defun %h2-manager-release-opening (manager key opening) + (declare (ignore manager key)) + opening) + + #+sbcl + (defun %h2-manager-wait-for-opening + (manager key opening deadline clock-function) + (let ((lock (%http2-connection-manager-lock manager))) + (sb-thread:with-mutex (lock) + (loop while (and + (eq (gethash key + (%http2-connection-manager-openings manager)) + opening) + (not (%http2-connection-manager-closed-p manager))) + do (http-kit::%check-deadline deadline clock-function :read) + (sb-thread:condition-wait + (%h2-manager-opening-waitqueue opening) + lock + :timeout (and deadline + (max 0 (- deadline + (funcall clock-function))))) + (%h2-manager-recover-wait-lock lock) + (http-kit::%check-deadline deadline clock-function :read)))) + opening) + + #-sbcl + (defun %h2-manager-wait-for-opening + (manager key opening deadline clock-function) + (declare (ignore manager key deadline clock-function)) + opening) + + #+sbcl + (defun %h2-manager-broadcast-openings-locked (manager) + (maphash (lambda (key opening) + (declare (ignore key)) + (sb-thread:condition-broadcast + (%h2-manager-opening-waitqueue opening))) + (%http2-connection-manager-openings manager))) + + #-sbcl + (defun %h2-manager-broadcast-openings-locked (manager) + (declare (ignore manager)) + nil) + + (defun %h2-manager-open-entry + (manager request key timeout deadline proxy-plan proxy share-active-p + request-scoped-p clear-generation) + (let ((connection + (%h2-manager-open-connection + manager request timeout deadline proxy-plan proxy))) + (unless (http2-connection-p connection) + (error 'http-kit:http-protocol-error + :message "The HTTP/2 manager open callback returned a non-connection." + :operation :http2-manager + :detail (type-of connection))) + (let ((close-new-p t) + (result-entry nil) + (result-connection nil) + (closed-during-open-p nil) + (retirement-actions nil)) + (unwind-protect + (let ((opened-at (%h2-manager-now manager))) + (%h2-manager-prune manager) + (%h2-manager-with-lock (manager) + (if (%http2-connection-manager-closed-p manager) + (setf closed-during-open-p t) + (let ((existing + (%h2-manager-entry-for-key-locked + manager key share-active-p)) + (same-key + (%h2-manager-same-key-entry-locked manager key)) + (transient-p + (or request-scoped-p + (/= clear-generation + (%http2-connection-manager-clear-generation + manager))))) + (cond + (existing + (incf + (%http2-managed-connection-active-count existing)) + (setf (%http2-managed-connection-exclusive-p existing) + (not share-active-p)) + (%h2-manager-touch-locked manager existing opened-at) + (setf result-entry existing + result-connection + (%http2-managed-connection-connection existing))) + (same-key + (setf transient-p t)) + ((>= (length + (%http2-connection-manager-entries manager)) + (%http2-connection-manager-max-connections manager)) + (let ((oldest + (%h2-manager-oldest-idle-entry-locked manager))) + (if oldest + (setf retirement-actions + (list + (%h2-manager-retire-entry-locked + manager oldest))) + (setf transient-p t)))) + ) + (unless result-entry + (setf result-entry + (%h2-manager-new-entry + key connection opened-at transient-p + (not share-active-p)) + result-connection connection) + (unless transient-p + (push result-entry + (%http2-connection-manager-entries manager))) + (%h2-manager-touch-locked + manager result-entry opened-at))))) + (when closed-during-open-p + (error 'http-kit:http-connection-error + :message "The HTTP/2 connection manager is closed." + :operation :http2-manager + :cause :closed)) + (setf close-new-p (not (eq result-connection connection))) + (handler-case + (%h2-manager-run-retirements manager retirement-actions) + (error (condition) + (%h2-manager-finish-entry manager result-entry) + (error condition))) + (values result-connection result-entry)) + (when close-new-p + (%h2-manager-close-connection connection)))))) + + (defun %h2-manager-connection-for + (manager request connection-key connection-key-supplied-p timeout deadline + proxy-plan proxy &optional (share-active-p nil) clock-function) + (unless (http2-connection-manager-p manager) + (error 'http-kit:http-protocol-error + :message "An HTTP/2 request requires an HTTP2-CONNECTION-MANAGER." + :operation :http2-manager + :detail (type-of manager))) + (http-kit::%check-http-request request) + (let* ((key (if connection-key-supplied-p + connection-key + (%h2-manager-request-key request proxy-plan proxy))) + (wait-clock (or clock-function #'http-kit::%monotonic-time)) + (wait-deadline + (http-kit:http-deadline timeout :deadline deadline + :clock-function wait-clock))) + (loop + do (%h2-manager-prune manager) + (multiple-value-bind (entry request-scoped-p actions clear-generation) + (%h2-manager-select-entry manager key (%h2-manager-now manager) + share-active-p) + (%h2-manager-run-retirements manager actions) + (when entry + (return-from %h2-manager-connection-for + (values (%http2-managed-connection-connection entry) entry))) + (when request-scoped-p + (return-from %h2-manager-connection-for + (%h2-manager-open-entry + manager request key timeout deadline proxy-plan proxy + share-active-p t clear-generation))) + (unless share-active-p + (return-from %h2-manager-connection-for + (%h2-manager-open-entry + manager request key timeout deadline proxy-plan proxy + nil nil clear-generation))) + (multiple-value-bind (opening owner-p reentrant-p) + (%h2-manager-claim-opening manager key) + (cond + (owner-p + (unwind-protect + (progn + (%h2-manager-prune manager) + (multiple-value-bind + (current-entry current-request-scoped-p + current-actions current-clear-generation) + (%h2-manager-select-entry + manager key (%h2-manager-now manager) + share-active-p) + (%h2-manager-run-retirements + manager current-actions) + (if current-entry + (return-from %h2-manager-connection-for + (values + (%http2-managed-connection-connection + current-entry) + current-entry)) + (return-from %h2-manager-connection-for + (%h2-manager-open-entry + manager request key timeout deadline proxy-plan + proxy t current-request-scoped-p + current-clear-generation))))) + (%h2-manager-release-opening manager key opening))) + (reentrant-p + (return-from %h2-manager-connection-for + (%h2-manager-open-entry + manager request key timeout deadline proxy-plan proxy + t t clear-generation))) + (t + (%h2-manager-wait-for-opening + manager key opening wait-deadline wait-clock)))))))) +) (defun %h2-manager-finish-entry (manager entry) (let ((now nil) @@ -573,9 +731,7 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." with retried-p = nil do (multiple-value-bind (connection entry) - (%h2-manager-connection-for - manager request connection-key connection-key-supplied-p - timeout deadline proxy-plan proxy) + (%h2-manager-connection-for manager request connection-key connection-key-supplied-p timeout deadline proxy-plan proxy t clock-function) (let ((retry-p nil) (response nil)) (unwind-protect @@ -601,7 +757,7 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." condition request-body-function)) (setf retried-p t retry-p t) - (error condition)))) + (error condition)))) (%h2-manager-finish-entry manager entry)) (unless retry-p (return response)))))) @@ -621,7 +777,7 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." (multiple-value-bind (connection entry) (%h2-manager-connection-for manager (first requests) connection-key connection-key-supplied-p - timeout deadline nil nil) + timeout deadline nil nil nil) (unwind-protect (send-http2-requests-over-connection connection requests @@ -690,14 +846,15 @@ CLOSE-HTTP2-CONNECTION-MANAGER also prevents future calls." (defun %h2-manager-retire-all (manager terminal-p) (let ((actions nil)) (%h2-manager-with-lock (manager) - (incf (%http2-connection-manager-clear-generation manager)) - (when terminal-p - (setf (%http2-connection-manager-closed-p manager) t)) - (dolist (entry (copy-list - (%http2-connection-manager-entries manager))) - (let ((action (%h2-manager-retire-entry-locked manager entry))) - (when action - (push action actions))))) + (incf (%http2-connection-manager-clear-generation manager)) + (when terminal-p + (setf (%http2-connection-manager-closed-p manager) t) + (%h2-manager-broadcast-openings-locked manager)) + (dolist (entry + (copy-list (%http2-connection-manager-entries manager))) + (let ((action (%h2-manager-retire-entry-locked manager entry))) + (when action + (push action actions))))) (%h2-manager-run-retirements manager (nreverse actions)) manager)) diff --git a/http2/transport-read-response.lisp b/http2/transport-read-response.lisp index 8c14c5cf..687f272c 100644 --- a/http2/transport-read-response.lisp +++ b/http2/transport-read-response.lisp @@ -138,11 +138,9 @@ frame status body body-length request-method max-body-bytes on-body-chunk collect-body-p expected-stream-id) (setf body-length new-body-length) - ;; DATA consumes both the per-stream and connection-level - ;; receive windows. Restore them after processing the - ;; payload so a stream transport can receive bodies larger - ;; than the initial 65,535-byte window. - (%h2-send-window-update writer stream-id data-length) + ;; Restore stream credit only while more response DATA can arrive. + (unless end-stream + (%h2-send-window-update writer stream-id data-length)) (%h2-send-window-update writer 0 data-length) (when end-stream (return-from %h2-read-response diff --git a/http2/transport-write.lisp b/http2/transport-write.lisp index b0ae1bcb..77b6d00d 100644 --- a/http2/transport-write.lisp +++ b/http2/transport-write.lisp @@ -6,9 +6,15 @@ (finish-output stream) wire) -(defun %h2-writer (stream deadline clock-function) +(defun %h2-writer (stream deadline clock-function &optional lock) (and stream (lambda (wire) + #+sbcl + (if lock + (sb-thread:with-mutex (lock) + (%h2-write-wire stream wire deadline clock-function)) + (%h2-write-wire stream wire deadline clock-function)) + #-sbcl (%h2-write-wire stream wire deadline clock-function)))) (defun %h2-send-control (writer type flags stream-id payload) diff --git a/t/tests-client-contract-boundaries.lisp b/t/tests-client-contract-boundaries.lisp index 98977b9e..d4f393ed 100644 --- a/t/tests-client-contract-boundaries.lisp +++ b/t/tests-client-contract-boundaries.lisp @@ -2840,6 +2840,105 @@ (ensure-equal 1 closed)) (setf (symbol-function constructor-symbol) original-constructor) (http-connection-pool-clear pool)))) +#+sbcl +(deftest client-clear-connections-clears-http1-pool-and-remains-usable + (let* ((opened 0) + (closed-streams nil) + (pool + (make-http-connection-pool + :open-stream + (lambda (&rest arguments) + (declare (ignore arguments)) + (incf opened) + (make-instance + 'binary-test-stream + :input (ascii "HTTP/1.1 200 OK|CRLF|Content-Length: 0|CRLF||CRLF|"))) + :close-stream + (lambda (stream) + (push stream closed-streams) + (when (open-stream-p stream) + (close stream :abort t))))) + (client (make-http-client :connection-pool pool :cache nil))) + (unwind-protect + (progn + (ensure-equal + 200 + (http-response-status + (http-client-send client "GET" "http://clear.test/first"))) + (ensure-equal 1 (getf (http-connection-pool-stats pool) :idle-count)) + (http-kit/client:http-client-clear-connections client) + (ensure-equal 0 (getf (http-connection-pool-stats pool) :idle-count)) + (ensure-equal 1 (length closed-streams)) + (http-kit/client:http-client-clear-connections client) + (ensure-equal 1 (length closed-streams)) + (ensure-equal + 200 + (http-response-status + (http-client-send client "GET" "http://clear.test/second"))) + (ensure-equal 2 opened) + (ensure-equal 1 (getf (http-connection-pool-stats pool) :idle-count)) + (http-kit/client:http-client-clear-connections client) + (ensure-equal 2 (length closed-streams)) + (ensure-equal 0 (getf (http-connection-pool-stats pool) :idle-count))) + (http-kit/client:http-client-clear-connections client)))) +#+sbcl +(deftest client-clear-connections-clears-native-http2-manager + (let* ((http-kit/client::*proxy-environment-function* + (lambda (name) (declare (ignore name)) nil)) + (open-stream-symbol 'http-kit/client::%client-native-open-stream) + (tls-upgrade-symbol 'http-kit/client::%client-native-tls-upgrade) + (original-open-stream (symbol-function open-stream-symbol)) + (original-tls-upgrade (symbol-function tls-upgrade-symbol)) + (wire + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 5 1 (h2-header-block (cons ":status" "200"))))) + (streams nil) + (opened 0)) + (unwind-protect + (progn + (setf (symbol-function open-stream-symbol) + (lambda () + (lambda (request &key timeout deadline proxy-plan proxy + &allow-other-keys) + (declare (ignore request timeout deadline proxy-plan proxy)) + (incf opened) + (let ((stream + (make-instance 'binary-test-stream :input wire))) + (push stream streams) + stream)))) + (setf (symbol-function tls-upgrade-symbol) + (lambda () + (lambda (stream uri &key timeout deadline &allow-other-keys) + (declare (ignore uri timeout deadline)) + (values stream "h2")))) + (let ((client (make-http-client :cache nil))) + (unwind-protect + (progn + (ensure-equal + 200 + (http-response-status + (http-client-send + client "GET" "https://clear.test/first"))) + (ensure-equal 1 opened) + (http-kit/client:http-client-clear-connections client) + (ensure-true (not (open-stream-p (first streams)))) + (http-kit/client:http-client-clear-connections client) + (ensure-equal 1 opened) + (ensure-equal + 200 + (http-response-status + (http-client-send + client "GET" "https://clear.test/second"))) + (ensure-equal 2 opened) + (ensure-true (open-stream-p (first streams))) + (ensure-true (not (open-stream-p (second streams)))) + (http-kit/client:http-client-clear-connections client) + (ensure-true (not (open-stream-p (first streams)))) + (ensure-true (not (open-stream-p (second streams))))) + (http-kit/client:http-client-clear-connections client)))) + (setf (symbol-function open-stream-symbol) original-open-stream) + (setf (symbol-function tls-upgrade-symbol) original-tls-upgrade)))) #+sbcl (deftest client-native-alpn-pending-stream-closes-on-http2-transport-error (let* ((sender-symbol (find-symbol "SEND-HTTP2-REQUEST-OVER-CONNECTION-MANAGER" "HTTP-KIT/HTTP2")) diff --git a/t/tests-client.lisp b/t/tests-client.lisp index aece2128..585521aa 100644 --- a/t/tests-client.lisp +++ b/t/tests-client.lisp @@ -4204,6 +4204,63 @@ (ascii "GET /one HTTP/1.1|CRLF|Host: example.test|CRLF|Content-Length: 0|CRLF||CRLF|GET /two HTTP/1.1|CRLF|Host: example.test|CRLF|Content-Length: 0|CRLF||CRLF|") (binary-test-output stream)))) +#+sbcl +(deftest client-connection-pool-clear-retires-active-stream + (let* ((first-stream + (make-instance + 'binary-test-stream + :input + (ascii + "HTTP/1.1 103 Early Hints|CRLF||CRLF|HTTP/1.1 200 OK|CRLF|Content-Length: 3|CRLF||CRLF|abc"))) + (second-stream + (make-instance + 'binary-test-stream + :input + (ascii + "HTTP/1.1 200 OK|CRLF|Content-Length: 3|CRLF||CRLF|def"))) + (opened 0) + (closed-streams nil) + (pool + (make-http-connection-pool + :open-stream + (lambda (request &key timeout deadline proxy-plan proxy + &allow-other-keys) + (declare (ignore request timeout deadline proxy-plan proxy)) + (incf opened) + (if (= opened 1) first-stream second-stream)) + :close-stream + (lambda (closed-stream) + (push closed-stream closed-streams)))) + (client (make-http-client :cache nil + :automatic-decompression-p nil + :connection-pool pool))) + (multiple-value-bind (response effective) + (http-client-send + client + (http-client-request client "GET" "http://example.test/first") + :on-information + (lambda (information) + (ensure-equal 103 (http-response-status information)) + (ensure-equal 0 (http-connection-pool-clear pool)) + (ensure-false (member first-stream closed-streams :test #'eq)))) + (declare (ignore effective)) + (ensure-equal 200 (http-response-status response)) + (ensure-equal "abc" (octets-as-string (http-response-body response)))) + (ensure-equal 1 opened) + (ensure-true (member first-stream closed-streams :test #'eq)) + (ensure-equal 0 + (getf (http-connection-pool-stats pool) :idle-count)) + (multiple-value-bind (response effective) + (http-client-send + client + (http-client-request client "GET" "http://example.test/second")) + (declare (ignore effective)) + (ensure-equal 200 (http-response-status response)) + (ensure-equal "def" (octets-as-string (http-response-body response)))) + (ensure-equal 2 opened) + (ensure-false (member second-stream closed-streams :test #'eq)) + (ensure-equal 1 (http-connection-pool-clear pool)) + (ensure-true (member second-stream closed-streams :test #'eq)))) #+sbcl (deftest client-connection-pool-closes-non-reusable-stream diff --git a/t/tests-e2e-http2.lisp b/t/tests-e2e-http2.lisp index ab2534dc..35291fd0 100644 --- a/t/tests-e2e-http2.lisp +++ b/t/tests-e2e-http2.lisp @@ -111,6 +111,235 @@ (when process (ignore-errors (uiop:terminate-process process)) (ignore-errors (uiop:wait-process process)))))))) +#+sbcl +(deftest e2e-http2-connection-manager-cold-open-client-tcp-tls-session-and-stream-ids + (let* ((directory + (merge-pathnames + (format nil "cl-http-kit-http2-cold-open-e2e-~36R/" + (random (expt 2 64))) + (uiop:temporary-directory))) + (certificate (namestring (merge-pathnames "server.crt" directory))) + (key (namestring (merge-pathnames "server.key" directory))) + (one (ascii "cold-open-first")) + (two (ascii "cold-open-second")) + (nghttpd (or (uiop:getenv "NGHTTPD") "nghttpd")) + (port (multiple-value-bind (listener selected-port) + (%network-test-listener) + (%network-test-close-socket listener) + selected-port)) + (process nil) + (client nil) + (counter-lock (sb-thread:make-mutex :name "HTTP/2 cold-open counters")) + (client-tcp-open-calls 0) + (tls-upgrades 0) + (manager-open-callbacks 0) + (constructed-entries 0) + (sessions nil) + (stream-ids nil) + (first-manager-open-entered (sb-thread:make-semaphore :count 0)) + (release-first-manager-open (sb-thread:make-semaphore :count 0)) + (second-manager-waiting (sb-thread:make-semaphore :count 0)) + (first-response nil) + (second-response nil) + (first-error nil) + (second-error nil) + (first-thread nil) + (second-thread nil) + (runtime-symbol 'http-kit/client::%client-runtime-function) + (original-runtime (symbol-function runtime-symbol)) + (open-symbol 'http-kit/http2::%h2-manager-open-connection) + (original-open (symbol-function open-symbol)) + (wait-symbol 'http-kit/http2::%h2-manager-wait-for-opening) + (original-wait (symbol-function wait-symbol)) + (new-entry-symbol 'http-kit/http2::%h2-manager-new-entry) + (original-new-entry (symbol-function new-entry-symbol)) + (connection-symbol 'http-kit/http2:make-http2-connection) + (original-make-connection (symbol-function connection-symbol)) + (scheduler-open-symbol 'http-kit/http2::%h2-scheduler-open-entry) + (original-scheduler-open (symbol-function scheduler-open-symbol))) + (unwind-protect + (progn + (ensure-directories-exist directory) + (%http2-e2e-write-file (merge-pathnames "one.txt" directory) one) + (%http2-e2e-write-file (merge-pathnames "two.txt" directory) two) + (uiop:run-program + (list "openssl" "req" "-x509" "-newkey" "rsa:2048" "-nodes" + "-days" "1" "-subj" "/CN=127.0.0.1" + "-addext" "subjectAltName=IP:127.0.0.1" + "-keyout" key "-out" certificate) + :output :string :error-output :string) + (let ((trust-anchor + (cl-tls-kit.x509:parse-certificate-der + (cl-tls-kit:pem-block-der + (first (cl-tls-kit:pem-decode + (uiop:read-file-string certificate))))))) + (setf process + (uiop:launch-program + (list nghttpd "-a" "127.0.0.1" + "-d" (namestring directory) + "-m" "100" + (princ-to-string port) key certificate) + :output :stream + :error-output :stream + :wait nil)) + (ensure-true (%e2e-wait-for-tcp "127.0.0.1" port :timeout 5)) + (setf (symbol-function runtime-symbol) + (lambda (package-name function-name) + (cond + ((and (string= package-name "HTTP-KIT/NETWORK") + (string= function-name + "MAKE-HTTP-NETWORK-STREAM-OPENER")) + (let ((factory + (funcall original-runtime package-name + function-name))) + (lambda (&rest factory-arguments) + (let ((opener (apply factory factory-arguments))) + (lambda (&rest open-arguments) + (sb-thread:with-mutex (counter-lock) + (incf client-tcp-open-calls)) + (apply opener open-arguments)))))) + ((and (string= package-name "HTTP-KIT/TLS") + (string= function-name "MAKE-HTTP-TLS-UPGRADER")) + (lambda (&key alpn-protocols) + (ensure-equal '("h2" "http/1.1") alpn-protocols) + (let ((tls-upgrader + (make-http-tls-upgrader + :verify :required + :trust-anchors (list trust-anchor) + :alpn-protocols alpn-protocols))) + (lambda (stream uri &key timeout deadline) + (sb-thread:with-mutex (counter-lock) + (incf tls-upgrades)) + (funcall tls-upgrader stream uri + :timeout timeout + :deadline deadline))))) + (t + (funcall original-runtime package-name function-name))))) + (setf (symbol-function open-symbol) + (lambda (manager &rest arguments) + (let ((first-open-p nil)) + (sb-thread:with-mutex (counter-lock) + (incf manager-open-callbacks) + (setf first-open-p (= manager-open-callbacks 1))) + (when first-open-p + (sb-thread:signal-semaphore + first-manager-open-entered) + (unless (sb-thread:wait-on-semaphore + release-first-manager-open :timeout 10) + (error "Timed out waiting to release the first manager open"))) + (apply original-open manager arguments)))) + (setf (symbol-function wait-symbol) + (lambda (manager open-key opening deadline clock-function) + (sb-thread:signal-semaphore second-manager-waiting) + (funcall original-wait manager open-key opening + deadline clock-function))) + (setf (symbol-function new-entry-symbol) + (lambda (&rest arguments) + (let ((entry (apply original-new-entry arguments))) + (sb-thread:with-mutex (counter-lock) + (incf constructed-entries)) + entry))) + (setf (symbol-function connection-symbol) + (lambda (&rest arguments) + (let ((connection + (apply original-make-connection arguments))) + (sb-thread:with-mutex (counter-lock) + (push connection sessions)) + connection))) + (setf (symbol-function scheduler-open-symbol) + (lambda (connection &rest arguments) + (let ((entry + (apply original-scheduler-open connection arguments))) + (sb-thread:with-mutex (counter-lock) + (push + (http-kit/http2::%h2-batch-entry-stream-id entry) + stream-ids)) + entry))) + (setf client (make-http-client :cache nil :default-timeout 15)) + (ensure-equal 0 client-tcp-open-calls) + (ensure-equal 0 tls-upgrades) + (ensure-equal 0 (length sessions)) + (setf first-thread + (sb-thread:make-thread + (lambda () + (handler-case + (setf first-response + (sb-ext:with-timeout 20 + (http-client-send + client "GET" + (format nil "https://127.0.0.1:~D/one.txt" + port)))) + (error (condition) + (setf first-error condition)))))) + (ensure-true + (sb-thread:wait-on-semaphore first-manager-open-entered + :timeout 10)) + (sb-thread:with-mutex (counter-lock) + (ensure-equal 1 client-tcp-open-calls) + (ensure-equal 1 tls-upgrades) + (ensure-equal 1 manager-open-callbacks) + (ensure-equal 0 constructed-entries) + (ensure-equal 0 (length sessions))) + (setf second-thread + (sb-thread:make-thread + (lambda () + (handler-case + (setf second-response + (sb-ext:with-timeout 20 + (http-client-send + client "GET" + (format nil "https://127.0.0.1:~D/two.txt" + port)))) + (error (condition) + (setf second-error condition)))))) + (ensure-true + (sb-thread:wait-on-semaphore second-manager-waiting :timeout 10)) + (sb-thread:with-mutex (counter-lock) + (ensure-equal 1 client-tcp-open-calls) + (ensure-equal 1 tls-upgrades) + (ensure-equal 1 manager-open-callbacks) + (ensure-equal 0 constructed-entries) + (ensure-equal 0 (length sessions))) + (sb-thread:signal-semaphore release-first-manager-open) + (sb-thread:join-thread first-thread) + (setf first-thread nil) + (sb-thread:join-thread second-thread) + (setf second-thread nil) + (ensure-true (null first-error)) + (ensure-true (null second-error)) + (ensure-equal 200 (http-response-status first-response)) + (ensure-equal 200 (http-response-status second-response)) + (ensure-equal "HTTP/2" + (http-response-protocol-version first-response)) + (ensure-equal "HTTP/2" + (http-response-protocol-version second-response)) + (ensure-octets-equal one (http-response-body first-response)) + (ensure-octets-equal two (http-response-body second-response)) + (sb-thread:with-mutex (counter-lock) + (ensure-equal 1 client-tcp-open-calls) + (ensure-equal 1 tls-upgrades) + (ensure-equal 1 manager-open-callbacks) + (ensure-equal 1 constructed-entries) + (ensure-equal 1 (length sessions)) + (ensure-equal '(1 3) (sort (copy-list stream-ids) #'<))) + (http-client-clear-connections client))) + (sb-thread:signal-semaphore release-first-manager-open) + (when first-thread + (ignore-errors (sb-thread:join-thread first-thread))) + (when second-thread + (ignore-errors (sb-thread:join-thread second-thread))) + (when client + (ignore-errors (http-client-clear-connections client))) + (setf (symbol-function scheduler-open-symbol) original-scheduler-open) + (setf (symbol-function connection-symbol) original-make-connection) + (setf (symbol-function new-entry-symbol) original-new-entry) + (setf (symbol-function wait-symbol) original-wait) + (setf (symbol-function open-symbol) original-open) + (setf (symbol-function runtime-symbol) original-runtime) + (when process + (ignore-errors (uiop:terminate-process process)) + (ignore-errors (uiop:wait-process process))) + (ignore-errors (uiop:delete-directory-tree directory :validate t))))) #+sbcl (deftest e2e-http2-nghttpd-native-default-client-reuses-clears-and-overlaps @@ -298,7 +527,7 @@ (ensure-octets-equal parallel-second-body (http-response-body second-parallel-response)) (sb-thread:with-mutex (upgrade-lock) - (ensure-equal 4 upgraded)) + (ensure-equal 3 upgraded)) (sb-thread:signal-semaphore release-first-callback) (sb-thread:join-thread first-thread) (setf first-thread nil) @@ -323,3 +552,484 @@ (ignore-errors (uiop:wait-process process))) (ignore-errors (uiop:delete-directory-tree directory :validate t)))))) +#+sbcl +(deftest e2e-http2-single-request-callers-share-one-multiplexed-connection-with-reentrant-callback + (multiple-value-bind (listener port) + (%network-test-listener) + (let ((server-thread nil) + (server-socket nil) + (server-stream nil) + (client-stream nil) + (connection nil) + (caller-threads (make-array 3 :initial-element nil)) + (responses (make-array 3 :initial-element nil)) + (caller-errors (make-array 3 :initial-element nil)) + (stream-ids (make-array 3 :initial-element nil)) + (ping-payload (ascii "pingtest")) + (callback-count 0) + (server-error nil) + (nested-response nil) + (nested-error nil) + (nested-stream-id nil) + (ping-response nil) + (ping-ack-sent-p nil) + (late-data-sent-p nil) + (partial-data-flow-credit-seen-p nil) + (late-data-flow-credit-seen-p nil) + (timeout-entry nil) + (timeout-body-chunk-seen-p nil) + (timeout-reset-seen-p nil) + (nested-request-seen-p nil) + (both-requests-before-response-p nil) + (lock (sb-thread:make-mutex :name "HTTP/2 scheduler E2E")) + (waitqueue (sb-thread:make-waitqueue :name "HTTP/2 scheduler E2E"))) + (labels ((check-prewrite-deadline () + (let* ((clock (lambda () 1)) + (probe-connection + (make-http2-connection + :stream (make-string-output-stream))) + (request + (make-http-request + :method "GET" + :uri "http://example.test/prewrite")) + (active-entry + (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (timeout-seen-p nil)) + (setf (http-kit/http2::%http2-connection-session-started-p + probe-connection) t + (http-kit/http2::%http2-connection-next-stream-id + probe-connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + probe-connection) 1 + (http-kit/http2::%http2-connection-scheduler-entries + probe-connection) (list active-entry)) + (handler-case + (http-kit/http2::%h2-scheduler-open-entry + probe-connection request nil nil + (http-kit/http2::%http2-connection-max-header-bytes + probe-connection) + (http-kit/http2::%http2-connection-max-fields + probe-connection) + (http-kit/http2::%http2-connection-max-body-bytes + probe-connection) + 0 clock nil nil nil t nil + (lambda (wire) + (declare (ignore wire)) + (http-kit::%check-deadline 0 clock :write))) + (http-kit:http-timeout () + (setf timeout-seen-p t))) + (ensure-true timeout-seen-p) + (ensure-equal + (list active-entry) + (http-kit/http2::%http2-connection-scheduler-entries + probe-connection)) + (ensure-equal + 5 + (http-kit/http2::%http2-connection-next-stream-id + probe-connection)) + (ensure-equal + 1 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + probe-connection)) + (ensure-true + (http-kit/http2::http2-connection-open-p probe-connection)) + (ensure-true + (http-kit/http2::%http2-connection-session-started-p + probe-connection)))) + (wait-for-callers (count) + (let ((deadline (+ (http-kit::%monotonic-time) 5))) + (sb-thread:with-mutex (lock) + (loop while (< callback-count count) + for remaining = + (- deadline (http-kit::%monotonic-time)) + do (when (<= remaining 0) + (return)) + (sb-thread:condition-wait + waitqueue lock :timeout remaining))) + (sb-thread:with-mutex (lock) + (ensure-equal count callback-count)))) + (start-caller + (index path timeout &optional information-callback body-callback) + (setf (aref caller-threads index) + (sb-thread:make-thread + (lambda () + (handler-case + (setf (aref responses index) + (send-http2-request-over-connection + connection + (make-http-request + :method "GET" + :uri (format nil + "http://127.0.0.1:~D/~A" + port path)) + :timeout timeout + :on-information information-callback + :on-body-chunk body-callback + :on-stream-open + (lambda (stream-id &rest ignored) + (declare (ignore ignored)) + (sb-thread:with-mutex (lock) + (setf (aref stream-ids index) + stream-id) + (when (= index 2) + (sb-thread:with-mutex + ((http-kit/http2::%http2-connection-scheduler-lock + connection)) + (setf timeout-entry + (http-kit/http2::%h2-scheduler-entry-for-stream + connection stream-id)))) + (incf callback-count) + (sb-thread:condition-broadcast + waitqueue))))) + (error (condition) + (setf (aref caller-errors index) condition)))))))) + (unwind-protect + (progn + (check-prewrite-deadline) + (setf server-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (progn + (setf server-socket + (sb-bsd-sockets:socket-accept listener) + server-stream + (sb-bsd-sockets:socket-make-stream + server-socket + :input t + :output t + :element-type '(unsigned-byte 8) + :buffering :full)) + (let* ((preface + (make-array + (length + http-kit/http2::+http2-connection-preface+) + :element-type '(unsigned-byte 8))) + (position 0)) + (loop while (< position (length preface)) + for next = + (read-sequence preface server-stream + :start position) + do (when (= next position) + (error "The HTTP/2 client closed before its preface.")) + (setf position next)) + (unless (equalp + preface + http-kit/http2::+http2-connection-preface+) + (error "The HTTP/2 client sent an invalid preface."))) + (let* ((reader + (http-kit/http2::%h2-reader-for + server-stream)) + (deadline + (+ (http-kit::%monotonic-time) 5)) + (request-streams nil)) + (loop while (< (length request-streams) 3) + for frame = + (http-kit/http2::%h2-read-frame + reader + http-kit/http2::+http2-default-max-frame-size+ + deadline + #'http-kit::%monotonic-time) + do (when (eq frame :eof) + (error "The HTTP/2 client closed before opening three streams.")) + (when (= (http-kit/http2::%h2-frame-type frame) + http-kit/http2::+http2-headers-type+) + (push + (http-kit/http2::%h2-frame-stream-id frame) + request-streams))) + (wait-for-callers 3) + (setf both-requests-before-response-p t) + (let* ((information-headers + (http-kit/http2::%h2-encode-header-block + '((":status" . "103")))) + (headers + (http-kit/http2::%h2-encode-header-block + '((":status" . "200")))) + (empty-payload + (make-array + 0 + :element-type '(unsigned-byte 8))) + (initial-stream-ids + (loop for stream-id across stream-ids + collect stream-id))) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-settings-type+ + 0 0 empty-payload) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-end-headers-flag+ + (aref stream-ids 0) + information-headers) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-end-headers-flag+ + (aref stream-ids 2) + headers) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-data-type+ + 0 + (aref stream-ids 2) + (ascii "partial-timeout-body")) + server-stream) + (finish-output server-stream) + (loop until (and nested-request-seen-p + timeout-reset-seen-p + partial-data-flow-credit-seen-p) + for frame = + (http-kit/http2::%h2-read-frame + reader + http-kit/http2::+http2-default-max-frame-size+ + deadline + #'http-kit::%monotonic-time) + do (when (eq frame :eof) + (error "The HTTP/2 client closed before the nested request and stream reset.")) + (cond + ((= (http-kit/http2::%h2-frame-type frame) + http-kit/http2::+http2-headers-type+) + (let ((stream-id + (http-kit/http2::%h2-frame-stream-id frame))) + (unless (member stream-id initial-stream-ids) + (setf nested-stream-id stream-id + nested-request-seen-p t) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-end-headers-flag+ + stream-id headers) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-data-type+ + http-kit/http2::+http2-end-stream-flag+ + stream-id + (ascii "nested-response")) + server-stream) + (finish-output server-stream)))) + ((and (= (http-kit/http2::%h2-frame-type frame) + http-kit/http2::+http2-rst-stream-type+) + (= (http-kit/http2::%h2-frame-stream-id frame) + (aref stream-ids 2))) + (setf timeout-reset-seen-p t)) + ((= (http-kit/http2::%h2-frame-type frame) + http-kit/http2::+http2-ping-type+) + (unless (and + (zerop + (http-kit/http2::%h2-frame-stream-id + frame)) + (= (length + (http-kit/http2::%h2-frame-payload + frame)) + 8) + (zerop + (logand + (http-kit/http2::%h2-frame-flags + frame) + http-kit/http2::+http2-ack-flag+))) + (error "The client sent an invalid HTTP/2 PING.")) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-ping-type+ + http-kit/http2::+http2-ack-flag+ + 0 + (http-kit/http2::%h2-frame-payload + frame)) + server-stream) + (finish-output server-stream) + (setf ping-ack-sent-p t)) + ((and + (= (http-kit/http2::%h2-frame-type frame) + http-kit/http2::+http2-window-update-type+) + (zerop + (http-kit/http2::%h2-frame-stream-id + frame))) + (when (and + (= (length + (http-kit/http2::%h2-frame-payload + frame)) + 4) + (= (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload + frame) + 0) + (length + (ascii "partial-timeout-body")))) + (setf partial-data-flow-credit-seen-p + t))))) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-end-headers-flag+ + (aref stream-ids 2) + headers) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-data-type+ + http-kit/http2::+http2-end-stream-flag+ + (aref stream-ids 2) + (ascii "late-timeout-body")) + server-stream) + (finish-output server-stream) + (setf late-data-sent-p t) + (loop until late-data-flow-credit-seen-p + for frame = + (http-kit/http2::%h2-read-frame + reader + http-kit/http2::+http2-default-max-frame-size+ + deadline + #'http-kit::%monotonic-time) + do (when (eq frame :eof) + (error "The HTTP/2 client closed before returning late DATA flow credit.")) + (when (and + (= (http-kit/http2::%h2-frame-type frame) + http-kit/http2::+http2-window-update-type+) + (zerop + (http-kit/http2::%h2-frame-stream-id + frame)) + (= (length + (http-kit/http2::%h2-frame-payload + frame)) + 4) + (= (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload + frame) + 0) + (length + (ascii "late-timeout-body")))) + (setf late-data-flow-credit-seen-p + t))) + (dolist (stream-id + (list (aref stream-ids 1) + (aref stream-ids 0))) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-end-headers-flag+ + stream-id headers) + server-stream)) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-data-type+ + 0 + (aref stream-ids 1) + (ascii "response-")) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-data-type+ + http-kit/http2::+http2-end-stream-flag+ + (aref stream-ids 0) + (ascii "response-first")) + server-stream) + (write-sequence + (http-kit/http2::%h2-frame-wire + http-kit/http2::+http2-data-type+ + http-kit/http2::+http2-end-stream-flag+ + (aref stream-ids 1) + (ascii "second")) + server-stream) + (finish-output server-stream)))) + (error (condition) + (setf server-error condition))) + (when server-error + (%network-test-close-stream server-stream) + (%network-test-close-socket server-socket))))))) + (setf client-stream + (open-http-tcp-stream + (make-http-request + :method "GET" + :uri (format nil "http://127.0.0.1:~D/first" port)) + :timeout 5) + connection + (make-http2-connection + :stream client-stream + :close-stream #'close)) + (start-caller + 0 "first" 6 + (lambda (information-response) + (when (= (http-response-status information-response) 103) + (handler-case + (progn + (setf ping-response + (ping-http2-connection + connection :payload ping-payload :timeout 4)) + (setf nested-response + (send-http2-request-over-connection + connection + (make-http-request + :method "GET" + :uri (format nil "http://127.0.0.1:~D/nested" port)) + :timeout 4))) + (error (condition) + (setf nested-error condition)))))) + (wait-for-callers 1) + (start-caller 1 "second" 6) + (wait-for-callers 2) + (start-caller + 2 "timeout" 2 nil + (lambda (payload) + (when (equalp payload (ascii "partial-timeout-body")) + (setf timeout-body-chunk-seen-p t)))) + (wait-for-callers 3) + (loop for thread across caller-threads + when thread do (sb-thread:join-thread thread)) + (sb-thread:join-thread server-thread) + (ensure-equal nil server-error) + (ensure-equal nil (aref caller-errors 0)) + (ensure-equal nil (aref caller-errors 1)) + (ensure-true (typep (aref caller-errors 2) 'http-kit:http-timeout)) + (ensure-equal nil nested-error) + (ensure-true both-requests-before-response-p) + (ensure-true nested-request-seen-p) + (ensure-true ping-ack-sent-p) + (ensure-true late-data-sent-p) + (ensure-true partial-data-flow-credit-seen-p) + (ensure-true late-data-flow-credit-seen-p) + (ensure-true timeout-body-chunk-seen-p) + (ensure-true timeout-reset-seen-p) + (ensure-true timeout-entry) + (ensure-equal + 0 + (length + (http-kit/http2::%h2-batch-entry-body-vector timeout-entry))) + (ensure-equal + 0 + (http-kit/http2::%h2-batch-entry-body-length timeout-entry)) + (ensure-equal nil + (http-kit/http2::%h2-batch-entry-response timeout-entry)) + (ensure-equal nil + (http-kit/http2::%h2-scheduler-entry-for-stream + connection (aref stream-ids 2))) + (ensure-octets-equal ping-payload ping-response) + (ensure-equal 200 (http-response-status (aref responses 0))) + (ensure-equal 200 (http-response-status (aref responses 1))) + (ensure-equal 200 (http-response-status nested-response)) + (ensure-octets-equal + (ascii "response-first") + (http-response-body (aref responses 0))) + (ensure-octets-equal + (ascii "response-second") + (http-response-body (aref responses 1))) + (ensure-octets-equal + (ascii "nested-response") + (http-response-body nested-response))) + (when connection + (ignore-errors (close-http2-connection connection))) + (%network-test-close-stream client-stream) + (%network-test-close-stream server-stream) + (%network-test-close-socket server-socket) + (%network-test-close-socket listener) + (when server-thread + (ignore-errors (sb-thread:join-thread server-thread))) + (loop for thread across caller-threads + when thread do (ignore-errors (sb-thread:join-thread thread))))))) + diff --git a/t/tests-http2-coverage-boundaries.lisp b/t/tests-http2-coverage-boundaries.lisp index d270da9e..039c642d 100644 --- a/t/tests-http2-coverage-boundaries.lisp +++ b/t/tests-http2-coverage-boundaries.lisp @@ -292,9 +292,25 @@ (http-response-body response)) (ensure-equal (list (h2-frame 4 1 0 (octets)) (h2-frame 6 1 0 payload) - (h2-frame 8 0 1 (octets 0 0 0 4)) (h2-frame 8 0 0 (octets 0 0 0 4))) (reverse writes))))) +#+sbcl (deftest http2-coverage-response-uses-initial-frames + (let* ((reads 0) + (response + (http-kit/http2::%h2-read-response + (lambda () (incf reads) :eof) + (lambda (wire) (declare (ignore wire))) + 16384 nil (lambda () 0) 4096 16 "GET" + :read-initial-settings-p nil + :initial-frames + (list + (h2-frame-object 1 5 1 + (h2-header-block + (cons ":status" "200") + (cons "content-length" "0"))))))) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets) (http-response-body response)) + (ensure-equal 0 reads))) #+sbcl (deftest http2-coverage-response-option-errors-before-io @@ -547,3 +563,2117 @@ (ensure-true condition) (ensure-equal :hpack (http-error-operation condition)) (ensure-equal -1 (http-protocol-error-detail condition)))) + +#+sbcl +(deftest http2-coverage-serial-fallback-direct-reuse + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 4 1 + (h2-header-block (cons ":status" "103"))) + (h2-frame 1 4 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "2"))) + (h2-frame 0 1 1 (octets 97 98)) + (h2-frame 1 4 3 + (h2-header-block (cons ":status" "201") + (cons "content-length" "1"))) + (h2-frame 0 1 3 (octets 99)))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (information-statuses nil) + (body-chunks nil) + (first-response + (http-kit/http2::%h2-send-http2-request-over-connection-serial + connection + (make-http-request :method "GET" :uri "https://example.com/one") + :on-information + (lambda (response) + (push (http-response-status response) information-statuses)) + :on-body-chunk (lambda (chunk) (push (copy-seq chunk) body-chunks)))) + (second-response + (http-kit/http2::%h2-send-http2-request-over-connection-serial + connection + (make-http-request :method "GET" :uri "https://example.com/two") + :on-body-chunk (lambda (chunk) (push (copy-seq chunk) body-chunks)))) + (frames (h2-output-frames stream))) + (ensure-equal '(103) (nreverse information-statuses)) + (ensure-equal 200 (http-response-status first-response)) + (ensure-equal (octets 97 98) (http-response-body first-response)) + (ensure-equal 201 (http-response-status second-response)) + (ensure-equal (octets 99) (http-response-body second-response)) + (ensure-equal (list (octets 97 98) (octets 99)) (nreverse body-chunks)) + (ensure-true (http-kit/http2:http2-connection-session-started-p connection)) + (ensure-equal 5 (http-kit/http2::%http2-connection-next-stream-id connection)) + (ensure-equal '(1 3) + (mapcar #'http-kit/http2::%h2-frame-stream-id + (remove-if-not + (lambda (frame) + (= 1 (http-kit/http2::%h2-frame-type frame))) + frames))) + (ensure-equal 1 + (count-if + (lambda (frame) + (and (= 4 (http-kit/http2::%h2-frame-type frame)) + (= 1 (http-kit/http2::%h2-frame-flags frame)))) + frames)) + (ensure-equal (length input) (binary-session-input-position stream)) + (http-kit/http2:close-http2-connection connection))) + +#+sbcl +(deftest http2-coverage-serial-fallback-peer-reset-keeps-session + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 3 0 1 (octets 0 0 0 8)))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (condition + (handler-case + (http-kit/http2::%h2-send-http2-request-over-connection-serial + connection + (make-http-request :method "GET" :uri "https://example.com/reset")) + (http-connection-error (error) error)))) + (ensure-true (typep condition 'http-connection-error)) + (ensure-equal :http2-control (http-error-operation condition)) + (ensure-equal '(:rst-stream 1 8) + (http-connection-error-cause condition)) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (ensure-true (open-stream-p stream)) + (ensure-equal 3 (http-kit/http2::%http2-connection-next-stream-id connection)) + (http-kit/http2:close-http2-connection connection) + (ensure-false (open-stream-p stream)))) + +#+sbcl +(deftest http2-coverage-scheduler-control-frame-state + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0))) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-next-stream-id connection) 5) + (labels ((dispatch (frame) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection frame nil nil nil clock)) + (expect-protocol-error (frame operation detail) + (let ((condition + (handler-case (dispatch frame) + (http-protocol-error (error) error)))) + (ensure-true (typep condition 'http-protocol-error)) + (ensure-equal operation (http-error-operation condition)) + (ensure-equal detail (http-protocol-error-detail condition)))) + (read-output-frames () + (let ((reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (frames nil)) + (loop for frame = (http-kit/http2::%h2-read-frame + reader 16384 nil nil) + until (eq frame :eof) + do (push frame frames)) + (nreverse frames)))) + (expect-protocol-error + (h2-frame-object 6 0 1 (octets 1 2 3 4 5 6 7 8)) + :http2-control '(1 8)) + (expect-protocol-error + (h2-frame-object 8 0 5 (octets 0 0 0 1)) + :http2-control 5) + (expect-protocol-error + (h2-frame-object 3 0 5 (octets 0 0 0 8)) + :http2-control 5) + (let ((payload (octets 1 2 3 4 5 6 7 8))) + (dispatch (h2-frame-object 6 0 0 payload)) + (let ((ping (first (read-output-frames)))) + (ensure-equal 6 (http-kit/http2::%h2-frame-type ping)) + (ensure-equal 1 (http-kit/http2::%h2-frame-flags ping)) + (ensure-equal 0 (http-kit/http2::%h2-frame-stream-id ping)) + (ensure-equal payload (http-kit/http2::%h2-frame-payload ping))) + (let ((waiter + (http-kit/http2::%make-h2-scheduler-ping-waiter payload))) + (setf (http-kit/http2::%http2-connection-scheduler-ping-waiters + connection) (list waiter)) + (let* ((frame (h2-frame-object 6 0 1 payload)) + (condition + (handler-case (dispatch frame) + (http-protocol-error (error) error)))) + (ensure-true (typep condition 'http-protocol-error)) + (ensure-equal :http2-client (http-error-operation condition)) + (ensure-true + (eq frame (http-protocol-error-detail condition)))) + (dispatch (h2-frame-object 6 1 0 (octets 8 7 6 5 4 3 2 1))) + (ensure-false + (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p waiter)) + (dispatch (h2-frame-object 6 1 0 payload)) + (ensure-true + (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p waiter))) + (dispatch (h2-frame-object 8 0 0 (octets 0 0 0 1))) + (ensure-equal 65536 + (http-kit/http2::%http2-connection-peer-connection-window-size + connection))) + (let* ((request + (make-http-request :method "GET" :uri "https://example.com/reset")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1))) + (setf (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry)) + (dispatch (h2-frame-object 3 0 1 (octets 0 0 0 8))) + (ensure-true (typep (http-kit/http2::%h2-batch-entry-error entry) + 'http-connection-error)) + (ensure-equal '(:rst-stream 1 8) + (http-connection-error-cause + (http-kit/http2::%h2-batch-entry-error entry))) + (ensure-equal (list entry) + (http-kit/http2::%http2-connection-scheduler-entries + connection))) + (let* ((request + (make-http-request :method "GET" :uri "https://example.com/retired")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 3))) + (setf (http-kit/http2::%h2-batch-entry-local-retired-p entry) t + (http-kit/http2::%http2-connection-next-stream-id connection) 5 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 3 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry)) + (dispatch (h2-frame-object 7 0 0 (octets 0 0 0 1 0 0 0 0))) + (ensure-equal 1 + (http-kit/http2:http2-connection-goaway-last-stream-id + connection)) + (ensure-equal '(:goaway 1 0) + (http-connection-error-cause + (http-kit/http2::%h2-batch-entry-error entry))) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)))) + (http-kit/http2:close-http2-connection connection))) + +#+sbcl +(deftest http2-coverage-scheduler-retired-stream-dispatch + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0)) + (block (h2-header-block (cons ":status" "200"))) + (split (max 1 (floor (length block) 2))) + (reader (h2-reader-from-frames + (h2-frame 9 4 1 (subseq block split))))) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-session-started-p connection) t + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 1) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection + (h2-frame-object 1 0 1 (subseq block 0 split)) + reader nil nil clock) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 1 1 (octets 97 98)) reader nil nil clock) + (let* ((output-reader + (http-kit/http2::%h2-reader-for (binary-session-output stream))) + (window-update + (http-kit/http2::%h2-read-frame output-reader 16384 nil nil))) + (ensure-equal 8 (http-kit/http2::%h2-frame-type window-update)) + (ensure-equal 0 (http-kit/http2::%h2-frame-stream-id window-update)) + (ensure-equal (octets 0 0 0 2) + (http-kit/http2::%h2-frame-payload window-update))) + (dolist (case '((9 4 :http2-headers 1) + (5 4 :http2-read :protocol-error))) + (destructuring-bind (type flags operation detail) case + (let ((condition + (handler-case + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object type flags 1 (octets)) + reader nil nil clock) + (http-protocol-error (error) error)))) + (ensure-true (typep condition 'http-protocol-error)) + (ensure-equal operation (http-error-operation condition)) + (ensure-equal detail (http-protocol-error-detail condition))))) + (let ((condition + (handler-case + (http-kit/http2::%h2-scheduler-dispatch-frame + connection + (h2-frame-object 1 5 3 (h2-header-block (cons ":status" "200"))) + reader nil nil clock) + (http-protocol-error (error) error)))) + (ensure-true (typep condition 'http-protocol-error)) + (ensure-equal :http2-read (http-error-operation condition)) + (ensure-equal 3 (http-protocol-error-detail condition))) + (let ((condition + (handler-case + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 1 3 (octets 97)) + reader nil nil clock) + (http-protocol-error (error) error)))) + (ensure-true (typep condition 'http-protocol-error)) + (ensure-equal :http2-read (http-error-operation condition)) + (ensure-equal '(0 3) (http-protocol-error-detail condition))) + (http-kit/http2:close-http2-connection connection))) + +#+sbcl +(deftest http2-coverage-scheduler-callback-flow-credit-and-retirement + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/body")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (clock (lambda () 0)) + (chunks nil) + (information-statuses nil)) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry)) + (ensure-true + (http-kit/http2::%h2-scheduler-queue-callback + connection entry + (list :information + (lambda (response) + (push (http-response-status response) information-statuses)) + (make-http-response :status 103)))) + (http-kit/http2::%h2-scheduler-run-entry-callbacks connection entry clock) + (ensure-equal '(103) (nreverse information-statuses)) + (ensure-true + (http-kit/http2::%h2-scheduler-queue-callback + connection entry (list :body (lambda (chunk) (push (copy-seq chunk) chunks)) + (octets 97 98) 2 nil))) + (ensure-true + (http-kit/http2::%h2-scheduler-queue-callback + connection entry (list :body (lambda (chunk) (push (copy-seq chunk) chunks)) + (octets 99 100 101) 3 nil))) + (http-kit/http2::%h2-scheduler-run-entry-callbacks connection entry clock) + (ensure-equal (list (octets 97 98) (octets 99 100 101)) (nreverse chunks)) + (let* ((reader (http-kit/http2::%h2-reader-for (binary-session-output stream))) + (frames nil)) + (loop for frame = (http-kit/http2::%h2-read-frame reader 16384 nil nil) + until (eq frame :eof) + do (push frame frames)) + (setf frames (nreverse frames)) + (ensure-equal '(1 0 1 0) + (mapcar #'http-kit/http2::%h2-frame-stream-id frames)) + (ensure-equal '(2 2 3 3) + (mapcar (lambda (frame) + (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload frame) 0)) + frames))) + (let ((callback-error nil)) + (ensure-true + (http-kit/http2::%h2-scheduler-queue-callback + connection entry + (list :body (lambda (chunk) + (declare (ignore chunk)) + (error "Consumer rejected the response chunk.")) + (octets 120) 1 nil))) + (handler-case + (http-kit/http2::%h2-scheduler-run-entry-callbacks + connection entry clock) + (error (condition) (setf callback-error condition))) + (ensure-true (typep callback-error 'simple-error)) + (ensure-true (eq callback-error (http-kit/http2::%h2-batch-entry-error entry))) + (ensure-true (http-kit/http2::%h2-batch-entry-local-retired-p entry)) + (ensure-equal 0 (length (http-kit/http2::%h2-batch-entry-body-vector entry))) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-false + (http-kit/http2::%h2-scheduler-queue-callback + connection entry (list :body #'identity (octets) 0 nil))) + (let* ((reader + (http-kit/http2::%h2-reader-for (binary-session-output stream))) + (frames nil)) + (loop for frame = (http-kit/http2::%h2-read-frame reader 16384 nil nil) + until (eq frame :eof) + do (push frame frames)) + (setf frames (nreverse frames)) + (ensure-equal 6 (length frames)) + (let ((window-update (fifth frames)) + (reset (sixth frames))) + (ensure-equal 8 (http-kit/http2::%h2-frame-type window-update)) + (ensure-equal 0 (http-kit/http2::%h2-frame-stream-id window-update)) + (ensure-equal (octets 0 0 0 1) + (http-kit/http2::%h2-frame-payload window-update)) + (ensure-equal 3 (http-kit/http2::%h2-frame-type reset)) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id reset)) + (ensure-equal (octets 0 0 0 8) + (http-kit/http2::%h2-frame-payload reset))))) + (http-kit/http2:close-http2-connection connection))) +#+sbcl +(deftest http2-coverage-scheduler-retirement-and-control-state + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/state")) + (clock (lambda () 0)) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (existing-error + (make-condition 'simple-error :format-control "Existing entry error.")) + (replacement-error + (make-condition 'simple-error :format-control "Replacement error."))) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-error entry) existing-error + (http-kit/http2::%h2-batch-entry-callback-events entry) + (list (list :body #'identity (octets 97 98) 2 nil))) + (http-kit/http2::%h2-scheduler-retire-entry + connection entry replacement-error clock) + (ensure-true (eq existing-error (http-kit/http2::%h2-batch-entry-error entry))) + (ensure-true (http-kit/http2::%h2-batch-entry-local-retired-p entry)) + (ensure-false (http-kit/http2::%http2-connection-scheduler-entries connection)) + (let ((expected + (concatenate-octets + (http-kit/http2::%h2-frame-wire 8 0 0 (octets 0 0 0 2)) + (http-kit/http2::%h2-frame-wire 3 0 1 (octets 0 0 0 8))))) + (ensure-equal expected (binary-session-output stream))) + (let* ((entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 3)) + (callback-called-p nil) + (before (copy-seq (binary-session-output stream)))) + (setf (http-kit/http2::%h2-batch-entry-error entry) existing-error + (http-kit/http2::%h2-batch-entry-callback-events entry) + (list (list :body (lambda (chunk) + (declare (ignore chunk)) + (setf callback-called-p t)) + (octets 99) 1 t))) + (http-kit/http2::%h2-scheduler-run-entry-callbacks + connection entry clock) + (ensure-false callback-called-p) + (ensure-false (http-kit/http2::%h2-batch-entry-callback-events entry)) + (ensure-equal + (http-kit/http2::%h2-frame-wire 8 0 0 (octets 0 0 0 1)) + (subseq (binary-session-output stream) (length before)))) + (let* ((entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 5)) + (callback-error nil)) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry)) + (http-kit/http2::%h2-scheduler-queue-callback + connection entry + (list :information (lambda (response) + (declare (ignore response)) + (error "Information callback failed.")) + (make-http-response :status 103))) + (handler-case + (http-kit/http2::%h2-scheduler-run-entry-callbacks + connection entry clock) + (error (condition) (setf callback-error condition))) + (ensure-true (typep callback-error 'simple-error)) + (ensure-true (http-kit/http2::%h2-batch-entry-local-retired-p entry))) + (let* ((failure (make-condition 'simple-error + :format-control "Control write failed.")) + (failing-stream + (make-instance 'h2-control-write-failure-stream + :input (octets) :failure failure)) + (failing-connection + (http-kit/http2:make-http2-connection :stream failing-stream)) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (observed nil)) + (setf (http-kit/http2::%http2-connection-scheduler-entries failing-connection) + (list entry) + (h2-control-write-failure-armed-p failing-stream) t) + (handler-case + (http-kit/http2::%h2-scheduler-retire-entry + failing-connection entry replacement-error clock) + (error (condition) (setf observed condition))) + (ensure-true (eq failure observed)) + (ensure-false (http-kit/http2:http2-connection-open-p failing-connection)) + (http-kit/http2:close-http2-connection failing-connection)) + (let* ((entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (response (make-http-response :status 200))) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-local-retired-p entry) t) + (http-kit/http2::%h2-scheduler-mark-response connection entry response) + (ensure-false (http-kit/http2::%h2-batch-entry-response entry)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection))) + (setf (http-kit/http2::%http2-connection-goaway-last-stream-id connection) 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) nil) + (http-kit/http2::%h2-scheduler-close-goaway-retired-if-idle connection) + (ensure-false (http-kit/http2:http2-connection-open-p connection)) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/control")) + (clock (lambda () 0)) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1))) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry)) + (labels ((control (frame) + (http-kit/http2::%h2-scheduler-control-frame connection frame nil)) + (protocol-error (frame) + (handler-case (progn (control frame) nil) + (http-protocol-error (condition) condition)))) + (let* ((failure (make-condition 'simple-error + :format-control "Ping waiter failed.")) + (waiter + (http-kit/http2::%make-h2-scheduler-ping-waiter + (octets 1 2 3 4 5 6 7 8)))) + (setf (http-kit/http2::%http2-connection-scheduler-ping-waiters + connection) (list waiter)) + (ensure-equal :http2-client + (http-error-operation + (protocol-error + (h2-frame-object 6 0 1 (octets 1 2 3 4 5 6 7 8))))) + (setf (http-kit/http2::%h2-scheduler-ping-waiter-failure waiter) failure) + (ensure-equal :http2-control + (http-error-operation + (protocol-error + (h2-frame-object 6 0 1 (octets 1 2 3 4 5 6 7 8))))) + (setf (http-kit/http2::%h2-scheduler-ping-waiter-failure waiter) nil + (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p waiter) t) + (control (h2-frame-object 6 1 0 (octets 1 2 3 4 5 6 7 8)))) + (dolist (case (list (list (h2-frame-object 3 0 0 (octets)) '(0 0)) + (list (h2-frame-object 7 0 1 + (octets 0 0 0 1 0 0 0 0)) + '(1 8)) + (list (h2-frame-object 7 0 0 + (octets 128 0 0 0 0 0 0 0)) + #x80000000))) + (let ((failure (protocol-error (first case)))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal (second case) (http-protocol-error-detail failure)))) + (setf (http-kit/http2::%h2-batch-entry-error entry) + (make-condition 'simple-error :format-control "Keep this error.") + (http-kit/http2::%http2-connection-goaway-last-stream-id connection) nil) + (control (h2-frame-object 7 0 0 (octets 0 0 0 0 0 0 0 0))) + (ensure-true (http-kit/http2::%h2-batch-entry-error entry)) + (setf (http-kit/http2::%h2-batch-entry-error entry) nil + (http-kit/http2::%h2-batch-entry-local-retired-p entry) t + (http-kit/http2::%http2-connection-goaway-last-stream-id connection) nil) + (control (h2-frame-object 7 0 0 (octets 0 0 0 0 0 0 0 0))) + (ensure-false (http-kit/http2::%http2-connection-scheduler-entries connection)) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-error entry) + (make-condition 'simple-error :format-control "Already reset.") + (http-kit/http2::%h2-batch-entry-local-retired-p entry) t + (http-kit/http2::%http2-connection-goaway-last-stream-id connection) nil) + (control (h2-frame-object 3 0 1 (octets 0 0 0 8))) + (ensure-false (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-false (http-kit/http2::%h2-scheduler-previously-opened-client-stream-p + connection 2)) + (control (h2-frame-object 2 0 1 (octets 0 0 0 0 0))) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 255 0 0 (octets)) nil nil nil clock)) + (http-kit/http2:close-http2-connection connection))) +#+sbcl +(deftest http2-coverage-scheduler-active-stream-frame-states + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/active")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (clock (lambda () 0)) + (information nil)) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-session-started-p connection) t + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-on-information entry) + (lambda (response) + (push (http-response-status response) information))) + (let* ((block (h2-header-block (cons ":status" "103"))) + (split (max 1 (floor (length block) 2))) + (reader (h2-reader-from-frames + (h2-frame 9 4 1 (subseq block split))))) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 1 0 1 (subseq block 0 split)) + reader nil nil clock)) + (ensure-equal '(103) + (mapcar (lambda (event) + (http-response-status (third event))) + (http-kit/http2::%h2-batch-entry-callback-events entry))) + (http-kit/http2::%h2-scheduler-run-entry-callbacks connection entry clock) + (ensure-equal '(103) information) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection + (h2-frame-object + 1 4 1 (h2-header-block (cons ":status" "200") + (cons "content-length" "2"))) + nil nil nil clock) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 1 1 (octets 97 98)) nil nil nil clock) + (ensure-true (http-kit/http2::%h2-batch-entry-response entry)) + (ensure-equal (octets 97 98) + (http-response-body (http-kit/http2::%h2-batch-entry-response entry))) + (dolist (frame (list + (h2-frame-object + 1 4 1 (h2-header-block (cons ":status" "204"))) + (h2-frame-object 0 1 1 (octets 99)))) + (let ((failure + (handler-case + (progn + (http-kit/http2::%h2-scheduler-dispatch-frame + connection frame nil nil nil clock) + nil) + (http-protocol-error (condition) condition)))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal :http2-read (http-error-operation failure)))) + (let* ((retired (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 3))) + (setf (http-kit/http2::%http2-connection-next-stream-id connection) 5 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 3 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list retired) + (http-kit/http2::%h2-batch-entry-local-retired-p retired) t) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 1 3 (octets 120)) nil nil nil clock) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection))) + (let* ((errored (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 5))) + (setf (http-kit/http2::%http2-connection-next-stream-id connection) 7 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 5 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list errored) + (http-kit/http2::%h2-batch-entry-status errored) 200 + (http-kit/http2::%h2-batch-entry-error errored) + (make-condition 'simple-error :format-control "Retired response.")) + (vector-push-extend 97 + (http-kit/http2::%h2-batch-entry-body-vector errored)) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 5 (octets 98)) nil nil nil clock) + (ensure-equal 0 + (length (http-kit/http2::%h2-batch-entry-body-vector errored)))) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/closed")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (clock (lambda () 0))) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-closed-p connection) t + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-status entry) 200) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) nil nil nil clock) + (ensure-equal 0 (length (binary-session-output stream))) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/retired")) + (clock (lambda () 0)) + (waiter + (http-kit/http2::%make-h2-scheduler-ping-waiter + (octets 1 2 3 4 5 6 7 8))) + (failure (make-condition 'simple-error :format-control "Ping failed."))) + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) nil + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 1 + (http-kit/http2::%http2-connection-scheduler-ping-waiters connection) + (list waiter)) + (let ((condition + (handler-case + (progn + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) + nil nil nil clock) + nil) + (http-protocol-error (observed) observed)))) + (ensure-equal :http2-client (http-error-operation condition))) + (setf (http-kit/http2::%h2-scheduler-ping-waiter-failure waiter) failure) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) nil nil nil clock) + (let ((entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 3))) + (setf (http-kit/http2::%http2-connection-next-stream-id connection) 5 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) 3 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-scheduler-ping-waiter-failure waiter) nil) + (setf (http-kit/http2::%h2-batch-entry-error entry) failure) + (let ((condition + (handler-case + (progn + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) + nil nil nil clock) + nil) + (http-protocol-error (observed) observed)))) + (ensure-equal :http2-client (http-error-operation condition))) + (setf (http-kit/http2::%h2-batch-entry-error entry) nil) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) nil nil nil clock) + (setf (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p waiter) t) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) nil nil nil clock)) + (ensure-true (plusp (length (binary-session-output stream)))) + (http-kit/http2:close-http2-connection connection))) +#+sbcl +(deftest http2-coverage-serial-fallback-boundaries + (let* ((request (make-http-request :method "GET" :uri "https://example.com/serial")) + (stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream))) + (let ((failure + (handler-case + (http-kit/http2::%h2-send-http2-request-over-connection-serial + :invalid request) + (http-protocol-error (condition) condition)))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal :http2-client (http-error-operation failure))) + (dolist (options '((:on-body-chunk :invalid) + (:on-information :invalid) + (:on-stream-open :invalid) + (:collect-body-p :invalid))) + (let ((failure + (handler-case + (apply #'http-kit/http2::%h2-send-http2-request-over-connection-serial + connection request options) + (http-protocol-error (condition) condition)))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal :http2-client (http-error-operation failure)))) + (ensure-equal 0 (length (binary-session-output stream))) + (let* ((closed-stream (make-instance 'binary-session-stream :input (octets))) + (closed-connection + (http-kit/http2:make-http2-connection :stream closed-stream))) + (http-kit/http2:close-http2-connection closed-connection) + (let ((failure + (handler-case + (http-kit/http2::%h2-send-http2-request-over-connection-serial + closed-connection request) + (http-connection-error (condition) condition)))) + (ensure-true (typep failure 'http-connection-error)) + (ensure-equal :closed (http-connection-error-cause failure)))) + (http-kit/http2:close-http2-connection connection)) + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 4 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "2"))) + (h2-frame 0 1 1 (octets 97 98)))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (opened nil) + (chunks nil) + (request + (make-http-request :method "POST" :uri "https://example.com/upload" + :body (octets 120 121))) + (response + (http-kit/http2::%h2-send-http2-request-over-connection-serial + connection request + :collect-body-p nil + :on-body-chunk (lambda (chunk) (push (copy-seq chunk) chunks)) + :on-stream-open + (lambda (stream-id cancel) + (setf opened stream-id) + (funcall cancel))))) + (ensure-equal 1 opened) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets) (http-response-body response)) + (ensure-equal (list (octets 97 98)) chunks) + (let* ((frames (h2-output-frames stream)) + (reset (find 3 frames :key #'http-kit/http2::%h2-frame-type)) + (data (find 0 frames :key #'http-kit/http2::%h2-frame-type))) + (ensure-true reset) + (ensure-equal (octets 0 0 0 8) + (http-kit/http2::%h2-frame-payload reset)) + (ensure-true data) + (ensure-equal (octets 120 121) + (http-kit/http2::%h2-frame-payload data))) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream + (make-instance 'binary-session-stream + :input (h2-frame 6 0 0 (octets 1 2 3 4 5 6 7 8)))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (reader (http-kit/http2::%h2-reader-for stream)) + (writer (http-kit/http2::%h2-writer stream nil (lambda () 0))) + (failure nil)) + (setf (http-kit/http2::%http2-connection-peer-connection-window-size + connection) 0) + (handler-case + (http-kit/http2::%h2-connection-send-request-body + connection reader writer 1 (octets 97) nil nil nil 16384 nil nil + (lambda () 0) t nil) + (http-protocol-error (condition) (setf failure condition))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal :http2-read (http-error-operation failure)) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (update (h2-frame-object 8 0 1 (octets 0 0 0 2)))) + (http-kit/http2::%h2-connection-note-window-update connection update 1) + (ensure-equal 65537 + (cdr (assoc 1 + (http-kit/http2::%http2-connection-peer-stream-windows + connection)))) + (setf (http-kit/http2::%http2-connection-peer-stream-windows connection) nil) + (http-kit/http2::%h2-connection-note-window-update connection update 3) + (ensure-false + (assoc 1 (http-kit/http2::%http2-connection-peer-stream-windows connection))) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (writer (http-kit/http2::%h2-writer stream nil (lambda () 0))) + (condition nil)) + (handler-case + (http-kit/http2::%h2-connection-control-handler + connection (h2-frame-object 7 0 0 + (octets 0 0 0 1 0 0 0 0)) + writer 3) + (http-connection-error (observed) (setf condition observed))) + (ensure-equal '(:goaway 1 0) (http-connection-error-cause condition)) + (http-kit/http2::%h2-connection-control-handler + connection (h2-frame-object 2 0 1 (octets 0 0 0 0 0)) writer 1) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream + (make-instance 'binary-session-stream + :input (h2-frame 4 0 0 (octets 0 3 0 0 0 1)))) + (connection (http-kit/http2:make-http2-connection :stream stream))) + (setf (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection) 0) + (ensure-equal 1 + (http-kit/http2::%h2-connection-wait-for-stream-capacity + connection (http-kit/http2::%h2-reader-for stream) + (http-kit/http2::%h2-writer stream nil (lambda () 0)) + nil (lambda () 0))) + (http-kit/http2:close-http2-connection connection)) + (dolist (input (list (octets) + (h2-frame 1 4 1 + (h2-header-block (cons ":status" "200"))))) + (let* ((stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (failure nil)) + (setf (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection) 0) + (handler-case + (http-kit/http2::%h2-connection-wait-for-stream-capacity + connection (http-kit/http2::%h2-reader-for stream) + (http-kit/http2::%h2-writer stream nil (lambda () 0)) + nil (lambda () 0)) + (http-error (condition) (setf failure condition))) + (ensure-true (typep failure 'http-error)) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream + (make-instance 'binary-session-stream + :input (h2-frame 7 0 0 + (octets 0 0 0 1 0 0 0 0)))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (failure nil)) + (setf (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection) 0) + (handler-case + (http-kit/http2::%h2-connection-wait-for-stream-capacity + connection (http-kit/http2::%h2-reader-for stream) + (http-kit/http2::%h2-writer stream nil (lambda () 0)) + nil (lambda () 0)) + (http-connection-error (condition) (setf failure condition))) + (ensure-equal '(:goaway 1 1) (http-connection-error-cause failure)) + (http-kit/http2:close-http2-connection connection)) + (let* ((stream + (make-instance 'binary-session-stream + :input (h2-frame 4 0 0 (octets)))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "CONNECT" :protocol "websocket" + :uri "https://example.com/chat")) + (failure nil)) + (handler-case + (http-kit/http2::%h2-send-http2-request-over-connection-serial + connection request) + (http-protocol-error (condition) (setf failure condition))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal :http2-write (http-error-operation failure)) + (ensure-false (http-kit/http2:http2-connection-open-p connection)) + (ensure-false (open-stream-p stream)) + (http-kit/http2:close-http2-connection connection))) +#+sbcl +(deftest http2-coverage-scheduler-upload-and-response-body + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 4 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "2"))) + (h2-frame 0 1 1 (octets 111 107)))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "POST" + :uri "https://example.com/scheduled-upload")) + (body-chunks (list (octets 117 112))) + (received-chunks nil)) + (unwind-protect + (let ((response + (http-kit/http2:send-http2-request-over-connection + connection request + :request-body-function + (lambda (maximum-size) + (ensure-true (>= maximum-size 2)) + (pop body-chunks)) + :request-body-length 2 + :on-body-chunk + (lambda (payload) + (push (copy-seq payload) received-chunks))))) + (ensure-false body-chunks) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets 111 107) (http-response-body response)) + (ensure-equal (list (octets 111 107)) (nreverse received-chunks)) + (let* ((frames (h2-output-frames stream)) + (reset (find 3 frames :key #'http-kit/http2::%h2-frame-type)) + (data (find 0 frames :key #'http-kit/http2::%h2-frame-type))) + (ensure-false reset) + (ensure-true data) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id data)) + (ensure-equal (octets 117 112) + (http-kit/http2::%h2-frame-payload data)) + (ensure-equal 1 + (logand 1 (http-kit/http2::%h2-frame-flags data))) + (ensure-equal 1 + (count 0 frames + :key #'http-kit/http2::%h2-frame-type)))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-cancel-retires-slot-and-wakes-capacity-waiter + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets 0 3 0 0 0 1)) + (h2-frame 1 5 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "0"))))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (wait-symbol 'http-kit/http2::%h2-scheduler-condition-wait) + (original-wait (symbol-function wait-symbol)) + (wait-entered (sb-thread:make-semaphore :count 0)) + (waiter-finished (sb-thread:make-semaphore :count 0)) + (waiter-thread nil) + (first-stream-id nil) + (second-stream-id nil) + (second-entry-stream-ids nil) + (first-error nil) + (second-error nil) + (producer-calls 0)) + (unwind-protect + (progn + (let ((response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://example.com/cancel-warmup")))) + (ensure-equal 200 (http-response-status response))) + ;; Keep peer capacity and sleep the waiter without consuming fixture EOF. + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf (http-kit/http2::%http2-connection-scheduler-reader-active-p + connection) + t)) + (setf (symbol-function wait-symbol) + (lambda (wait-connection deadline clock-function) + (sb-thread:signal-semaphore wait-entered) + (funcall original-wait wait-connection deadline clock-function))) + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "POST" + :uri "https://example.com/cancel-owner") + :request-body-function + (lambda (maximum-size) + (declare (ignore maximum-size)) + (incf producer-calls) + (octets 97)) + :request-body-length 1 + :on-stream-open + (lambda (stream-id cancel) + (setf first-stream-id stream-id) + (setf waiter-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request + :method "POST" + :uri "https://example.com/cancel-waiter") + :request-body-function + (lambda (maximum-size) + (declare (ignore maximum-size)) + (incf producer-calls) + (octets 98)) + :request-body-length 1 + :on-stream-open + (lambda (opened-stream-id cancel-waiter) + (setf second-stream-id opened-stream-id + second-entry-stream-ids + (http-kit/http2::%h2-with-scheduler-lock + (connection) + (mapcar + #'http-kit/http2::%h2-batch-entry-stream-id + (http-kit/http2::%http2-connection-scheduler-entries + connection)))) + (funcall cancel-waiter))) + (error (condition) + (setf second-error condition))) + (sb-thread:signal-semaphore waiter-finished))))) + (ensure-true + (sb-thread:wait-on-semaphore wait-entered :timeout 5)) + (funcall cancel) + (ensure-true + (sb-thread:wait-on-semaphore waiter-finished :timeout 5)))) + (error (condition) + (setf first-error condition))) + (when waiter-thread + (sb-thread:join-thread waiter-thread) + (setf waiter-thread nil)) + (ensure-equal 3 first-stream-id) + (ensure-equal 5 second-stream-id) + (ensure-equal '(5) second-entry-stream-ids) + (ensure-true (typep first-error 'http-connection-error)) + (ensure-equal '(:local-cancel 3 8) + (http-connection-error-cause first-error)) + (ensure-true (typep second-error 'http-connection-error)) + (ensure-equal '(:local-cancel 5 8) + (http-connection-error-cause second-error)) + (ensure-equal 0 producer-calls) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-true + (http-kit/http2::%h2-scheduler-capacity-available-p connection)) + (let* ((frames (h2-output-frames stream)) + (resets + (sort + (loop for frame in frames + when (= 3 (http-kit/http2::%h2-frame-type frame)) + collect + (list + (http-kit/http2::%h2-frame-stream-id frame) + (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload frame) 0))) + #'< :key #'first))) + (ensure-equal '((3 8) (5 8)) resets) + (ensure-equal 0 + (count 0 frames + :key #'http-kit/http2::%h2-frame-type))) + (setf (symbol-function wait-symbol) original-wait) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf (http-kit/http2::%http2-connection-scheduler-reader-active-p + connection) + nil) + (http-kit/http2::%h2-scheduler-broadcast connection)) + (http-kit/http2:close-http2-connection connection) + (when waiter-thread + (ignore-errors (sb-thread:join-thread waiter-thread))))))) +#+sbcl +(deftest http2-coverage-scheduler-explicit-cancel-code + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 5 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "0"))))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (opened-stream nil) + (failure nil)) + (unwind-protect + (progn + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://example.com/cancel-code") + :on-stream-open + (lambda (stream-id cancel) + (setf opened-stream stream-id) + (funcall cancel :error-code 2))) + (error (condition) + (setf failure condition))) + (ensure-equal 1 opened-stream) + (ensure-true (typep failure 'http-connection-error)) + (ensure-equal '(:local-cancel 1 2) + (http-connection-error-cause failure)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (let* ((frames (h2-output-frames stream)) + (reset (find 3 frames :key #'http-kit/http2::%h2-frame-type))) + (ensure-true reset) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id reset)) + (ensure-equal (octets 0 0 0 2) + (http-kit/http2::%h2-frame-payload reset)))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-default-cancel-code + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 5 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "0"))))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (opened-stream nil) + (failure nil)) + (unwind-protect + (progn + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://example.com/default-cancel") + :on-stream-open + (lambda (stream-id cancel) + (setf opened-stream stream-id) + (funcall cancel))) + (error (condition) + (setf failure condition))) + (ensure-equal 1 opened-stream) + (ensure-true (typep failure 'http-connection-error)) + (ensure-equal '(:local-cancel 1 8) + (http-connection-error-cause failure)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (let* ((frames (h2-output-frames stream)) + (reset (find 3 frames :key #'http-kit/http2::%h2-frame-type))) + (ensure-true reset) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id reset)) + (ensure-equal (octets 0 0 0 8) + (http-kit/http2::%h2-frame-payload reset)))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-capacity-recheck-after-settings + (let* ((input (h2-frame 4 0 0 (octets 0 3 0 0 0 1))) + (session-prefix + (concatenate-octets + (h2-preface) + (http-kit/http2::%h2-settings-wire + http-kit/http2::+http2-default-max-frame-size+))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection + :stream stream + :max-frame-size + http-kit/http2::+http2-default-max-frame-size+)) + (request + (make-http-request :method "GET" :uri "https://example.com/capacity")) + (reader (http-kit/http2::%h2-reader-for stream)) + (clock (lambda () 0)) + (writer (http-kit/http2::%h2-scheduler-writer connection nil clock)) + (capacity-symbol + 'http-kit/http2::%h2-scheduler-capacity-available-p) + (original-capacity + (symbol-function 'http-kit/http2::%h2-scheduler-capacity-available-p)) + (capacity-checks 0) + (first-capacity nil) + (second-capacity t) + (entries-at-second-check nil) + (entry nil)) + (unwind-protect + (progn + (write-sequence session-prefix stream) + (setf (http-kit/http2::%http2-connection-session-started-p + connection) + t + (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) + nil + (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection) + 1 + (symbol-function capacity-symbol) + (lambda (checked-connection) + (let ((available (funcall original-capacity + checked-connection))) + (incf capacity-checks) + (cond + ((= capacity-checks 1) + (setf first-capacity available + (http-kit/http2::%http2-connection-peer-max-concurrent-streams + checked-connection) + 0)) + ((= capacity-checks 2) + (setf second-capacity available + entries-at-second-check + (length + (http-kit/http2::%http2-connection-scheduler-entries + checked-connection))))) + available))) + (setf entry + (http-kit/http2::%h2-scheduler-open-entry + connection request nil nil + (http-kit/http2::%http2-connection-max-header-bytes + connection) + (http-kit/http2::%http2-connection-max-fields connection) + (http-kit/http2::%http2-connection-max-body-bytes connection) + nil clock nil nil nil t reader writer)) + (ensure-true first-capacity) + (ensure-false second-capacity) + (ensure-equal 0 entries-at-second-check) + (ensure-true (>= capacity-checks 4)) + (ensure-equal 1 + (http-kit/http2::%h2-batch-entry-stream-id entry)) + (ensure-equal (list entry) + (http-kit/http2::%http2-connection-scheduler-entries + connection)) + (ensure-equal 1 + (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection)) + (ensure-equal 3 + (http-kit/http2::%http2-connection-next-stream-id + connection)) + (ensure-equal (length input) + (binary-session-input-position stream)) + (ensure-equal session-prefix + (subseq (binary-session-output stream) + 0 (length session-prefix))) + (let* ((frames (h2-output-frames stream)) + (headers (find 1 frames + :key #'http-kit/http2::%h2-frame-type))) + (ensure-equal '(4 4 1) + (mapcar #'http-kit/http2::%h2-frame-type frames)) + (ensure-equal '(0 1 5) + (mapcar #'http-kit/http2::%h2-frame-flags frames)) + (ensure-true headers) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id headers)))) + (setf (symbol-function capacity-symbol) original-capacity) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-upload-window-recheck + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0)) + (reader (http-kit/http2::%h2-reader-for stream)) + (writer (http-kit/http2::%h2-writer stream nil clock)) + (check-symbol 'http-kit::%check-limit) + (original-check (symbol-function 'http-kit::%check-limit)) + (check-lock (sb-thread:make-mutex :name "HTTP/2 upload check barrier")) + (check-arrived (sb-thread:make-semaphore :count 0)) + (release-checks (sb-thread:make-semaphore :count 0)) + (check-count 0) + (flow-waits 0) + (producer-calls (make-array 2 :initial-element 0)) + (results (make-array 2 :initial-element nil)) + (thread-errors (make-array 2 :initial-element nil)) + (threads (make-array 2 :initial-element nil))) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-peer-connection-window-size + connection) + 1 + (http-kit/http2::%http2-connection-peer-stream-windows + connection) + (list (cons 1 1) (cons 3 1)) + (symbol-function check-symbol) + (lambda (&rest arguments) + (multiple-value-prog1 + (apply original-check arguments) + (when (eq (first arguments) :body) + (let ((barrier-p nil)) + (sb-thread:with-mutex (check-lock) + (when (< check-count 2) + (incf check-count) + (setf barrier-p t))) + (when barrier-p + (sb-thread:signal-semaphore check-arrived) + (unless (sb-thread:wait-on-semaphore + release-checks :timeout 5) + (error "Timed out at the HTTP/2 upload barrier.")))))))) + (dotimes (index 2) + (let* ((thread-index index) + (stream-id (if (zerop thread-index) 1 3)) + (payload (if (zerop thread-index) 97 99))) + (setf (aref threads thread-index) + (sb-thread:make-thread + (lambda () + (handler-case + (setf (aref results thread-index) + (multiple-value-list + (http-kit/http2::%h2-connection-send-request-body + connection reader writer stream-id (octets) + (lambda (maximum-size) + (declare (ignore maximum-size)) + (incf + (aref producer-calls thread-index)) + (if (= (aref producer-calls thread-index) 1) + (octets payload) + nil)) + 1 nil 16384 nil nil clock nil nil + :scheduler-p t + :flow-wait-function + (lambda (flow-connection flow-stream-id + deadline clock-function) + (declare (ignore flow-stream-id + deadline + clock-function)) + (http-kit/http2::%h2-with-scheduler-lock + (flow-connection) + (incf + (http-kit/http2::%http2-connection-peer-connection-window-size + flow-connection)) + (incf flow-waits)))))) + (error (condition) + (setf (aref thread-errors thread-index) + condition)))))))) + (loop repeat 2 + do (ensure-true + (sb-thread:wait-on-semaphore check-arrived :timeout 5))) + (loop repeat 2 do (sb-thread:signal-semaphore release-checks)) + (dotimes (index 2) + (let ((thread (aref threads index))) + (sb-thread:join-thread thread) + (setf (aref threads index) nil))) + (ensure-equal 2 check-count) + (ensure-equal 1 flow-waits) + (ensure-equal '(1 1) (coerce producer-calls 'list)) + (ensure-equal '((nil nil) (nil nil)) (coerce results 'list)) + (ensure-equal '(nil nil) (coerce thread-errors 'list)) + (ensure-equal 0 + (http-kit/http2::%http2-connection-peer-connection-window-size + connection)) + (ensure-equal 0 (cdr (assoc 1 + (http-kit/http2::%http2-connection-peer-stream-windows + connection)))) + (ensure-equal 0 (cdr (assoc 3 + (http-kit/http2::%http2-connection-peer-stream-windows + connection)))) + (let* ((frame-reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (first-frame (http-kit/http2::%h2-read-frame + frame-reader 16384 nil nil)) + (second-frame (http-kit/http2::%h2-read-frame + frame-reader 16384 nil nil)) + (frames (list first-frame second-frame)) + (first-data (find 1 frames + :key #'http-kit/http2::%h2-frame-stream-id)) + (second-data (find 3 frames + :key #'http-kit/http2::%h2-frame-stream-id))) + (ensure-equal 2 (count 0 frames + :key #'http-kit/http2::%h2-frame-type)) + (ensure-true first-data) + (ensure-true second-data) + (ensure-equal (octets 97) + (http-kit/http2::%h2-frame-payload first-data)) + (ensure-equal (octets 99) + (http-kit/http2::%h2-frame-payload second-data)) + (ensure-equal 1 + (logand 1 + (http-kit/http2::%h2-frame-flags first-data))) + (ensure-equal 1 + (logand 1 + (http-kit/http2::%h2-frame-flags second-data))))) + (loop repeat 2 do (sb-thread:signal-semaphore release-checks)) + (dotimes (index 2) + (let ((thread (aref threads index))) + (when thread + (sb-thread:join-thread thread) + (setf (aref threads index) nil)))) + (setf (symbol-function check-symbol) original-check) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-upload-credit-and-malformed-goaway + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 8 0 0 (octets 0 0 0 1)) + (h2-frame 1 4 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "2"))) + (h2-frame 0 1 1 (octets 111 107)))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (body-chunks (list (octets 117 112))) + (producer-calls 0)) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-peer-connection-window-size + connection) + 1) + (let ((response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "POST" + :uri "https://example.com/window-resumption") + :request-body-function + (lambda (maximum-size) + (incf producer-calls) + (ensure-true (>= maximum-size 2)) + (pop body-chunks)) + :request-body-length 2))) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets 111 107) (http-response-body response))) + (ensure-equal 1 producer-calls) + (ensure-false body-chunks) + (let* ((data-frames + (remove-if-not + (lambda (frame) + (= 0 (http-kit/http2::%h2-frame-type frame))) + (h2-output-frames stream)))) + (ensure-equal 2 (length data-frames)) + (ensure-equal (list (octets 117) (octets 112)) + (mapcar #'http-kit/http2::%h2-frame-payload + data-frames)) + (ensure-equal (list 0 1) + (mapcar (lambda (frame) + (logand 1 + (http-kit/http2::%h2-frame-flags + frame))) + data-frames)) + (ensure-equal 0 + (http-kit/http2::%http2-connection-peer-connection-window-size + connection)))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (writer (http-kit/http2::%h2-writer stream nil (lambda () 0)))) + (unwind-protect + (dolist (case + (list (list (h2-frame-object + 7 0 1 (octets 0 0 0 0 0 0 0 0)) + (list 1 8)) + (list (h2-frame-object + 7 0 0 (octets 128 0 0 0 0 0 0 0)) + #x80000000))) + (let ((failure + (handler-case + (progn + (http-kit/http2::%h2-connection-control-handler + connection (first case) writer 1) + nil) + (http-protocol-error (condition) condition)))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal :http2-control (http-error-operation failure)) + (ensure-equal (second case) + (http-protocol-error-detail failure)) + (ensure-false + (http-kit/http2::%http2-connection-goaway-last-stream-id + connection)))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-serial-and-scheduled-upload-boundaries + (let* ((input + (concatenate-octets + (h2-frame 8 0 0 (octets 0 0 0 1)) + (h2-frame 8 0 1 (octets 0 0 0 1)))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0)) + (reader (http-kit/http2::%h2-reader-for stream)) + (writer (http-kit/http2::%h2-writer stream nil clock))) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-peer-connection-window-size + connection) + 0 + (http-kit/http2::%http2-connection-peer-stream-windows + connection) + (list (cons 1 0))) + (multiple-value-bind (pending first-settings-p) + (http-kit/http2::%h2-connection-send-request-body + connection reader writer 1 (octets 97) nil 1 1 16384 nil nil + clock nil nil) + (ensure-false pending) + (ensure-false first-settings-p)) + (let* ((frame-reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (frame (http-kit/http2::%h2-read-frame + frame-reader 16384 nil nil))) + (ensure-equal 0 (http-kit/http2::%h2-frame-type frame)) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id frame)) + (ensure-equal (octets 97) + (http-kit/http2::%h2-frame-payload frame)) + (ensure-equal 1 + (logand 1 (http-kit/http2::%h2-frame-flags frame)))) + (ensure-equal 0 + (http-kit/http2::%http2-connection-peer-connection-window-size + connection)) + (ensure-equal 0 + (cdr (assoc + 1 + (http-kit/http2::%http2-connection-peer-stream-windows + connection)))) + (ensure-equal (length input) (binary-session-input-position stream))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0)) + (reader (http-kit/http2::%h2-reader-for stream)) + (writer (http-kit/http2::%h2-writer stream nil clock)) + (producer-calls 0)) + (unwind-protect + (progn + (http-kit/http2::%h2-connection-send-request-body + connection reader writer 1 (octets) + (lambda (maximum-size) + (ensure-true (plusp maximum-size)) + (incf producer-calls) + (octets 98)) + 1 1 16384 nil nil clock nil nil) + (ensure-equal 1 producer-calls) + (let* ((frame-reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (frame (http-kit/http2::%h2-read-frame + frame-reader 16384 nil nil))) + (ensure-equal 0 (http-kit/http2::%h2-frame-type frame)) + (ensure-equal (octets 98) + (http-kit/http2::%h2-frame-payload frame)) + (ensure-equal 1 + (logand 1 (http-kit/http2::%h2-frame-flags frame)))) + (ensure-equal 65534 + (http-kit/http2::%http2-connection-peer-connection-window-size + connection))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0)) + (reader (http-kit/http2::%h2-reader-for stream)) + (writer (http-kit/http2::%h2-writer stream nil clock)) + (producer-calls 0)) + (unwind-protect + (progn + (http-kit/http2::%h2-connection-send-request-body + connection reader writer 1 (octets) + (lambda (maximum-size) + (declare (ignore maximum-size)) + (incf producer-calls) + nil) + nil 1 16384 nil nil clock nil nil) + (ensure-equal 1 producer-calls) + (let* ((frame-reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (frame (http-kit/http2::%h2-read-frame + frame-reader 16384 nil nil))) + (ensure-equal 0 (http-kit/http2::%h2-frame-type frame)) + (ensure-equal (octets) + (http-kit/http2::%h2-frame-payload frame)) + (ensure-equal 1 + (logand 1 (http-kit/http2::%h2-frame-flags frame))))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (clock (lambda () 0)) + (reader (http-kit/http2::%h2-reader-for stream)) + (writer (http-kit/http2::%h2-writer stream nil clock)) + (producer-calls 0)) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-peer-connection-window-size + connection) + 0 + (http-kit/http2::%http2-connection-peer-stream-windows + connection) + (list (cons 1 0))) + (http-kit/http2::%h2-connection-send-request-body + connection reader writer 1 (octets) + (lambda (maximum-size) + (declare (ignore maximum-size)) + (incf producer-calls) + nil) + nil 1 16384 nil nil clock nil nil :scheduler-p t) + (ensure-equal 1 producer-calls) + (let* ((frame-reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (frame (http-kit/http2::%h2-read-frame + frame-reader 16384 nil nil))) + (ensure-equal 0 (http-kit/http2::%h2-frame-type frame)) + (ensure-equal (octets) + (http-kit/http2::%h2-frame-payload frame)) + (ensure-equal 1 + (logand 1 (http-kit/http2::%h2-frame-flags frame)))) + (ensure-equal 0 + (http-kit/http2::%http2-connection-peer-connection-window-size + connection)) + (ensure-equal 0 + (cdr (assoc + 1 + (http-kit/http2::%http2-connection-peer-stream-windows + connection))))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-extended-connect-waits-for-peer-capacity + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 + (octets 0 8 0 0 0 1 0 3 0 0 0 0)) + (h2-frame 4 0 0 (octets 0 3 0 0 0 1)) + (h2-frame + 1 5 1 + (h2-header-block (cons ":status" "200"))))) + (stream (make-instance 'binary-session-stream :input input)) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request + (make-http-request :method "CONNECT" :protocol "websocket" + :uri "https://example.com/chat"))) + (unwind-protect + (let ((response + (http-kit/http2::%h2-send-http2-request-over-connection-serial + connection request))) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets) (http-response-body response)) + (ensure-true + (http-kit/http2::%http2-connection-session-started-p connection)) + (ensure-true + (http-kit/http2::%http2-connection-peer-enable-connect-protocol-p + connection)) + (ensure-equal 1 + (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection)) + (ensure-equal (length input) + (binary-session-input-position stream)) + (let* ((frames (h2-output-frames stream)) + (headers (remove-if-not + (lambda (frame) + (= 1 (http-kit/http2::%h2-frame-type frame))) + frames)) + (settings-acks + (remove-if-not + (lambda (frame) + (and (= 4 (http-kit/http2::%h2-frame-type frame)) + (/= 0 + (logand 1 + (http-kit/http2::%h2-frame-flags + frame))))) + frames))) + (ensure-equal 1 (length headers)) + (ensure-equal 1 + (http-kit/http2::%h2-frame-stream-id + (first headers))) + (ensure-equal 2 (length settings-acks)))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-retired-frame-lifecycle + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/retired")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (clock (lambda () 0))) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-callback-events entry) + (list (list :information #'identity + (make-http-response :status 103)) + (list :body #'identity (octets 97 98) 2 nil))) + (http-kit/http2::%h2-scheduler-retire-entry + connection entry + (make-condition 'simple-error :format-control "Retire queued callbacks.") + clock) + (ensure-true + (http-kit/http2::%h2-batch-entry-local-retired-p entry)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-false + (http-kit/http2::%h2-batch-entry-callback-events entry)) + (let* ((reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (frames nil)) + (loop for frame = (http-kit/http2::%h2-read-frame + reader 16384 nil nil) + until (eq frame :eof) + do (push frame frames)) + (setf frames (nreverse frames)) + (ensure-equal '(8 3) + (mapcar #'http-kit/http2::%h2-frame-type frames)) + (ensure-equal (octets 0 0 0 2) + (http-kit/http2::%h2-frame-payload (first frames))) + (ensure-equal (octets 0 0 0 8) + (http-kit/http2::%h2-frame-payload (second frames))))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (payload (octets 1 2 3 4 5 6 7 8)) + (waiter (http-kit/http2::%make-h2-scheduler-ping-waiter payload))) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-scheduler-ping-waiters + connection) + (list waiter) + (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p waiter) + t) + (dolist (case '((t :http2-control) (nil :http2-client))) + (setf (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p + waiter) + (first case)) + (let ((failure + (handler-case + (progn + (http-kit/http2::%h2-scheduler-control-frame + connection (h2-frame-object 6 0 1 payload) nil) + nil) + (http-protocol-error (condition) condition)))) + (ensure-true (typep failure 'http-protocol-error)) + (ensure-equal (second case) + (http-error-operation failure))))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/data")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (clock (lambda () 0))) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) + nil + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) + 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-local-retired-p entry) + t) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 0 1 (octets 97)) nil nil nil clock) + (ensure-equal (list entry) + (http-kit/http2::%http2-connection-scheduler-entries + connection)) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection (h2-frame-object 0 1 1 (octets 98)) nil nil nil clock) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (let* ((reader + (http-kit/http2::%h2-reader-for + (binary-session-output stream))) + (updates nil)) + (loop for frame = (http-kit/http2::%h2-read-frame + reader 16384 nil nil) + until (eq frame :eof) + when (= 8 (http-kit/http2::%h2-frame-type frame)) + do (push frame updates)) + (ensure-equal 2 + (reduce #'+ updates + :key (lambda (frame) + (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload + frame) + 0)) + :initial-value 0)) + (ensure-true + (every (lambda (frame) + (zerop (http-kit/http2::%h2-frame-stream-id frame))) + updates)))) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (request (make-http-request :method "GET" :uri "https://example.com/headers")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1)) + (clock (lambda () 0)) + (information-calls 0)) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-scheduler-first-peer-frame-p + connection) + nil + (http-kit/http2::%http2-connection-next-stream-id connection) 3 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection) + 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry) + (http-kit/http2::%h2-batch-entry-local-retired-p entry) + t + (http-kit/http2::%h2-batch-entry-on-information entry) + (lambda (response) + (declare (ignore response)) + (incf information-calls))) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection + (h2-frame-object 1 4 1 (h2-header-block (cons ":status" "103"))) + nil nil nil clock) + (ensure-equal (list entry) + (http-kit/http2::%http2-connection-scheduler-entries + connection)) + (ensure-equal 0 information-calls) + (http-kit/http2::%h2-scheduler-dispatch-frame + connection + (h2-frame-object 1 5 1 + (h2-header-block (cons ":status" "200") + (cons "content-length" "0"))) + nil nil nil clock) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-equal 0 information-calls)) + (http-kit/http2:close-http2-connection connection))) + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream (lambda (owned-stream) + (ensure-true (eq stream owned-stream)) + (incf closed) + (close owned-stream)))) + (request (make-http-request :method "GET" :uri "https://example.com/goaway")) + (entry (http-kit/http2::%make-h2-batch-entry + :request request :stream-id 1))) + (unwind-protect + (progn + (setf (http-kit/http2::%http2-connection-goaway-last-stream-id + connection) + 1 + (http-kit/http2::%http2-connection-scheduler-entries connection) + (list entry)) + (http-kit/http2::%h2-scheduler-close-goaway-retired-if-idle connection) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (ensure-equal 0 closed) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) nil) + (http-kit/http2::%h2-scheduler-close-goaway-retired-if-idle connection) + (ensure-false (http-kit/http2:http2-connection-open-p connection)) + (ensure-equal 1 closed)) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(progn + (deftest http2-coverage-manager-claim-after-close + (let ((manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (&rest arguments) + (declare (ignore arguments)) + nil)))) + (http-kit/http2:close-http2-connection-manager manager) + (let ((failure + (handler-case + (progn + (http-kit/http2::%h2-manager-claim-opening + manager :closed) + nil) + (http-connection-error (condition) condition)))) + (ensure-true (typep failure 'http-connection-error)) + (ensure-equal :closed (http-connection-error-cause failure))))) + + (deftest http2-coverage-manager-opening-release-identity + (let* ((manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (&rest arguments) + (declare (ignore arguments)) + nil))) + (opening + (nth-value 0 + (http-kit/http2::%h2-manager-claim-opening manager :first))) + (other-opening + (nth-value 0 + (http-kit/http2::%h2-manager-claim-opening manager :second)))) + (unwind-protect + (progn + (http-kit/http2::%h2-manager-release-opening + manager :first other-opening) + (ensure-true + (eq opening + (gethash :first + (http-kit/http2::%http2-connection-manager-openings + manager)))) + (ensure-true + (eq opening + (http-kit/http2::%h2-manager-release-opening + manager :first opening))) + (ensure-false + (gethash :first + (http-kit/http2::%http2-connection-manager-openings + manager)))) + (http-kit/http2::%h2-manager-release-opening + manager :first opening) + (http-kit/http2::%h2-manager-release-opening + manager :second other-opening)))) + + (deftest http2-coverage-manager-wait-lock-recovery + (let ((lock (sb-thread:make-mutex))) + (unwind-protect + (progn + (http-kit/http2::%h2-manager-recover-wait-lock lock) + (ensure-true (sb-thread:holding-mutex-p lock)) + (sb-thread:release-mutex lock) + (sb-thread:grab-mutex lock) + (http-kit/http2::%h2-manager-recover-wait-lock lock) + (ensure-true (sb-thread:holding-mutex-p lock))) + (when (sb-thread:holding-mutex-p lock) + (sb-thread:release-mutex lock))) + (ensure-false (sb-thread:holding-mutex-p lock)))) + + (deftest http2-coverage-manager-open-entry-reuses-existing + (let* ((existing-close-count 0) + (new-close-count 0) + (open-count 0) + (existing-stream + (make-instance 'binary-session-stream :input (octets))) + (new-stream + (make-instance 'binary-session-stream :input (octets))) + (existing-connection + (http-kit/http2:make-http2-connection + :stream existing-stream + :close-stream + (lambda (stream) + (ensure-true (eq stream existing-stream)) + (incf existing-close-count) + (close stream)))) + (new-connection + (http-kit/http2:make-http2-connection + :stream new-stream + :close-stream + (lambda (stream) + (ensure-true (eq stream new-stream)) + (incf new-close-count) + (close stream)))) + (request + (make-http-request :method "GET" + :uri "https://example.com/open-race")) + (key :same-key) + (entry + (http-kit/http2::%make-http2-managed-connection + :key key + :connection existing-connection + :opened-at 0 + :last-used 0 + :last-used-at 0 + :active-count 1 + :exclusive-p nil)) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (ignored-request &key timeout deadline) + (declare (ignore ignored-request timeout deadline)) + (incf open-count) + new-connection)))) + (setf (http-kit/http2::%http2-connection-manager-entries manager) + (list entry)) + (unwind-protect + (progn + (multiple-value-bind (connection selected-entry) + (http-kit/http2::%h2-manager-open-entry + manager request key nil nil nil nil t nil + (http-kit/http2::%http2-connection-manager-clear-generation + manager)) + (ensure-true (eq existing-connection connection)) + (ensure-true (eq entry selected-entry)) + (ensure-equal 2 + (http-kit/http2::%http2-managed-connection-active-count + entry)) + (ensure-false + (http-kit/http2::%http2-managed-connection-exclusive-p entry)) + (ensure-equal 1 + (http-kit/http2::%http2-managed-connection-last-used + entry)) + (ensure-equal 1 open-count) + (ensure-true (http-kit/http2:http2-connection-open-p + existing-connection)) + (ensure-false (http-kit/http2:http2-connection-open-p + new-connection)) + (ensure-equal 1 new-close-count)) + (http-kit/http2::%h2-manager-finish-entry manager entry) + (http-kit/http2::%h2-manager-finish-entry manager entry) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 1 existing-close-count) + (ensure-equal 1 new-close-count)) + (http-kit/http2:close-http2-connection-manager manager) + (http-kit/http2:close-http2-connection existing-connection) + (http-kit/http2:close-http2-connection new-connection))))) +(deftest http2-coverage-manager-exclusive-entry-is-not-shared + (let* ((stream (make-instance 'binary-session-stream :input (octets))) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (owned-stream) + (ensure-true (eq stream owned-stream)) + (close owned-stream)))) + (key :same-key) + (entry + (http-kit/http2::%make-http2-managed-connection + :key key + :connection connection + :opened-at 0 + :last-used 0 + :last-used-at 0 + :active-count 1 + :exclusive-p t)) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (&rest arguments) + (declare (ignore arguments)) + nil)))) + (setf (http-kit/http2::%http2-connection-manager-entries manager) + (list entry)) + (unwind-protect + (multiple-value-bind (selected-entry request-scoped-p actions + clear-generation) + (http-kit/http2::%h2-manager-select-entry manager key 0 t) + (ensure-true (null selected-entry)) + (ensure-true request-scoped-p) + (ensure-true (null actions)) + (ensure-equal 0 clear-generation) + (ensure-equal 1 + (http-kit/http2::%http2-managed-connection-active-count + entry)) + (ensure-true + (http-kit/http2::%http2-managed-connection-exclusive-p entry))) + (http-kit/http2::%h2-manager-finish-entry manager entry) + (http-kit/http2:close-http2-connection-manager manager) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-scheduler-bounds-informational-callback-queue + (let* ((information-block + (h2-header-block (cons ":status" "103"))) + (information-frame (h2-frame 1 4 1 information-block)) + (frames + (append + (list (h2-frame 4 0 0 (octets)) information-frame) + (make-list 17 :initial-element information-frame) + (list + (h2-frame 1 5 3 + (h2-header-block (cons ":status" "200") + (cons "content-length" "0")))))) + (stream + (make-instance 'binary-session-stream + :input (apply #'concatenate-octets frames))) + (connection + (http-kit/http2:make-http2-connection :stream stream)) + (information-calls 0) + (nested-response nil) + (outer-error nil)) + (unwind-protect + (progn + (setf outer-error + (handler-case + (progn + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://example.com/outer") + :on-information + (lambda (response) + (ensure-equal 103 (http-response-status response)) + (incf information-calls) + (when (= information-calls 1) + (setf nested-response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request + :method "GET" + :uri "https://example.com/nested")))))) + nil) + (http-protocol-error (condition) condition))) + (ensure-true (typep outer-error 'http-protocol-error)) + (ensure-equal :http2-read (http-error-operation outer-error)) + (ensure-equal + (list :information-callback-queue 1 16) + (http-protocol-error-detail outer-error)) + (ensure-equal 200 (http-response-status nested-response)) + (ensure-equal 1 information-calls) + (ensure-true + (null + (http-kit/http2::%http2-connection-scheduler-entries connection))) + (let ((reset-frame + (find-if + (lambda (frame) + (and + (= http-kit/http2::+http2-rst-stream-type+ + (http-kit/http2::%h2-frame-type frame)) + (= 1 (http-kit/http2::%h2-frame-stream-id frame)))) + (h2-output-frames stream)))) + (ensure-true reset-frame) + (ensure-equal + 8 + (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload reset-frame) 0)))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-request-body-inactive-scheduler-entry + (let* ((stream + (make-instance 'binary-session-stream :input (octets))) + (connection + (http-kit/http2:make-http2-connection :stream stream)) + (entry + (http-kit/http2::%make-h2-batch-entry + :request + (make-http-request :method "POST" + :uri "https://example.com/inactive") + :stream-id 1)) + (writes nil) + (condition nil)) + (ensure-false + (member entry + (http-kit/http2::%http2-connection-scheduler-entries connection) + :test #'eq)) + (unwind-protect + (progn + (handler-case + (http-kit/http2::%h2-connection-send-request-body + connection nil + (lambda (wire) (push (copy-seq wire) writes)) + 1 (octets 97) nil nil nil 16384 nil nil + (lambda () 0) nil nil + :scheduler-p t :scheduler-entry entry) + (http-connection-error (observed) + (setf condition observed))) + (ensure-true (typep condition 'http-connection-error)) + (ensure-equal :http2-write (http-error-operation condition)) + (ensure-equal '(:stream-inactive 1) + (http-connection-error-cause condition)) + (ensure-false writes) + (ensure-false + (member entry + (http-kit/http2::%http2-connection-scheduler-entries + connection) + :test #'eq))) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-coverage-request-body-unscheduled-trailer-headers + (let* ((stream + (make-instance 'binary-session-stream :input (octets))) + (connection + (http-kit/http2:make-http2-connection :stream stream)) + (trailers '(("x-upload-result" . "complete"))) + (writes nil)) + (unwind-protect + (progn + (multiple-value-bind (pending-frames read-initial-settings-p) + (http-kit/http2::%h2-connection-send-request-body + connection nil + (lambda (wire) (push (copy-seq wire) writes)) + 1 (octets) nil nil nil 16384 trailers nil + (lambda () 0) nil nil + :scheduler-p nil) + (ensure-false pending-frames) + (ensure-false read-initial-settings-p)) + (ensure-equal 1 (length writes)) + (let* ((reader (h2-reader-from-frames (first writes))) + (frame + (http-kit/http2::%h2-read-frame reader 16384 nil nil))) + (ensure-false (eq frame :eof)) + (ensure-equal http-kit/http2::+http2-headers-type+ + (http-kit/http2::%h2-frame-type frame)) + (ensure-equal 5 (http-kit/http2::%h2-frame-flags frame)) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id frame)) + (ensure-equal trailers + (h2-decode-header-block + (http-kit/http2::%h2-frame-payload frame) + (h2-hpack-context))) + (ensure-equal :eof + (http-kit/http2::%h2-read-frame + reader 16384 nil nil)))) + (http-kit/http2:close-http2-connection connection)))) + + diff --git a/t/tests-http2-manager.lisp b/t/tests-http2-manager.lisp index 22667ed6..6e729363 100644 --- a/t/tests-http2-manager.lisp +++ b/t/tests-http2-manager.lisp @@ -1169,17 +1169,21 @@ manager)) (ensure-false (http-kit/http2:http2-connection-manager-open-p manager)))) #+sbcl -(deftest http2-connection-manager-same-key-concurrent-open-reuses-retained-connection +(deftest http2-connection-manager-cold-open-coalesces-same-key-single-callers (let* ((open-entered (sb-thread:make-semaphore :count 0)) (release-first (sb-thread:make-semaphore :count 0)) + (waiter-arrived (sb-thread:make-semaphore :count 0)) (first-done (sb-thread:make-semaphore :count 0)) (second-done (sb-thread:make-semaphore :count 0)) - (open-lock (sb-thread:make-mutex :name "same-key open counter")) + (open-lock (sb-thread:make-mutex :name "cold open counter")) (opened 0) (closed 0) (connections (make-array 2 :initial-element nil)) + (wait-symbol 'http-kit/http2::%h2-manager-wait-for-opening) + (original-wait (symbol-function + 'http-kit/http2::%h2-manager-wait-for-opening)) (request - (make-http-request :method "GET" :uri "https://same-open.test/")) + (make-http-request :method "GET" :uri "https://cold-open.test/")) (manager (http-kit/http2:make-http2-connection-manager :open-connection @@ -1192,8 +1196,8 @@ (when (zerop index) (sb-thread:signal-semaphore open-entered) (unless (sb-thread:wait-on-semaphore - release-first :timeout 5) - (error "Timed out waiting to release the first same-key open"))) + release-first :timeout 10) + (error "Timed out waiting to release the first cold open"))) (let ((stream (make-instance 'binary-session-stream :input (octets)))) (setf (aref connections index) (http-kit/http2:make-http2-connection @@ -1210,8 +1214,12 @@ (first-connection nil) (first-entry nil) (second-connection nil) - (second-entry nil) - (second-entry-identity nil)) + (second-entry nil)) + (setf (symbol-function wait-symbol) + (lambda (wait-manager key opening deadline clock-function) + (sb-thread:signal-semaphore waiter-arrived) + (funcall original-wait wait-manager key opening deadline + clock-function))) (unwind-protect (progn (setf first-thread @@ -1219,10 +1227,10 @@ (lambda () (unwind-protect (handler-case - (sb-ext:with-timeout 10 + (sb-ext:with-timeout 15 (multiple-value-setq (first-connection first-entry) (http-kit/http2::%h2-manager-connection-for - manager request "same-key" t nil nil nil nil))) + manager request "same-key" t nil nil nil nil t))) (error (condition) (setf first-error condition))) (sb-thread:signal-semaphore first-done))))) @@ -1233,53 +1241,56 @@ (lambda () (unwind-protect (handler-case - (sb-ext:with-timeout 10 - (multiple-value-setq - (second-connection second-entry) + (sb-ext:with-timeout 15 + (multiple-value-setq (second-connection second-entry) (http-kit/http2::%h2-manager-connection-for - manager request "same-key" t nil nil nil nil))) + manager request "same-key" t nil nil nil nil t))) (error (condition) (setf second-error condition))) (sb-thread:signal-semaphore second-done))))) (ensure-true - (sb-thread:wait-on-semaphore second-done :timeout 12)) - (sb-thread:join-thread second-thread) - (setf second-thread nil) - (ensure-true (null second-error)) - (ensure-true second-entry) - (setf second-entry-identity second-entry) - (http-kit/http2::%h2-manager-finish-entry manager second-entry) - (setf second-entry nil) + (sb-thread:wait-on-semaphore waiter-arrived :timeout 5)) + (ensure-equal + 1 + (sb-thread:with-mutex (open-lock) opened)) (sb-thread:signal-semaphore release-first) (ensure-true (sb-thread:wait-on-semaphore first-done :timeout 12)) + (ensure-true + (sb-thread:wait-on-semaphore second-done :timeout 12)) (sb-thread:join-thread first-thread) (setf first-thread nil) + (sb-thread:join-thread second-thread) + (setf second-thread nil) (ensure-true (null first-error)) - (ensure-true (eq second-connection first-connection)) - (ensure-true (eq first-connection (aref connections 1))) - (ensure-true (eq second-entry-identity first-entry)) - (ensure-equal 2 opened) - (ensure-equal 1 closed) - (ensure-false - (http-kit/http2:http2-connection-open-p (aref connections 0))) - (ensure-equal - 1 - (http-kit/http2:http2-connection-manager-connection-count manager)) + (ensure-true (null second-error)) + (ensure-equal 1 opened) + (ensure-true first-entry) + (ensure-true (eq first-connection second-connection)) + (ensure-true (eq first-entry second-entry)) + (ensure-true (eq first-connection (aref connections 0))) + (ensure-equal 1 + (http-kit/http2:http2-connection-manager-connection-count + manager)) + (ensure-equal 0 closed) (http-kit/http2::%h2-manager-finish-entry manager first-entry) (setf first-entry nil) - (http-kit/http2:close-http2-connection-manager manager)) + (http-kit/http2::%h2-manager-finish-entry manager second-entry) + (setf second-entry nil) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 1 closed)) (sb-thread:signal-semaphore release-first) (when first-thread - (sb-thread:join-thread first-thread)) + (ignore-errors (sb-thread:join-thread first-thread))) (when second-thread - (sb-thread:join-thread second-thread)) + (ignore-errors (sb-thread:join-thread second-thread))) + (setf (symbol-function wait-symbol) original-wait) (when first-entry (http-kit/http2::%h2-manager-finish-entry manager first-entry)) (when second-entry (http-kit/http2::%h2-manager-finish-entry manager second-entry)) (http-kit/http2:close-http2-connection-manager manager)) - (ensure-equal 2 closed))) + (ensure-equal 1 closed))) #+sbcl (deftest http2-connection-manager-opening-at-capacity-retires-idle-entry (let* ((open-entered (sb-thread:make-semaphore :count 0)) @@ -1944,3 +1955,636 @@ (when entry (http-kit/http2::%h2-manager-finish-entry manager entry)) (http-kit/http2:close-http2-connection-manager manager)))) +#+sbcl +(progn + (defun %make-cold-open-regression-connection (on-close) + (let ((stream (make-instance 'binary-session-stream :input (octets)))) + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (closed-stream) + (unless (eq stream closed-stream) + (error "HTTP/2 regression connection closed the wrong stream.")) + (funcall on-close))))) + + (deftest http2-connection-manager-cold-open-failure-wakes-waiter-and-retries + (let* ((open-entered (sb-thread:make-semaphore :count 0)) + (release-first (sb-thread:make-semaphore :count 0)) + (waiter-arrived (sb-thread:make-semaphore :count 0)) + (owner-done (sb-thread:make-semaphore :count 0)) + (waiter-done (sb-thread:make-semaphore :count 0)) + (counter-lock (sb-thread:make-mutex :name "cold-open failure")) + (opened 0) + (closed 0) + (request (make-http-request :method "GET" + :uri "https://cold-failure.test/")) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline) + (declare (ignore request timeout deadline)) + (let ((index (sb-thread:with-mutex (counter-lock) + (prog1 opened (incf opened))))) + (if (zerop index) + (progn + (sb-thread:signal-semaphore open-entered) + (unless (sb-thread:wait-on-semaphore + release-first :timeout 10) + (error "Timed out waiting to fail the first open.")) + (error "Expected first cold open failure.")) + (%make-cold-open-regression-connection + (lambda () (incf closed)))))))) + (wait-symbol 'http-kit/http2::%h2-manager-wait-for-opening) + (original-wait (symbol-function wait-symbol)) + (owner-thread nil) + (waiter-thread nil) + (owner-error nil) + (waiter-error nil) + (waiter-connection nil) + (waiter-entry nil)) + (setf (symbol-function wait-symbol) + (lambda (manager key opening deadline clock-function) + (sb-thread:signal-semaphore waiter-arrived) + (funcall original-wait manager key opening deadline + clock-function))) + (unwind-protect + (progn + (setf owner-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2::%h2-manager-connection-for + manager request "failure" t nil nil nil nil t) + (error (condition) (setf owner-error condition))) + (sb-thread:signal-semaphore owner-done))))) + (ensure-true (sb-thread:wait-on-semaphore open-entered :timeout 5)) + (setf waiter-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (multiple-value-setq + (waiter-connection waiter-entry) + (http-kit/http2::%h2-manager-connection-for + manager request "failure" t nil nil nil nil t)) + (error (condition) (setf waiter-error condition))) + (sb-thread:signal-semaphore waiter-done))))) + (ensure-true + (sb-thread:wait-on-semaphore waiter-arrived :timeout 5)) + (sb-thread:signal-semaphore release-first) + (ensure-true (sb-thread:wait-on-semaphore owner-done :timeout 10)) + (ensure-true (sb-thread:wait-on-semaphore waiter-done :timeout 10)) + (sb-thread:join-thread owner-thread) + (setf owner-thread nil) + (sb-thread:join-thread waiter-thread) + (setf waiter-thread nil) + (ensure-true owner-error) + (ensure-true (null waiter-error)) + (ensure-equal 2 opened) + (ensure-true waiter-entry) + (ensure-true waiter-connection) + (ensure-equal 1 + (http-kit/http2:http2-connection-manager-connection-count + manager)) + (http-kit/http2::%h2-manager-finish-entry manager waiter-entry) + (setf waiter-entry nil) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 1 closed)) + (sb-thread:signal-semaphore release-first) + (when owner-thread (ignore-errors (sb-thread:join-thread owner-thread))) + (when waiter-thread (ignore-errors (sb-thread:join-thread waiter-thread))) + (setf (symbol-function wait-symbol) original-wait) + (when waiter-entry + (http-kit/http2::%h2-manager-finish-entry manager waiter-entry)) + (http-kit/http2:close-http2-connection-manager manager)))) + + (deftest http2-connection-manager-cold-open-wait-observes-request-deadline + (let* ((open-entered (sb-thread:make-semaphore :count 0)) + (release-open (sb-thread:make-semaphore :count 0)) + (waiter-arrived (sb-thread:make-semaphore :count 0)) + (owner-done (sb-thread:make-semaphore :count 0)) + (waiter-done (sb-thread:make-semaphore :count 0)) + (opened 0) + (closed 0) + (request (make-http-request :method "GET" + :uri "https://cold-deadline.test/")) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline) + (declare (ignore request timeout deadline)) + (incf opened) + (sb-thread:signal-semaphore open-entered) + (unless (sb-thread:wait-on-semaphore release-open :timeout 10) + (error "Timed out waiting to release the deadline test open.")) + (%make-cold-open-regression-connection + (lambda () (incf closed)))))) + (wait-symbol 'http-kit/http2::%h2-manager-wait-for-opening) + (original-wait (symbol-function wait-symbol)) + (owner-thread nil) + (waiter-thread nil) + (owner-error nil) + (waiter-error nil) + (owner-entry nil)) + (setf (symbol-function wait-symbol) + (lambda (manager key opening deadline clock-function) + (sb-thread:signal-semaphore waiter-arrived) + (funcall original-wait manager key opening deadline + clock-function))) + (unwind-protect + (progn + (setf owner-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (multiple-value-bind (connection entry) + (http-kit/http2::%h2-manager-connection-for + manager request "deadline" t nil nil nil nil t) + (declare (ignore connection)) + (setf owner-entry entry)) + (error (condition) (setf owner-error condition))) + (sb-thread:signal-semaphore owner-done))))) + (ensure-true (sb-thread:wait-on-semaphore open-entered :timeout 5)) + (setf waiter-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2::%h2-manager-connection-for + manager request "deadline" t 0 nil nil nil t) + (error (condition) (setf waiter-error condition))) + (sb-thread:signal-semaphore waiter-done))))) + (ensure-true + (sb-thread:wait-on-semaphore waiter-arrived :timeout 5)) + (ensure-true (sb-thread:wait-on-semaphore waiter-done :timeout 5)) + (sb-thread:join-thread waiter-thread) + (setf waiter-thread nil) + (ensure-true (typep waiter-error 'http-timeout)) + (ensure-equal :read (http-timeout-kind waiter-error)) + (sb-thread:signal-semaphore release-open) + (ensure-true (sb-thread:wait-on-semaphore owner-done :timeout 10)) + (sb-thread:join-thread owner-thread) + (setf owner-thread nil) + (ensure-true (null owner-error)) + (ensure-equal 1 opened) + (ensure-true owner-entry) + (http-kit/http2::%h2-manager-finish-entry manager owner-entry) + (setf owner-entry nil) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 1 closed)) + (sb-thread:signal-semaphore release-open) + (when owner-thread (ignore-errors (sb-thread:join-thread owner-thread))) + (when waiter-thread (ignore-errors (sb-thread:join-thread waiter-thread))) + (setf (symbol-function wait-symbol) original-wait) + (when owner-entry + (http-kit/http2::%h2-manager-finish-entry manager owner-entry)) + (http-kit/http2:close-http2-connection-manager manager)))) + + (deftest http2-connection-manager-cold-open-close-wakes-waiter-and-rejects-owner-result + (let* ((open-entered (sb-thread:make-semaphore :count 0)) + (release-open (sb-thread:make-semaphore :count 0)) + (waiter-arrived (sb-thread:make-semaphore :count 0)) + (owner-done (sb-thread:make-semaphore :count 0)) + (waiter-done (sb-thread:make-semaphore :count 0)) + (opened 0) + (closed 0) + (request (make-http-request :method "GET" + :uri "https://cold-close.test/")) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline) + (declare (ignore request timeout deadline)) + (incf opened) + (sb-thread:signal-semaphore open-entered) + (unless (sb-thread:wait-on-semaphore release-open :timeout 10) + (error "Timed out waiting to release the close test open.")) + (%make-cold-open-regression-connection + (lambda () (incf closed)))))) + (wait-symbol 'http-kit/http2::%h2-manager-wait-for-opening) + (original-wait (symbol-function wait-symbol)) + (owner-thread nil) + (waiter-thread nil) + (owner-error nil) + (waiter-error nil)) + (setf (symbol-function wait-symbol) + (lambda (manager key opening deadline clock-function) + (sb-thread:signal-semaphore waiter-arrived) + (funcall original-wait manager key opening deadline + clock-function))) + (unwind-protect + (progn + (setf owner-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2::%h2-manager-connection-for + manager request "close" t nil nil nil nil t) + (error (condition) (setf owner-error condition))) + (sb-thread:signal-semaphore owner-done))))) + (ensure-true (sb-thread:wait-on-semaphore open-entered :timeout 5)) + (setf waiter-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2::%h2-manager-connection-for + manager request "close" t nil nil nil nil t) + (error (condition) (setf waiter-error condition))) + (sb-thread:signal-semaphore waiter-done))))) + (ensure-true + (sb-thread:wait-on-semaphore waiter-arrived :timeout 5)) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-true (sb-thread:wait-on-semaphore waiter-done :timeout 5)) + (sb-thread:join-thread waiter-thread) + (setf waiter-thread nil) + (ensure-true (typep waiter-error 'http-connection-error)) + (sb-thread:signal-semaphore release-open) + (ensure-true (sb-thread:wait-on-semaphore owner-done :timeout 10)) + (sb-thread:join-thread owner-thread) + (setf owner-thread nil) + (ensure-true (typep owner-error 'http-connection-error)) + (ensure-equal 1 opened) + (ensure-equal 1 closed) + (ensure-equal + 0 + (http-kit/http2:http2-connection-manager-connection-count manager))) + (sb-thread:signal-semaphore release-open) + (when owner-thread (ignore-errors (sb-thread:join-thread owner-thread))) + (when waiter-thread (ignore-errors (sb-thread:join-thread waiter-thread))) + (setf (symbol-function wait-symbol) original-wait) + (http-kit/http2:close-http2-connection-manager manager)))) + + (deftest http2-connection-manager-cold-open-clear-wakes-waiter-to-retry + (let* ((open-entered (sb-thread:make-semaphore :count 0)) + (release-open (sb-thread:make-semaphore :count 0)) + (waiter-arrived (sb-thread:make-semaphore :count 0)) + (owner-done (sb-thread:make-semaphore :count 0)) + (waiter-done (sb-thread:make-semaphore :count 0)) + (counter-lock (sb-thread:make-mutex :name "cold-open clear")) + (opened 0) + (closed 0) + (request (make-http-request :method "GET" + :uri "https://cold-clear.test/")) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline) + (declare (ignore request timeout deadline)) + (let ((index (sb-thread:with-mutex (counter-lock) + (prog1 opened (incf opened))))) + (when (zerop index) + (sb-thread:signal-semaphore open-entered) + (unless (sb-thread:wait-on-semaphore + release-open :timeout 10) + (error "Timed out waiting to release the clear test open."))) + (%make-cold-open-regression-connection + (lambda () (incf closed))))))) + (wait-symbol 'http-kit/http2::%h2-manager-wait-for-opening) + (original-wait (symbol-function wait-symbol)) + (owner-thread nil) + (waiter-thread nil) + (owner-error nil) + (waiter-error nil) + (owner-connection nil) + (owner-entry nil) + (waiter-connection nil) + (waiter-entry nil)) + (setf (symbol-function wait-symbol) + (lambda (manager key opening deadline clock-function) + (sb-thread:signal-semaphore waiter-arrived) + (funcall original-wait manager key opening deadline + clock-function))) + (unwind-protect + (progn + (setf owner-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (multiple-value-setq (owner-connection owner-entry) + (http-kit/http2::%h2-manager-connection-for + manager request "clear" t nil nil nil nil t)) + (error (condition) (setf owner-error condition))) + (sb-thread:signal-semaphore owner-done))))) + (ensure-true (sb-thread:wait-on-semaphore open-entered :timeout 5)) + (setf waiter-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (multiple-value-setq (waiter-connection waiter-entry) + (http-kit/http2::%h2-manager-connection-for + manager request "clear" t nil nil nil nil t)) + (error (condition) (setf waiter-error condition))) + (sb-thread:signal-semaphore waiter-done))))) + (ensure-true + (sb-thread:wait-on-semaphore waiter-arrived :timeout 5)) + (http-kit/http2:clear-http2-connection-manager manager) + (ensure-equal + 0 + (http-kit/http2:http2-connection-manager-connection-count manager)) + (sb-thread:signal-semaphore release-open) + (ensure-true (sb-thread:wait-on-semaphore owner-done :timeout 10)) + (ensure-true (sb-thread:wait-on-semaphore waiter-done :timeout 10)) + (sb-thread:join-thread owner-thread) + (setf owner-thread nil) + (sb-thread:join-thread waiter-thread) + (setf waiter-thread nil) + (ensure-true (null owner-error)) + (ensure-true (null waiter-error)) + (ensure-equal 2 opened) + (ensure-true (http-kit/http2::%http2-managed-connection-transient-p + owner-entry)) + (ensure-false (http-kit/http2::%http2-managed-connection-transient-p + waiter-entry)) + (ensure-true (not (eq owner-connection waiter-connection))) + (ensure-equal + 1 + (http-kit/http2:http2-connection-manager-connection-count manager)) + (http-kit/http2::%h2-manager-finish-entry manager owner-entry) + (setf owner-entry nil) + (ensure-equal 1 closed) + (http-kit/http2::%h2-manager-finish-entry manager waiter-entry) + (setf waiter-entry nil) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 2 closed)) + (sb-thread:signal-semaphore release-open) + (when owner-thread (ignore-errors (sb-thread:join-thread owner-thread))) + (when waiter-thread (ignore-errors (sb-thread:join-thread waiter-thread))) + (setf (symbol-function wait-symbol) original-wait) + (when owner-entry + (http-kit/http2::%h2-manager-finish-entry manager owner-entry)) + (when waiter-entry + (http-kit/http2::%h2-manager-finish-entry manager waiter-entry)) + (http-kit/http2:close-http2-connection-manager manager)))) + + (deftest http2-connection-manager-cold-open-reentrant-owner-uses-transient-fallback + (let* ((request (make-http-request :method "GET" + :uri "https://cold-reentrant.test/")) + (opened 0) + (closed 0) + (manager nil) + (nested-connection nil) + (nested-entry nil) + (outer-connection nil) + (outer-entry nil)) + (setf manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline) + (declare (ignore timeout deadline)) + (incf opened) + (let ((connection + (%make-cold-open-regression-connection + (lambda () (incf closed))))) + (when (= opened 1) + (multiple-value-setq (nested-connection nested-entry) + (http-kit/http2::%h2-manager-connection-for + manager + request + "reentrant" + t nil nil nil nil t))) + connection)))) + (multiple-value-setq (outer-connection outer-entry) + (http-kit/http2::%h2-manager-connection-for + manager request "reentrant" t nil nil nil nil t)) + (ensure-equal 2 opened) + (ensure-true nested-entry) + (ensure-true outer-entry) + (ensure-true (http-kit/http2::%http2-managed-connection-transient-p + nested-entry)) + (ensure-false (http-kit/http2::%http2-managed-connection-transient-p + outer-entry)) + (ensure-true (not (eq nested-connection outer-connection))) + (ensure-equal + 1 + (http-kit/http2:http2-connection-manager-connection-count manager)) + (http-kit/http2::%h2-manager-finish-entry manager nested-entry) + (ensure-equal 1 closed) + (http-kit/http2::%h2-manager-finish-entry manager outer-entry) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 2 closed)))) +#+sbcl +(deftest http2-connection-manager-multiplexes-concurrent-high-level-client-requests + (let* ((body-entered (sb-thread:make-semaphore :count 0)) + (release-first (sb-thread:make-semaphore :count 0)) + (first-done (sb-thread:make-semaphore :count 0)) + (input-wire + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 4 1 (h2-header-block (cons ":status" "200"))) + (h2-frame 0 1 1 (octets 1)) + (h2-frame 1 4 3 (h2-header-block (cons ":status" "201"))) + (h2-frame 0 1 3 (octets 2)))) + (opened 0) + (closed 0) + (streams nil) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline proxy-plan proxy) + (declare (ignore timeout deadline proxy-plan proxy)) + (let* ((stream + (make-instance + 'binary-session-stream + :input (if (zerop opened) + input-wire + (h2-response-wire (octets 9))))) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (closed-stream) + (ensure-true (eq stream closed-stream)) + (incf closed))))) + (ensure-equal "GET" (http-request-method request)) + (incf opened) + (push stream streams) + connection)))) + (manager-transport + (http-kit/http2:make-http2-connection-manager-transport manager)) + (client + (http-kit/client:make-http-client + :transport-function + (lambda (request &rest arguments) + (apply manager-transport request + :connection-key "multiplex.test" arguments)) + :cache nil + :default-timeout 5)) + (first-response nil) + (second-response nil) + (first-error nil) + (first-thread nil)) + (unwind-protect + (progn + (setf first-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (setf first-response + (sb-ext:with-timeout 15 + (http-kit/client:http-client-send + client "GET" + "http://multiplex.test/first" + :on-body-chunk + (lambda (chunk) + (ensure-equal (octets 1) chunk) + (sb-thread:signal-semaphore body-entered) + (unless (sb-thread:wait-on-semaphore + release-first :timeout 10) + (error "Timed out waiting to release the first response callback")))))) + (error (condition) + (setf first-error condition))) + (sb-thread:signal-semaphore first-done))))) + (ensure-true + (sb-thread:wait-on-semaphore body-entered :timeout 5)) + (setf second-response + (sb-ext:with-timeout 10 + (http-kit/client:http-client-send + client "GET" "http://multiplex.test/second"))) + (ensure-equal 201 (http-response-status second-response)) + (ensure-equal (octets 2) (http-response-body second-response)) + (sb-thread:signal-semaphore release-first) + (ensure-true + (sb-thread:wait-on-semaphore first-done :timeout 5)) + (sb-thread:join-thread first-thread) + (setf first-thread nil) + (ensure-true (null first-error)) + (ensure-equal 200 (http-response-status first-response)) + (ensure-equal (octets 1) (http-response-body first-response)) + (ensure-equal 1 opened) + (ensure-equal + 1 + (http-kit/http2:http2-connection-manager-connection-count manager)) + (ensure-equal + '(1 3) + (loop for frame in (h2-output-frames (first streams)) + when (= 1 (http-kit/http2::%h2-frame-type frame)) + collect (http-kit/http2::%h2-frame-stream-id frame)))) + (sb-thread:signal-semaphore release-first) + (when first-thread + (sb-thread:join-thread first-thread)) + (http-kit/http2:close-http2-connection-manager manager)) + (ensure-equal 1 closed))) +#+sbcl +(deftest http2-connection-manager-cold-open-owner-rechecks-entry-after-claim + (let* ((open-entered (sb-thread:make-semaphore :count 0)) + (release-open (sb-thread:make-semaphore :count 0)) + (owner-done (sb-thread:make-semaphore :count 0)) + (claim-arrived (sb-thread:make-semaphore :count 0)) + (resume-claim (sb-thread:make-semaphore :count 0)) + (second-started (sb-thread:make-semaphore :count 0)) + (start-second (sb-thread:make-semaphore :count 0)) + (second-done (sb-thread:make-semaphore :count 0)) + (counter-lock (sb-thread:make-mutex :name "cold-open claim race")) + (opened 0) + (closed 0) + (request (make-http-request :method "GET" + :uri "https://cold-claim-race.test/")) + (manager + (http-kit/http2:make-http2-connection-manager + :open-connection + (lambda (request &key timeout deadline) + (declare (ignore request timeout deadline)) + (let ((index + (sb-thread:with-mutex (counter-lock) + (prog1 opened (incf opened))))) + (unless (zerop index) + (error "Unexpected duplicate cold open.")) + (sb-thread:signal-semaphore open-entered) + (unless (sb-thread:wait-on-semaphore release-open :timeout 10) + (error "Timed out waiting to release the first cold open.")) + (%make-cold-open-regression-connection + (lambda () (incf closed))))))) + (claim-symbol 'http-kit/http2::%h2-manager-claim-opening) + (original-claim (symbol-function claim-symbol)) + (owner-thread nil) + (second-thread nil) + (owner-error nil) + (second-error nil) + (owner-connection nil) + (owner-entry nil) + (second-connection nil) + (second-entry nil)) + (unwind-protect + (progn + (setf owner-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (multiple-value-setq (owner-connection owner-entry) + (http-kit/http2::%h2-manager-connection-for + manager request "claim-race" t nil nil nil nil t)) + (error (condition) (setf owner-error condition))) + (sb-thread:signal-semaphore owner-done))))) + (ensure-true (sb-thread:wait-on-semaphore open-entered :timeout 5)) + (setf (symbol-function claim-symbol) + (lambda (claim-manager key) + (when (eq sb-thread:*current-thread* second-thread) + (sb-thread:signal-semaphore claim-arrived) + (unless (sb-thread:wait-on-semaphore + resume-claim :timeout 10) + (error "Timed out waiting to resume the cold-open claim."))) + (funcall original-claim claim-manager key))) + (setf second-thread + (sb-thread:make-thread + (lambda () + (sb-thread:signal-semaphore second-started) + (sb-thread:wait-on-semaphore start-second) + (unwind-protect + (handler-case + (multiple-value-setq + (second-connection second-entry) + (http-kit/http2::%h2-manager-connection-for + manager request "claim-race" t nil nil nil nil t)) + (error (condition) (setf second-error condition))) + (sb-thread:signal-semaphore second-done))))) + (ensure-true + (sb-thread:wait-on-semaphore second-started :timeout 5)) + (sb-thread:signal-semaphore start-second) + (ensure-true + (sb-thread:wait-on-semaphore claim-arrived :timeout 5)) + (sb-thread:signal-semaphore release-open) + (ensure-true (sb-thread:wait-on-semaphore owner-done :timeout 10)) + (sb-thread:join-thread owner-thread) + (setf owner-thread nil) + (ensure-true (null owner-error)) + (sb-thread:signal-semaphore resume-claim) + (ensure-true (sb-thread:wait-on-semaphore second-done :timeout 10)) + (sb-thread:join-thread second-thread) + (setf second-thread nil) + (ensure-true (null second-error)) + (ensure-equal 1 opened) + (ensure-true (eq owner-connection second-connection)) + (ensure-true (eq owner-entry second-entry)) + (ensure-equal + 1 + (http-kit/http2:http2-connection-manager-connection-count manager)) + (ensure-equal 0 closed) + (http-kit/http2::%h2-manager-finish-entry manager owner-entry) + (setf owner-entry nil) + (ensure-equal 0 closed) + (http-kit/http2::%h2-manager-finish-entry manager second-entry) + (setf second-entry nil) + (http-kit/http2:close-http2-connection-manager manager) + (ensure-equal 1 closed)) + (sb-thread:signal-semaphore release-open) + (sb-thread:signal-semaphore resume-claim) + (when owner-thread + (ignore-errors (sb-thread:join-thread owner-thread))) + (when second-thread + (ignore-errors (sb-thread:join-thread second-thread))) + (setf (symbol-function claim-symbol) original-claim) + (when owner-entry + (http-kit/http2::%h2-manager-finish-entry manager owner-entry)) + (when second-entry + (http-kit/http2::%h2-manager-finish-entry manager second-entry)) + (http-kit/http2:close-http2-connection-manager manager)))) + + diff --git a/t/tests-http2-open-stream.lisp b/t/tests-http2-open-stream.lisp index 106597ee..66e4109a 100644 --- a/t/tests-http2-open-stream.lisp +++ b/t/tests-http2-open-stream.lisp @@ -178,18 +178,12 @@ (first-settings-ack (http-kit/http2::%h2-read-frame request-frames 16384 nil nil)) - (first-stream-window-update - (http-kit/http2::%h2-read-frame - request-frames 16384 nil nil)) (first-connection-window-update (http-kit/http2::%h2-read-frame request-frames 16384 nil nil)) (second-request-frame (http-kit/http2::%h2-read-frame request-frames 16384 nil nil)) - (second-stream-window-update - (http-kit/http2::%h2-read-frame - request-frames 16384 nil nil)) (second-connection-window-update (http-kit/http2::%h2-read-frame request-frames 16384 nil nil))) @@ -208,12 +202,6 @@ (ensure-equal 1 (http-kit/http2::%h2-frame-flags first-settings-ack)) (ensure-equal 0 (http-kit/http2::%h2-frame-stream-id first-settings-ack)) - (ensure-equal 8 - (http-kit/http2::%h2-frame-type - first-stream-window-update)) - (ensure-equal 1 - (http-kit/http2::%h2-frame-stream-id - first-stream-window-update)) (ensure-equal 8 (http-kit/http2::%h2-frame-type first-connection-window-update)) @@ -221,15 +209,6 @@ (http-kit/http2::%h2-frame-stream-id first-connection-window-update)) (ensure-equal 3 (http-kit/http2::%h2-frame-stream-id second-request-frame)) - (ensure-equal 8 - (http-kit/http2::%h2-frame-type - second-stream-window-update)) - (ensure-equal 3 - (http-kit/http2::%h2-frame-stream-id - second-stream-window-update)) - (ensure-equal (octets 0 0 0 5) - (http-kit/http2::%h2-frame-payload - second-stream-window-update)) (ensure-equal 8 (http-kit/http2::%h2-frame-type second-connection-window-update)) @@ -239,7 +218,11 @@ (ensure-equal (octets 0 0 0 5) (http-kit/http2::%h2-frame-payload second-connection-window-update)) - (http-kit/http2:close-http2-connection connection) + (progn + (ensure-equal :eof + (http-kit/http2::%h2-read-frame + request-frames 16384 nil nil)) + (http-kit/http2:close-http2-connection connection)) (ensure-true closed) (ensure-true (not (http-kit/http2:http2-connection-open-p connection))))) @@ -269,6 +252,83 @@ (ensure-equal 200 (http-response-status response)) (ensure-equal (octets) (http-response-body response))) (http-kit/http2:close-http2-connection connection))) + (deftest http2-public-connection-does-not-send-data-after-peer-reset-during-upload + (let* ((producer-started (sb-thread:make-semaphore :count 0)) + (release-producer (sb-thread:make-semaphore :count 0)) + (upload-done (sb-thread:make-semaphore :count 0)) + (stream + (make-instance + 'binary-session-stream + :input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 3 0 1 (octets 0 0 0 8)) + (h2-frame 1 5 3 (octets #x88))))) + (connection + (http-kit/http2:make-http2-connection :stream stream)) + (upload-thread nil) + (upload-error nil) + (peer-response nil) + (producer-started-p nil) + (upload-done-p nil)) + (unwind-protect + (progn + (setf upload-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request + :method "POST" + :uri "https://127.0.0.1/upload") + :timeout 5 + :request-body-function + (lambda (maximum-size) + (declare (ignore maximum-size)) + (sb-thread:signal-semaphore producer-started) + (unless + (sb-thread:wait-on-semaphore + release-producer :timeout 5) + (error "Timed out waiting to release the upload producer.")) + (octets 65)) + :request-body-length 1) + (error (condition) + (setf upload-error condition))) + (sb-thread:signal-semaphore upload-done))))) + (setf producer-started-p + (sb-thread:wait-on-semaphore producer-started :timeout 5)) + (ensure-true producer-started-p) + (setf peer-response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/next") + :timeout 5)) + (ensure-equal 200 (http-response-status peer-response)) + (ensure-equal (octets) (http-response-body peer-response)) + (sb-thread:signal-semaphore release-producer) + (setf upload-done-p + (sb-thread:wait-on-semaphore upload-done :timeout 5)) + (ensure-true upload-done-p) + (sb-thread:join-thread upload-thread) + (setf upload-thread nil) + (ensure-true (typep upload-error 'http-connection-error)) + (ensure-equal '(:rst-stream 1 8) + (http-connection-error-cause upload-error)) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (ensure-equal + 0 + (count-if + (lambda (frame) + (and (= 0 (http-kit/http2::%h2-frame-type frame)) + (= 1 (http-kit/http2::%h2-frame-stream-id frame)))) + (h2-output-frames stream)))) + (sb-thread:signal-semaphore release-producer) + (when upload-thread + (sb-thread:join-thread upload-thread)) + (http-kit/http2:close-http2-connection connection)))) (deftest http2-public-priority-update (let* ((stream @@ -307,71 +367,240 @@ connection 1 :priority-field-value (string #\Newline))) (http-kit/http2:close-http2-connection connection))) + (progn (deftest http2-public-connection-cancel-callback-default-code (let* ((stream (make-instance 'binary-session-stream :input (h2-response-wire (octets)))) (connection (http-kit/http2:make-http2-connection :stream stream)) (opened-stream-id nil) - (response - (http-kit/http2:send-http2-request-over-connection - connection - (make-http-request :method "GET" - :uri "https://127.0.0.1/cancel") - :on-stream-open - (lambda (stream-id cancel-function) - (setf opened-stream-id stream-id) - (funcall cancel-function)))) - (reader - (http-kit/http2::%h2-reader-for - (subseq (binary-session-output stream) - (length (h2-preface))))) - (reset-frame nil)) - (loop for frame = (http-kit/http2::%h2-read-frame - reader 16384 nil nil) - until (eq frame :eof) - when (= 3 (http-kit/http2::%h2-frame-type frame)) - do (setf reset-frame frame)) - (ensure-equal 200 (http-response-status response)) - (ensure-equal 1 opened-stream-id) - (ensure-true reset-frame) - (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id reset-frame)) - (ensure-equal (octets 0 0 0 8) - (http-kit/http2::%h2-frame-payload reset-frame)) - (http-kit/http2:close-http2-connection connection))) + (failure nil)) + (unwind-protect + (progn + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/cancel") + :on-stream-open + (lambda (stream-id cancel-function) + (setf opened-stream-id stream-id) + (funcall cancel-function))) + (error (condition) + (setf failure condition))) + (ensure-true (typep failure 'http-connection-error)) + (ensure-equal '(:local-cancel 1 8) + (http-connection-error-cause failure)) + (ensure-equal 1 opened-stream-id) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (let ((reader + (http-kit/http2::%h2-reader-for + (subseq (binary-session-output stream) + (length (h2-preface))))) + (reset-frame nil)) + (loop for frame = (http-kit/http2::%h2-read-frame + reader 16384 nil nil) + until (eq frame :eof) + when (= 3 (http-kit/http2::%h2-frame-type frame)) + do (setf reset-frame frame)) + (ensure-true reset-frame) + (ensure-equal 1 (http-kit/http2::%h2-frame-stream-id reset-frame)) + (ensure-equal (octets 0 0 0 8) + (http-kit/http2::%h2-frame-payload reset-frame)))) + (http-kit/http2:close-http2-connection connection)))) + (deftest http2-public-connection-cancel-during-flow-control-wait-reuses-slot + (let* ((initial-input + (concatenate-octets + (h2-frame 4 0 0 + (octets 0 3 0 0 0 1 0 4 0 0 0 1)) + (h2-frame 1 5 1 (octets #x88)))) + (input + (make-array (length initial-input) + :element-type (quote (unsigned-byte 8)) + :adjustable t + :fill-pointer t + :initial-contents initial-input)) + (stream + (make-instance (quote binary-session-stream) :input input)) + (connection + (http-kit/http2:make-http2-connection :stream stream)) + (wait-symbol + (quote http-kit/http2::%h2-scheduler-condition-wait)) + (original-wait (symbol-function wait-symbol)) + (flow-wait-entered (sb-thread:make-semaphore :count 0)) + (upload-finished (sb-thread:make-semaphore :count 0)) + (upload-thread nil) + (upload-stream-id nil) + (upload-error nil) + (producer-calls 0) + (follow-up-stream-id nil)) + (unwind-protect + (progn + (ensure-equal + 200 + (http-response-status + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/warmup")))) + (ensure-equal + 1 + (http-kit/http2:http2-connection-peer-max-concurrent-streams + connection)) + (setf (symbol-function wait-symbol) + (lambda (wait-connection deadline clock-function) + (sb-thread:signal-semaphore flow-wait-entered) + (funcall original-wait + wait-connection deadline clock-function))) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf + (http-kit/http2::%http2-connection-scheduler-reader-active-p + connection) + t)) + (setf upload-thread + (sb-thread:make-thread + (lambda () + (unwind-protect + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request + :method "POST" + :uri "https://127.0.0.1/cancel-upload") + :request-body-function + (lambda (maximum-size) + (declare (ignore maximum-size)) + (incf producer-calls) + (octets 65 66)) + :request-body-length 2 + :on-stream-open + (lambda (stream-id cancel-function) + (declare (ignore cancel-function)) + (setf upload-stream-id stream-id))) + (error (condition) + (setf upload-error condition))) + (sb-thread:signal-semaphore upload-finished)))))) + (ensure-true + (sb-thread:wait-on-semaphore flow-wait-entered :timeout 5)) + (ensure-equal 3 upload-stream-id) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (ensure-equal + 0 + (http-kit/http2::%h2-connection-stream-window + connection upload-stream-id)) + (ensure-true + (plusp + (http-kit/http2::%http2-connection-peer-connection-window-size + connection)))) + (ensure-true + (http-kit/http2:cancel-http2-stream + connection upload-stream-id)) + (ensure-true + (sb-thread:wait-on-semaphore upload-finished :timeout 5)) + (sb-thread:join-thread upload-thread) + (setf upload-thread nil) + (ensure-true + (typep upload-error (quote http-connection-error))) + (ensure-equal + (list :local-cancel upload-stream-id 8) + (http-connection-error-cause upload-error)) + (ensure-equal 1 producer-calls) + (ensure-true + (http-kit/http2:http2-connection-open-p connection)) + (let ((upload-data + (remove-if-not + (lambda (frame) + (and (= 0 + (http-kit/http2::%h2-frame-type frame)) + (= upload-stream-id + (http-kit/http2::%h2-frame-stream-id frame)))) + (h2-output-frames stream)))) + (ensure-equal 1 (length upload-data)) + (ensure-equal + (octets 65) + (http-kit/http2::%h2-frame-payload (first upload-data)))) + (setf (symbol-function wait-symbol) original-wait) + (loop for octet across (h2-frame 1 5 5 (octets #x88)) + do (vector-push-extend + octet (binary-session-input stream))) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf + (http-kit/http2::%http2-connection-scheduler-reader-active-p + connection) + nil) + (http-kit/http2::%h2-scheduler-broadcast connection)) + (ensure-equal + 200 + (http-response-status + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/reused-slot") + :on-stream-open + (lambda (stream-id cancel-function) + (declare (ignore cancel-function)) + (setf follow-up-stream-id stream-id))))) + (ensure-equal 5 follow-up-stream-id) + (ensure-true + (http-kit/http2:http2-connection-open-p connection)) + (ensure-equal + 1 + (count-if + (lambda (frame) + (and (= 0 (http-kit/http2::%h2-frame-type frame)) + (= upload-stream-id + (http-kit/http2::%h2-frame-stream-id frame)))) + (h2-output-frames stream))) + (when upload-thread + (when (and upload-stream-id + (http-kit/http2:http2-connection-open-p connection)) + (http-kit/http2:cancel-http2-stream + connection upload-stream-id)) + (sb-thread:join-thread upload-thread)) + (setf (symbol-function wait-symbol) original-wait) + (http-kit/http2:close-http2-connection connection))))) (deftest http2-public-connection-cancel-custom-and-direct-api (let* ((stream (make-instance 'binary-session-stream :input (h2-response-wire (octets)))) (connection - (http-kit/http2:make-http2-connection :stream stream))) - (http-kit/http2:send-http2-request-over-connection - connection - (make-http-request :method "GET" - :uri "https://127.0.0.1/cancel-custom") - :on-stream-open - (lambda (stream-id cancel-function) - (ensure-equal 1 stream-id) - (funcall cancel-function :error-code 7))) - (ensure-true - (http-kit/http2:cancel-http2-stream connection 1 :error-code 9)) - (let ((reader - (http-kit/http2::%h2-reader-for - (subseq (binary-session-output stream) - (length (h2-preface))))) - (reset-payloads nil)) - (loop for frame = (http-kit/http2::%h2-read-frame - reader 16384 nil nil) - until (eq frame :eof) - when (= 3 (http-kit/http2::%h2-frame-type frame)) - do (progn - (ensure-equal - 1 (http-kit/http2::%h2-frame-stream-id frame)) - (push (http-kit/http2::%h2-frame-payload frame) - reset-payloads))) - (ensure-equal (list (octets 0 0 0 7) (octets 0 0 0 9)) - (nreverse reset-payloads))) - (http-kit/http2:close-http2-connection connection))) + (http-kit/http2:make-http2-connection :stream stream)) + (failure nil)) + (unwind-protect + (progn + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/cancel-custom") + :on-stream-open + (lambda (stream-id cancel-function) + (ensure-equal 1 stream-id) + (funcall cancel-function :error-code 7))) + (error (condition) + (setf failure condition))) + (ensure-true (typep failure 'http-connection-error)) + (ensure-equal '(:local-cancel 1 7) + (http-connection-error-cause failure)) + (ensure-true + (http-kit/http2:cancel-http2-stream connection 1 :error-code 9)) + (let ((reader + (http-kit/http2::%h2-reader-for + (subseq (binary-session-output stream) + (length (h2-preface))))) + (reset-payloads nil)) + (loop for frame = (http-kit/http2::%h2-read-frame + reader 16384 nil nil) + until (eq frame :eof) + when (= 3 (http-kit/http2::%h2-frame-type frame)) + do (progn + (ensure-equal + 1 (http-kit/http2::%h2-frame-stream-id frame)) + (push (http-kit/http2::%h2-frame-payload frame) + reset-payloads))) + (ensure-equal (list (octets 0 0 0 7) (octets 0 0 0 9)) + (nreverse reset-payloads)))) + (http-kit/http2:close-http2-connection connection)))) (deftest http2-public-connection-cancel-rejects-invalid-callback (let* ((stream (make-instance 'binary-session-stream @@ -781,9 +1010,21 @@ (and (= 4 (http-kit/http2::%h2-frame-type frame)) (= 1 (http-kit/http2::%h2-frame-flags frame)))) frames)) - (ensure-equal 8 - (count 8 frames - :key #'http-kit/http2::%h2-frame-type))) + (let ((window-update-frames + (remove-if-not + (lambda (frame) + (= 8 (http-kit/http2::%h2-frame-type frame))) + frames))) + (ensure-equal 7 (length window-update-frames)) + (ensure-equal 4 + (count 0 window-update-frames + :key #'http-kit/http2::%h2-frame-stream-id)) + (ensure-equal 2 + (count 1 window-update-frames + :key #'http-kit/http2::%h2-frame-stream-id)) + (ensure-equal 1 + (count 3 window-update-frames + :key #'http-kit/http2::%h2-frame-stream-id)))) (ensure-true (http-kit/http2:http2-connection-session-started-p connection)) (http-kit/http2:close-http2-connection connection))))) @@ -1263,6 +1504,121 @@ (ensure-equal (length body) (funcall body-position)) (ensure-true (plusp (funcall body-calls))) (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-public-produced-body-respects-peer-frame-size-shrink + (let* ((initial-frame-size 32768) + (reduced-frame-size 16384) + (body (make-array initial-frame-size + :element-type '(unsigned-byte 8) + :initial-element #x5a)) + (stream + (make-instance 'binary-session-stream + :input + (concatenate-octets + (h2-frame 4 0 0 + (octets 0 5 0 0 128 0)) + (h2-frame 1 5 1 + (h2-header-block (cons ":status" "200"))) + (h2-frame 1 5 3 + (h2-header-block (cons ":status" "200")))))) + (connection + (http-kit/http2:make-http2-connection + :stream stream :max-frame-size initial-frame-size)) + (window-symbol + (find-symbol "%H2-CONNECTION-STREAM-WINDOW" "HTTP-KIT/HTTP2")) + (original-window (symbol-function window-symbol)) + (shrink-frame + (h2-frame-object 4 0 0 (octets 0 5 0 0 64 0))) + (settings-applied-p nil) + (producer-calls 0) + (producer-thread nil) + (response nil)) + (unwind-protect + (progn + (let ((warmup-response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/frame-size-warmup")))) + (ensure-equal 200 (http-response-status warmup-response)) + (ensure-equal + initial-frame-size + (http-kit/http2:http2-connection-peer-max-frame-size connection))) + (setf (symbol-function window-symbol) + (lambda (window-connection stream-id) + ;; Apply a peer SETTINGS frame after the body loop has read + ;; its old frame limit but before the DATA writer takes the lock. + (when (and (eq window-connection connection) + (eq sb-thread:*current-thread* producer-thread) + (= stream-id 3) + (plusp producer-calls) + (not settings-applied-p)) + (setf settings-applied-p t) + (http-kit/http2::%h2-scheduler-control-frame + connection shrink-frame + (http-kit/http2::%h2-scheduler-control-writer + connection + (http-kit/http2::%http2-connection-clock-function + connection)))) + (funcall original-window window-connection stream-id))) + (setf response + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "POST" + :uri "https://127.0.0.1/frame-size-upload") + :request-body-function + (lambda (maximum-size) + (incf producer-calls) + (setf producer-thread sb-thread:*current-thread*) + (when (= producer-calls 1) + (ensure-equal initial-frame-size maximum-size) + body)) + :request-body-length (length body)) + (http-kit:http-connection-error (condition) + (error "HTTP/2 frame-size request failed with cause: ~A" + (http-kit:http-connection-error-cause condition))))) + (ensure-equal 200 (http-response-status response)) + (ensure-true settings-applied-p) + (ensure-equal + reduced-frame-size + (http-kit/http2:http2-connection-peer-max-frame-size connection)) + (let* ((reader + (http-kit/http2::%h2-reader-for + (subseq (binary-session-output stream) + (length (h2-preface))))) + (frames + (loop for frame = (http-kit/http2::%h2-read-frame + reader initial-frame-size nil nil) + until (eq frame :eof) + collect frame)) + (data-frames + (remove-if-not + (lambda (frame) + (and (= 0 (http-kit/http2::%h2-frame-type frame)) + (= 3 (http-kit/http2::%h2-frame-stream-id frame)))) + frames)) + (payloads + (mapcar #'http-kit/http2::%h2-frame-payload data-frames))) + (ensure-equal 2 (length data-frames)) + (ensure-true + (every (lambda (frame) + (<= (length (http-kit/http2::%h2-frame-payload frame)) + reduced-frame-size)) + data-frames)) + (ensure-equal (list reduced-frame-size reduced-frame-size) + (mapcar #'length payloads)) + (ensure-equal body (apply #'concatenate-octets payloads)) + (ensure-equal 0 + (logand 1 + (http-kit/http2::%h2-frame-flags + (first data-frames)))) + (ensure-equal 1 + (logand 1 + (http-kit/http2::%h2-frame-flags + (second data-frames)))))) + (setf (symbol-function window-symbol) original-window) + (http-kit/http2:close-http2-connection connection)))) (deftest http2-client-control-budget-counts-all-but-rst-stream (let* ((stream (make-instance 'binary-session-stream @@ -1395,6 +1751,111 @@ (ensure-true (http-kit/http2:http2-connection-open-p connection)) (ensure-true (http-kit/http2:http2-connection-draining-p connection)) (http-kit/http2:close-http2-connection connection))) +(deftest http2-public-control-goaway-serializes-with-scheduled-stream-open + (let* ((stream + (make-instance + 'binary-session-stream + :input (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 5 1 (octets #x88)) + (h2-frame 1 5 3 (octets #x88))))) + (connection (http-kit/http2:make-http2-connection :stream stream)) + (scheduler-lock + (http-kit/http2::%http2-connection-scheduler-lock connection)) + (goaway-started (sb-thread:make-semaphore :count 0)) + (goaway-completed (sb-thread:make-semaphore :count 0)) + (request-started (sb-thread:make-semaphore :count 0)) + (goaway-thread nil) + (request-thread nil) + (goaway-error nil) + (request-error nil) + (request-response nil) + (goaway-started-p nil) + (request-started-p nil) + (goaway-waiting-for-lock-p nil) + (goaway-completed-after-unlock-p nil)) + (unwind-protect + (progn + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" :uri "https://127.0.0.1/first")) + (sb-thread:with-mutex (scheduler-lock) + (setf goaway-thread + (sb-thread:make-thread + (lambda () + (sb-thread:signal-semaphore goaway-started) + (handler-case + (http-kit/http2:send-http2-goaway connection) + (error (condition) + (setf goaway-error condition))) + (sb-thread:signal-semaphore goaway-completed)))) + (setf goaway-started-p + (sb-thread:wait-on-semaphore goaway-started :timeout 5) + goaway-waiting-for-lock-p + (loop with deadline = + (+ (get-internal-real-time) + (* 5 internal-time-units-per-second)) + for waiting-for = + (sb-thread::thread-waiting-for goaway-thread) + when (eq waiting-for scheduler-lock) + return t + while (< (get-internal-real-time) deadline) + do (sb-thread:thread-yield) + finally (return nil)) + request-thread + (sb-thread:make-thread + (lambda () + (sb-thread:signal-semaphore request-started) + (handler-case + (setf request-response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request + :method "GET" + :uri "https://127.0.0.1/second"))) + (error (condition) + (setf request-error condition))))) + request-started-p + (sb-thread:wait-on-semaphore request-started :timeout 5))) + (setf goaway-completed-after-unlock-p + (sb-thread:wait-on-semaphore goaway-completed :timeout 5)) + (sb-thread:join-thread goaway-thread) + (setf goaway-thread nil) + (sb-thread:join-thread request-thread) + (setf request-thread nil) + (ensure-true goaway-started-p) + (ensure-true request-started-p) + (ensure-true goaway-waiting-for-lock-p) + (ensure-true goaway-completed-after-unlock-p) + (ensure-true (null goaway-error)) + (ensure-true (http-kit/http2:http2-connection-draining-p connection)) + (let* ((frames (h2-output-frames stream)) + (request-headers + (find-if (lambda (frame) + (and (= 1 (http-kit/http2::%h2-frame-type frame)) + (= 3 (http-kit/http2::%h2-frame-stream-id frame)))) + frames)) + (goaway + (find-if (lambda (frame) + (= 7 (http-kit/http2::%h2-frame-type frame))) + frames)) + (last-stream-id + (http-kit/http2::%h2-u32 + (http-kit/http2::%h2-frame-payload goaway) 0))) + (ensure-true goaway) + (if request-headers + (progn + (ensure-true (null request-error)) + (ensure-equal 200 (http-response-status request-response)) + (ensure-true (>= last-stream-id 3))) + (progn + (ensure-true (typep request-error 'http-protocol-error)) + (ensure-equal 1 last-stream-id))))) + (when goaway-thread + (sb-thread:join-thread goaway-thread)) + (when request-thread + (sb-thread:join-thread request-thread)) + (http-kit/http2:close-http2-connection connection)))) #+sbcl (deftest http2-public-control-priority-wire-boundaries @@ -1780,6 +2241,221 @@ (http-kit/http2:close-http2-connection connection) (ensure-equal 1 closed)))) +#+sbcl +(progn + (defun scheduled-ping-wire-p (sequence start end) + ;; A PING frame has nine bytes of header and eight bytes of payload. + ;; Offsets are zero-based: type is at 3, flags at 4, stream ID starts at 5. + (and (= (- end start) 17) + (= (aref sequence (+ start 3)) + http-kit/http2::+http2-ping-type+) + (zerop (aref sequence (+ start 4))) + (zerop (http-kit/http2::%h2-u32 sequence (+ start 5))))) + + (defclass scheduled-ping-eof-stream (binary-session-stream) + ((eof-started + :initarg :eof-started + :reader scheduled-ping-eof-started) + (eof-release + :initarg :eof-release + :reader scheduled-ping-eof-release) + (ping-write-started + :initarg :ping-write-started + :reader scheduled-ping-write-started) + (ping-write-release + :initarg :ping-write-release + :reader scheduled-ping-write-release) + (ping-write-failed + :initarg :ping-write-failed + :reader scheduled-ping-write-failed) + (ping-written + :initarg :ping-written + :reader scheduled-ping-written) + (defer-ping-write-p + :initarg :defer-ping-write-p + :reader scheduled-ping-defer-write-p) + (fail-ping-write-p + :initarg :fail-ping-write-p + :reader scheduled-ping-fail-write-p) + (closed-p + :initform nil + :accessor scheduled-ping-stream-closed-p))) + + (defmethod sb-gray:stream-read-sequence + ((stream scheduled-ping-eof-stream) sequence &optional (start 0) end) + (declare (ignore start end)) + (when (>= (binary-session-input-position stream) + (length (binary-session-input stream))) + (sb-thread:signal-semaphore (scheduled-ping-eof-started stream)) + (sb-thread:wait-on-semaphore (scheduled-ping-eof-release stream))) + (call-next-method)) + + (defmethod sb-gray:stream-write-sequence + ((stream scheduled-ping-eof-stream) sequence &optional (start 0) end) + (let ((end (or end (length sequence)))) + (if (scheduled-ping-wire-p sequence start end) + (progn + (sb-thread:signal-semaphore + (scheduled-ping-write-started stream)) + (when (scheduled-ping-defer-write-p stream) + (sb-thread:wait-on-semaphore + (scheduled-ping-write-release stream)) + (when (scheduled-ping-fail-write-p stream) + (sb-thread:signal-semaphore + (scheduled-ping-write-failed stream)) + (error 'http-connection-error + :message "The test stream failed the PING write." + :operation :http2-write + :cause :test-write-failure)) + (when (scheduled-ping-stream-closed-p stream) + (error 'http-connection-error + :message "The test stream closed before the PING write." + :operation :http2-write + :cause :closed))) + (prog1 (call-next-method) + (sb-thread:signal-semaphore (scheduled-ping-written stream)))) + (call-next-method))))) + +#+sbcl +(deftest http2-scheduler-ping-reader-eof-handoff + (dolist (mode '(:ping-written-before-eof + :eof-recorded-before-ping-write-finishes + :ping-write-fails-before-reader-eof)) + (let* ((payload (octets 1 2 3 4 5 6 7 8)) + (eof-started (sb-thread:make-semaphore :count 0)) + (eof-release (sb-thread:make-semaphore :count 0)) + (ping-write-started (sb-thread:make-semaphore :count 0)) + (ping-write-release (sb-thread:make-semaphore :count 0)) + (ping-write-failed (sb-thread:make-semaphore :count 0)) + (ping-written (sb-thread:make-semaphore :count 0)) + (stream + (make-instance 'scheduled-ping-eof-stream + :input (h2-response-wire (octets)) + :eof-started eof-started + :eof-release eof-release + :ping-write-started ping-write-started + :ping-write-release ping-write-release + :ping-write-failed ping-write-failed + :ping-written ping-written + :defer-ping-write-p + (member mode + '(:eof-recorded-before-ping-write-finishes + :ping-write-fails-before-reader-eof)) + :fail-ping-write-p + (eq mode :ping-write-fails-before-reader-eof))) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (closed-stream) + (ensure-true (eq stream closed-stream)) + (setf (scheduled-ping-stream-closed-p stream) t) + (incf closed)))) + (request-thread nil) + (ping-thread nil) + (request-error nil) + (ping-error nil) + (eof-released-p nil) + (ping-write-released-p nil)) + (unwind-protect + (progn + (ensure-equal + 200 + (http-response-status + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/first")))) + (setf request-thread + (sb-thread:make-thread + (lambda () + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request + :method "GET" + :uri "https://127.0.0.1/second")) + (error (condition) + (setf request-error condition)))))) + (ensure-true + (sb-thread:wait-on-semaphore eof-started :timeout 5)) + (setf ping-thread + (sb-thread:make-thread + (lambda () + (handler-case + (http-kit/http2:ping-http2-connection + connection :payload payload) + (error (condition) + (setf ping-error condition)))))) + (ecase mode + (:ping-written-before-eof + (ensure-true + (sb-thread:wait-on-semaphore ping-written :timeout 5)) + (setf eof-released-p t) + (sb-thread:signal-semaphore eof-release) + (sb-thread:join-thread request-thread) + (setf request-thread nil) + (sb-thread:join-thread ping-thread) + (setf ping-thread nil)) + (:eof-recorded-before-ping-write-finishes + (ensure-true + (sb-thread:wait-on-semaphore ping-write-started :timeout 5)) + (setf eof-released-p t) + (sb-thread:signal-semaphore eof-release) + (sb-thread:join-thread request-thread) + (setf request-thread nil) + (setf ping-write-released-p t) + (sb-thread:signal-semaphore ping-write-release) + (sb-thread:join-thread ping-thread) + (setf ping-thread nil)) + (:ping-write-fails-before-reader-eof + (ensure-true + (sb-thread:wait-on-semaphore ping-write-started :timeout 5)) + (setf ping-write-released-p t) + (sb-thread:signal-semaphore ping-write-release) + (ensure-true + (sb-thread:wait-on-semaphore ping-write-failed :timeout 5)) + (sb-thread:join-thread ping-thread) + (setf ping-thread nil) + (setf eof-released-p t) + (sb-thread:signal-semaphore eof-release) + (sb-thread:join-thread request-thread) + (setf request-thread nil))) + (ensure-true (typep request-error 'http-connection-error)) + (ensure-equal :http2-read (http-error-operation request-error)) + (ensure-equal :eof (http-connection-error-cause request-error)) + (if (eq mode :ping-write-fails-before-reader-eof) + (progn + (ensure-true (typep ping-error 'http-connection-error)) + (ensure-equal :http2-write (http-error-operation ping-error)) + (ensure-equal :test-write-failure + (http-connection-error-cause ping-error))) + (progn + (ensure-true (typep ping-error 'http-protocol-error)) + (ensure-equal :http2-client (http-error-operation ping-error)) + (ensure-equal :eof (http-protocol-error-detail ping-error)))) + (ensure-equal 1 closed) + (ensure-true (not (http-kit/http2:http2-connection-open-p connection))) + (ensure-equal + (if (eq mode :ping-written-before-eof) 1 0) + (count-if + (lambda (frame) + (and (= 6 (http-kit/http2::%h2-frame-type frame)) + (zerop (http-kit/http2::%h2-frame-flags frame)))) + (h2-output-frames stream)))) + (unless eof-released-p + (setf eof-released-p t) + (sb-thread:signal-semaphore eof-release)) + (unless ping-write-released-p + (setf ping-write-released-p t) + (sb-thread:signal-semaphore ping-write-release)) + (when request-thread + (sb-thread:join-thread request-thread)) + (when ping-thread + (sb-thread:join-thread ping-thread)) + (http-kit/http2:close-http2-connection connection))))) + #+sbcl (deftest http2-public-runtime-boundary-batch-completed-stream (dolist (mode '(:headers :data :other-stream)) @@ -1833,6 +2509,36 @@ (binary-session-input-position stream)) (http-kit/http2:close-http2-connection connection) (ensure-equal 1 closed)))) +#+sbcl +(deftest http2-scheduler-unknown-data-active-entry + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 0 0 3 (octets 9)) + (h2-frame 1 5 1 + (h2-header-block (cons ":status" "200"))))) + (stream (make-instance 'binary-session-stream :input input)) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (closed-stream) + (ensure-true (eq stream closed-stream)) + (incf closed)))) + (result + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" + :uri "https://127.0.0.1/active")) + (http-protocol-error (condition) condition)))) + (ensure-true (typep result 'http-protocol-error)) + (ensure-equal :http2-read (http-error-operation result)) + (ensure-equal 3 (http-protocol-error-detail result)) + (ensure-equal 1 closed) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 closed))) #+sbcl (deftest http2-public-runtime-boundary-batch-goaway-last-stream @@ -2506,9 +3212,9 @@ (ensure-equal (if good (length (binary-session-input stream)) 0) (binary-session-input-position stream)) (let ((frames (h2-output-frames stream))) - (ensure-equal (if good '(4 1 0 0 4 8 8) '(4 1)) + (ensure-equal (if good '(4 1 0 0 4 8) '(4 1)) (mapcar #'http-kit/http2::%h2-frame-type frames)) - (ensure-equal (if good '(0 1 1 1 0 1 0) '(0 1)) + (ensure-equal (if good '(0 1 1 1 0 0) '(0 1)) (mapcar #'http-kit/http2::%h2-frame-stream-id frames))) (when good (let ((last (car (last (remove-if-not @@ -2517,7 +3223,7 @@ (ensure-equal 0 (http-kit/http2::%h2-frame-type last)) (ensure-equal 1 (http-kit/http2::%h2-frame-flags last)) (ensure-equal (octets) (http-kit/http2::%h2-frame-payload last))) - (dolist (frame (last (h2-output-frames stream) 2)) + (dolist (frame (last (h2-output-frames stream) 1)) (ensure-equal 0 (http-kit/http2::%h2-frame-flags frame)) (ensure-equal (octets 0 0 0 1) (http-kit/http2::%h2-frame-payload frame)))) (ensure-equal (if good 0 1) closed) @@ -2556,13 +3262,13 @@ (ensure-equal (octets 90) (http-response-body result)))) (ensure-equal (length input) (binary-session-input-position stream)) (let ((frames (h2-output-frames stream))) - (ensure-equal (if operation '(4 1 4) '(4 1 4 8 8)) + (ensure-equal (if operation '(4 1 4) '(4 1 4 8)) (mapcar #'http-kit/http2::%h2-frame-type frames)) - (ensure-equal (if operation '(0 1 0) '(0 1 0 1 0)) + (ensure-equal (if operation '(0 1 0) '(0 1 0 0)) (mapcar #'http-kit/http2::%h2-frame-stream-id frames)) (ensure-equal 1 (http-kit/http2::%h2-frame-flags (third frames))) (unless operation - (dolist (frame (last frames 2)) + (dolist (frame (last frames 1)) (ensure-equal 0 (http-kit/http2::%h2-frame-flags frame)) (ensure-equal (octets 0 0 0 3) (http-kit/http2::%h2-frame-payload frame))))) (ensure-equal (if operation 1 0) closed) @@ -2660,3 +3366,421 @@ (ensure-equal :closed (http-connection-error-cause failure)) (ensure-true (equalp before (binary-session-output stream)))) (ensure-equal 1 closed)))) +#+sbcl +(progn + (defclass scheduler-close-after-ping-write-stream (binary-session-stream) + ((ping-write-started + :initarg :ping-write-started + :reader scheduler-close-after-ping-write-started) + (ping-write-release + :initarg :ping-write-release + :reader scheduler-close-after-ping-write-release))) + + (defmethod sb-gray:stream-write-sequence + ((stream scheduler-close-after-ping-write-stream) sequence + &optional (start 0) end) + (let ((end (or end (length sequence)))) + (if (scheduled-ping-wire-p sequence start end) + (prog1 (call-next-method) + (sb-thread:signal-semaphore + (scheduler-close-after-ping-write-started stream)) + (sb-thread:wait-on-semaphore + (scheduler-close-after-ping-write-release stream))) + (call-next-method))))) +#+sbcl +(deftest http2-scheduler-ping-close-after-write + (let* ((payload (octets 9 8 7 6 5 4 3 2)) + (ping-write-started (sb-thread:make-semaphore :count 0)) + (ping-write-release (sb-thread:make-semaphore :count 0)) + (stream + (make-instance 'scheduler-close-after-ping-write-stream + :input (octets) + :ping-write-started ping-write-started + :ping-write-release ping-write-release)) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (closed-stream) + (ensure-true (eq stream closed-stream)) + (incf closed)))) + (ping-error nil) + (ping-thread nil) + (ping-write-released-p nil)) + (setf (http-kit/http2::%http2-connection-session-started-p connection) t) + (unwind-protect + (progn + (setf ping-thread + (sb-thread:make-thread + (lambda () + (setf ping-error + (handler-case + (http-kit/http2:ping-http2-connection + connection :payload payload) + (error (condition) condition)))))) + (ensure-true + (sb-thread:wait-on-semaphore ping-write-started :timeout 5)) + (ensure-true + (http-kit/http2:http2-connection-open-p connection)) + (http-kit/http2:close-http2-connection connection) + (setf ping-write-released-p t) + (sb-thread:signal-semaphore ping-write-release) + (sb-thread:join-thread ping-thread) + (setf ping-thread nil) + (ensure-true (typep ping-error 'http-kit:http-connection-error)) + (ensure-equal :http2-control (http-kit:http-error-operation ping-error)) + (ensure-equal :closed + (http-kit:http-connection-error-cause ping-error)) + (ensure-false + (http-kit/http2:http2-connection-open-p connection)) + (ensure-true + (scheduled-ping-wire-p + (binary-session-output stream) 0 + (length (binary-session-output stream)))) + (ensure-equal 1 closed)) + (http-kit/http2:close-http2-connection connection) + (unless ping-write-released-p + (setf ping-write-released-p t) + (sb-thread:signal-semaphore ping-write-release)) + (when ping-thread + (sb-thread:join-thread ping-thread))))) +#+sbcl +(deftest http2-scheduler-response-waits-for-late-callback + (let* ((request (make-http-request :method "GET" + :uri "https://scheduler.test/late-callback")) + (stream + (make-instance 'binary-session-stream + :input (h2-response-wire (octets 65 66)))) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (closed-stream) + (ensure-true (eq stream closed-stream)) + (incf closed)))) + (runner-symbol + 'http-kit/http2::%h2-scheduler-run-entry-callbacks) + (original-runner (symbol-function runner-symbol)) + (runner-calls 0) + (callback-enqueued-p nil) + (late-callback-calls 0) + (body-chunks nil) + (response nil)) + (unwind-protect + (progn + (setf (symbol-function runner-symbol) + (lambda (received-connection entry clock-function) + (funcall original-runner + received-connection entry clock-function) + (incf runner-calls) + (unless callback-enqueued-p + (setf callback-enqueued-p t) + (http-kit/http2::%h2-scheduler-queue-callback + received-connection entry + (list :information + (lambda (information) + (declare (ignore information)) + (incf late-callback-calls)) + nil))))) + (setf response + (http-kit/http2:send-http2-request-over-connection + connection request + :on-body-chunk + (lambda (chunk) + (push (copy-seq chunk) body-chunks)))) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets 65 66) (http-response-body response)) + (ensure-equal (list (octets 65 66)) (nreverse body-chunks)) + (ensure-equal 2 runner-calls) + (ensure-true callback-enqueued-p) + (ensure-equal 1 late-callback-calls) + (ensure-equal 0 closed) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 closed)) + (setf (symbol-function runner-symbol) original-runner) + (http-kit/http2:close-http2-connection connection)))) +#+sbcl +(deftest http2-scheduler-extra-runtime-edge-boundaries + (let ((request (make-http-request :method "GET" + :uri "https://scheduler.test/edge"))) + (labels ((make-connection (input) + (let* ((stream (make-instance 'binary-session-stream :input input)) + (closes (list 0)) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream + (lambda (received) + (ensure-true (eq received stream)) + (incf (car closes)))))) + (values stream connection closes))) + (entry (request stream-id &key error) (let ((entry (http-kit/http2::%make-h2-batch-entry :request request :stream-id stream-id))) (setf (http-kit/http2::%h2-batch-entry-error entry) error) entry))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (let* ((active-entry (entry request 1)) + (clock-calls 0) + (clock (lambda () (if (= (incf clock-calls) 1) 0 2))) + (observed nil)) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list active-entry))) + (setf observed + (handler-case + (http-kit/http2::%h2-scheduler-wait-until + connection (lambda () nil) + (http-kit/http2::%h2-reader-for stream) nil 1 clock active-entry) + (http-kit:http-timeout (condition) condition))) + (ensure-true (typep observed 'http-kit:http-timeout)) + (ensure-equal :read (http-kit:http-error-operation observed)) + (ensure-true (eq observed + (http-kit/http2::%h2-batch-entry-error active-entry))) + (ensure-true + (http-kit/http2::%h2-batch-entry-local-retired-p active-entry)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (ensure-equal (h2-frame 3 0 1 (octets 0 0 0 8)) + (binary-session-output stream)) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 (car closes)))) + (dolist (timeout-p '(nil t)) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (let* ((failure + (if timeout-p + (make-condition 'http-kit:http-timeout + :message "scheduled request write timed out" + :operation :write :kind :write) + (make-condition 'http-kit:http-connection-error + :message "scheduled request write failed" + :operation :http2-write + :cause :test-write))) + (observed + (handler-case + (http-kit/http2::%h2-scheduler-open-entry + connection request nil nil + (http-kit/http2::%http2-connection-max-header-bytes + connection) + (http-kit/http2::%http2-connection-max-fields connection) + (http-kit/http2::%http2-connection-max-body-bytes + connection) + nil #'http-kit::%monotonic-time nil nil nil t nil + (lambda (wire) + (ensure-true (plusp (length wire))) + (error failure))) + (http-kit:http-error (condition) condition)))) + (ensure-true (eq failure observed)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-equal 3 + (http-kit/http2::%http2-connection-next-stream-id + connection)) + (ensure-equal 0 + (http-kit/http2::%http2-connection-scheduler-last-opened-stream-id + connection)) + (ensure-false + (http-kit/http2::%http2-connection-session-started-p connection)) + (ensure-equal 0 (length (binary-session-output stream))) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 (car closes))))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (http-kit/http2:close-http2-connection connection) + (let ((observed + (handler-case + (http-kit/http2::%h2-scheduler-open-entry + connection request nil nil + (http-kit/http2::%http2-connection-max-header-bytes connection) + (http-kit/http2::%http2-connection-max-fields connection) + (http-kit/http2::%http2-connection-max-body-bytes connection) + nil #'http-kit::%monotonic-time nil nil nil t nil nil) + (http-kit:http-connection-error (condition) condition)))) + (ensure-true (typep observed 'http-kit:http-connection-error)) + (ensure-equal :http2-client (http-kit:http-error-operation observed)) + (ensure-equal :closed (http-kit:http-connection-error-cause observed)) + (ensure-equal 0 (length (binary-session-output stream))) + (ensure-equal 1 (car closes)))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (let* ((entry-error + (make-condition 'http-kit:http-connection-error + :message "request flow-control entry failed" + :operation :http2-write :cause :test-flow-error)) + (active-entry (entry request 1 :error entry-error)) + (observed nil)) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list active-entry))) + (setf observed + (handler-case + (http-kit/http2::%h2-scheduler-wait-for-window + connection 1 nil #'http-kit::%monotonic-time) + (http-kit:http-connection-error (condition) condition))) + (ensure-true (eq entry-error observed)) + (ensure-equal :test-flow-error + (http-kit:http-connection-error-cause observed)) + (ensure-equal 0 (length (binary-session-output stream))) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 (car closes)))) + (dolist (closed-p '(nil t)) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (when closed-p + (http-kit/http2:close-http2-connection connection)) + (let ((observed + (handler-case + (http-kit/http2::%h2-scheduler-wait-for-window + connection 1 nil #'http-kit::%monotonic-time) + (http-kit:http-connection-error (condition) condition)))) + (ensure-true (typep observed 'http-kit:http-connection-error)) + (ensure-equal :http2-write (http-kit:http-error-operation observed)) + (ensure-equal :closed (http-kit:http-connection-error-cause observed)) + (ensure-equal 0 (length (binary-session-output stream))) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 (car closes))))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (setf (http-kit/http2::%http2-connection-peer-max-concurrent-streams + connection) + 0) + (http-kit/http2:close-http2-connection connection) + (let ((observed + (handler-case + (http-kit/http2::%h2-scheduler-wait-for-capacity + connection nil nil nil #'http-kit::%monotonic-time) + (http-kit:http-connection-error (condition) condition)))) + (ensure-true (typep observed 'http-kit:http-connection-error)) + (ensure-equal :http2-write (http-kit:http-error-operation observed)) + (ensure-equal :closed (http-kit:http-connection-error-cause observed)) + (ensure-equal 0 (length (binary-session-output stream))) + (ensure-equal 1 (car closes)))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (declare (ignore stream)) + (let* ((old-entry-error + (make-condition 'http-kit:http-protocol-error + :message "earlier stream error" + :operation :http2-read :detail :earlier)) + (failure + (make-condition 'http-kit:http-connection-error + :message "reader failed" + :operation :http2-read :cause :reader-failure)) + (old-ping-error + (make-condition 'http-kit:http-connection-error + :message "earlier ping error" + :operation :http2-control :cause :earlier)) + (old-entry (entry request 1 :error old-entry-error)) + (active-entry (entry request 3)) + (acknowledged + (http-kit/http2::%make-h2-scheduler-ping-waiter + (octets 0 0 0 0 0 0 0 1))) + (pending + (http-kit/http2::%make-h2-scheduler-ping-waiter + (octets 0 0 0 0 0 0 0 2))) + (failed + (http-kit/http2::%make-h2-scheduler-ping-waiter + (octets 0 0 0 0 0 0 0 3)))) + (setf (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p + acknowledged) + t + (http-kit/http2::%h2-scheduler-ping-waiter-failure failed) + old-ping-error) + (http-kit/http2::%h2-with-scheduler-lock (connection) + (setf (http-kit/http2::%http2-connection-scheduler-entries connection) + (list old-entry active-entry) + (http-kit/http2::%http2-connection-scheduler-ping-waiters + connection) + (list acknowledged pending failed))) + (http-kit/http2::%h2-scheduler-fail-connection connection failure) + (http-kit/http2::%h2-scheduler-fail-connection connection failure) + (ensure-true (http-kit/http2::%http2-connection-closed-p connection)) + (ensure-false + (http-kit/http2::%http2-connection-scheduler-entries connection)) + (ensure-true + (eq old-entry-error (http-kit/http2::%h2-batch-entry-error old-entry))) + (ensure-true + (eq failure (http-kit/http2::%h2-batch-entry-error active-entry))) + (ensure-true + (http-kit/http2::%h2-scheduler-ping-waiter-acknowledged-p acknowledged)) + (ensure-false + (http-kit/http2::%h2-scheduler-ping-waiter-failure acknowledged)) + (ensure-true + (eq failure + (http-kit/http2::%h2-scheduler-ping-waiter-failure pending))) + (ensure-true + (eq old-ping-error + (http-kit/http2::%h2-scheduler-ping-waiter-failure failed))) + (ensure-equal 1 (car closes)))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (setf (http-kit/http2::%http2-connection-session-started-p connection) t) + (http-kit/http2:close-http2-connection connection) + (let ((observed + (handler-case + (http-kit/http2::%h2-scheduler-ping + connection (octets 0 0 0 0 0 0 0 9) nil + #'http-kit::%monotonic-time) + (http-kit:http-connection-error (condition) condition)))) + (ensure-true (typep observed 'http-kit:http-connection-error)) + (ensure-equal :http2-control (http-kit:http-error-operation observed)) + (ensure-equal :closed (http-kit:http-connection-error-cause observed)) + (ensure-equal 0 (length (binary-session-output stream))) + (ensure-equal 1 (car closes)))) + (multiple-value-bind (stream connection closes) + (make-connection (h2-response-wire (octets))) + (let ((observed + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection request + :on-stream-open + (lambda (stream-id cancel) + (declare (ignore cancel)) + (ensure-equal 1 stream-id) + (http-kit/http2:close-http2-connection connection))) + (http-kit:http-connection-error (condition) condition)))) + (ensure-true (typep observed 'http-kit:http-connection-error)) + (ensure-equal :http2-read (http-kit:http-error-operation observed)) + (ensure-equal :closed (http-kit:http-connection-error-cause observed)) + (ensure-equal 0 (binary-session-input-position stream)) + (ensure-equal '(1) + (mapcar #'http-kit/http2::%h2-frame-stream-id + (remove-if-not + (lambda (frame) + (= 1 (http-kit/http2::%h2-frame-type frame))) + (h2-output-frames stream)))) + (ensure-equal 1 (car closes)))) + (multiple-value-bind (stream connection closes) + (make-connection (h2-response-wire (octets 65 66))) + (let* ((chunks nil) + (response + (http-kit/http2:send-http2-request-over-connection + connection request + :on-body-chunk + (lambda (chunk) (push (copy-seq chunk) chunks))))) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets 65 66) (http-response-body response)) + (ensure-equal (list (octets 65 66)) (nreverse chunks)) + (ensure-true + (member 8 (mapcar #'http-kit/http2::%h2-frame-type + (h2-output-frames stream)))) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 (car closes)))) + (multiple-value-bind (stream connection closes) + (make-connection (octets)) + (let ((observed + (handler-case + (http-kit/http2::%h2-send-http2-request-over-connection-scheduled + connection request :clock-function :invalid-clock) + (http-kit:http-protocol-error (condition) condition)))) + (ensure-true (typep observed 'http-kit:http-protocol-error)) + (ensure-equal :http2-client (http-kit:http-error-operation observed)) + (ensure-equal :invalid-clock + (http-kit:http-protocol-error-detail observed)) + (ensure-equal 0 (binary-session-input-position stream)) + (ensure-equal 0 (length (binary-session-output stream))) + (ensure-true (http-kit/http2:http2-connection-open-p connection)) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 (car closes))))))) diff --git a/t/tests-http2-read-errors.lisp b/t/tests-http2-read-errors.lisp index 797c0d63..18e90187 100644 --- a/t/tests-http2-read-errors.lisp +++ b/t/tests-http2-read-errors.lisp @@ -240,14 +240,14 @@ #+sbcl (deftest http2-public-single-blocked-upload-errors - (dolist (case (list (list (h2-frame 1 5 1 (octets #x88)) '(1 1 5) nil 0) - (list (h2-frame 4 1 0 (octets)) '(4 0 1) nil 0) - (list (concatenate-octets + (dolist (case (list (list :input (h2-frame 1 5 1 (octets #x88)) :detail '(1 1 5) :eof-p nil :expected-acks 0 :expected-callbacks 0) + (list :input (h2-frame 4 1 0 (octets)) :detail '(4 0 1) :eof-p nil :expected-acks 0 :expected-callbacks 0) + (list :input (concatenate-octets (h2-frame 4 0 0 (octets)) (h2-frame 1 4 1 (octets #x88)) (h2-frame 0 1 1 (octets 9))) - :eof t 1))) - (destructuring-bind (input detail eof-p expected-acks) case + :detail :eof :eof-p t :expected-acks 1 :expected-callbacks 1))) + (destructuring-bind (&key input detail eof-p expected-acks expected-callbacks) case (let* ((body (make-array 65536 :element-type '(unsigned-byte 8) :initial-element 7)) (stream (make-instance 'binary-session-stream :input input)) (closes 0) @@ -277,7 +277,7 @@ (ensure-equal :http2-read (http-error-operation failure)) (ensure-equal detail (if eof-p (http-connection-error-cause failure) (http-protocol-error-detail failure))) - (ensure-equal 0 callbacks) + (ensure-equal expected-callbacks callbacks) (ensure-equal (length input) (binary-session-input-position stream)) (multiple-value-bind (sent count ack) (h2-output-data-summary stream) (ensure-equal 65535 (length sent)) @@ -353,8 +353,9 @@ (ensure-true (eq original seen)) (ensure-equal :test-callback (http-error-operation result)) (ensure-equal phase (http-protocol-error-detail result)) - (ensure-equal 1 closes) - (ensure-false (http-kit/http2:http2-connection-open-p connection))) + (ensure-equal (if (eq phase :body) 0 1) closes) + (ensure-equal (eq phase :body) + (http-kit/http2:http2-connection-open-p connection))) (progn (ensure-equal 200 (http-response-status result)) (ensure-equal (octets 0 255) (http-response-body result)) @@ -373,12 +374,38 @@ (:body (list (octets 0))) (t (list (octets 0) (octets 255)))) (nreverse chunks)) + ;; Earlier DATA gets stream and connection credit; END_STREAM gets connection credit only. (let ((frames (h2-output-frames stream))) (ensure-equal - (case phase ((:open :producer) '(4 1)) (:body '(4 1 0 4)) - (t '(4 1 0 4 8 8 8 8))) + (case phase + ((:open :producer) + (list http-kit/http2::+http2-settings-type+ + http-kit/http2::+http2-headers-type+)) + (:body + (list http-kit/http2::+http2-settings-type+ + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-data-type+ + http-kit/http2::+http2-settings-type+ + http-kit/http2::+http2-window-update-type+ + http-kit/http2::+http2-rst-stream-type+)) + ((nil) + (list http-kit/http2::+http2-settings-type+ + http-kit/http2::+http2-headers-type+ + http-kit/http2::+http2-data-type+ + http-kit/http2::+http2-settings-type+ + http-kit/http2::+http2-window-update-type+ + http-kit/http2::+http2-window-update-type+ + http-kit/http2::+http2-window-update-type+))) (mapcar #'http-kit/http2::%h2-frame-type frames)) (ensure-equal '(0 4) (mapcar #'http-kit/http2::%h2-frame-flags (subseq frames 0 2))) + (when (null phase) + (ensure-equal '(1 0 0) + (mapcar #'http-kit/http2::%h2-frame-stream-id + (nthcdr 4 frames)))) + (when (eq phase :body) + (ensure-equal '(0 1) + (mapcar #'http-kit/http2::%h2-frame-stream-id + (nthcdr 4 frames)))) (multiple-value-bind (sent count ack) (h2-output-data-summary stream) (ensure-equal (if (member phase '(:open :producer)) (octets) (octets 7)) sent) (ensure-equal (if (member phase '(:open :producer)) 0 1) count) diff --git a/t/tests-http2-response-boundaries.lisp b/t/tests-http2-response-boundaries.lisp index d460e71b..4344e8cb 100644 --- a/t/tests-http2-response-boundaries.lisp +++ b/t/tests-http2-response-boundaries.lisp @@ -97,19 +97,21 @@ (http-kit/http2::%h2-reader-for (let ((header-block (h2-header-block (cons ":status" "200") - (cons "content-length" "3")))) + (cons "content-length" "4")))) (concatenate-octets (h2-frame 4 0 0 (octets)) (h2-frame 1 4 1 header-block) - (h2-frame 0 9 1 (octets 2 1 2 3 0 0))))) + (h2-frame 0 8 1 (octets 2 1 2 3 0 0)) + (h2-frame 0 1 1 (octets 4))))) (lambda (wire) (push wire sent)) 16384 nil nil 65536 65536 "GET" nil t))) (ensure-equal 200 (http-response-status response) "WINDOW_UPDATE response status") - (ensure-equal (octets 1 2 3) (http-response-body response) + (ensure-equal (octets 1 2 3 4) (http-response-body response) "WINDOW_UPDATE response body") (ensure-equal - (list (h2-frame 8 0 0 (octets 0 0 0 6)) + (list (h2-frame 8 0 0 (octets 0 0 0 1)) + (h2-frame 8 0 0 (octets 0 0 0 6)) (h2-frame 8 0 1 (octets 0 0 0 6)) (h2-frame 4 1 0 (octets))) sent @@ -320,13 +322,13 @@ (binary-session-input-position stream)) (ensure-equal 0 closes) (let ((frames (h2-output-frames stream))) - (ensure-equal '(4 1 4 8 8) + (ensure-equal '(4 1 4 8) (mapcar #'http-kit/http2::%h2-frame-type frames)) - (ensure-equal '(0 5 1 0 0) + (ensure-equal '(0 5 1 0) (mapcar #'http-kit/http2::%h2-frame-flags frames)) - (ensure-equal '(0 1 0 1 0) + (ensure-equal '(0 1 0 0) (mapcar #'http-kit/http2::%h2-frame-stream-id frames)) - (dolist (frame (last frames 2)) + (dolist (frame (last frames 1)) (ensure-equal (octets 0 0 0 2) (http-kit/http2::%h2-frame-payload frame))))) (http-kit/http2:close-http2-connection connection) @@ -451,10 +453,12 @@ :request-body-length (when producer-p (length body)) :on-body-chunk (lambda (chunk) - (ensure-equal (length input) (binary-session-input-position stream)) + (ensure-true (< (binary-session-input-position stream) + (length input))) (multiple-value-bind (sent count ack) (h2-output-data-summary stream) (declare (ignore count ack)) - (ensure-equal 65536 (length sent))) + (ensure-true (< (length sent) (length body))) + (ensure-true (equalp sent (subseq body 0 (length sent))))) (push chunk chunks))))) (ensure-equal 200 (http-response-status response)) (ensure-equal (octets 0 255) (http-response-body response)) @@ -482,6 +486,68 @@ (ensure-equal 1 closes) (ensure-false (open-stream-p stream))))) +#+sbcl +(deftest http2-public-single-blocked-upload-no-error-reset-keeps-response + (dolist (producer-p '(nil t)) + (let* ((body (make-array 65536 :element-type '(unsigned-byte 8))) + (early-response + (concatenate-octets + (h2-frame 1 4 1 (h2-header-block (cons ":status" "200") + (cons "content-length" "2"))) + (h2-frame 0 0 1 (octets 0)) + (h2-frame 0 1 1 (octets 255)))) + (reset-input (concatenate-octets + (h2-frame 4 0 0 (octets)) early-response + (h2-frame 3 0 1 (octets 0 0 0 0)))) + (input (concatenate-octets + reset-input (h2-frame 8 0 0 (octets 0 0 0 1)))) + (stream (make-instance 'binary-session-stream :input input)) + (closes 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :close-stream (lambda (actual) + (ensure-true (eq stream actual)) + (incf closes) + (close actual))))) + (dotimes (index (length body)) + (setf (aref body index) (mod index 256))) + (unwind-protect + (multiple-value-bind (producer position calls) + (make-octet-body-producer body) + (declare (ignore position calls)) + (let ((response + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "POST" :uri "https://example.test/upload" + :body (unless producer-p body)) + :request-body-function (when producer-p producer) + :request-body-length (when producer-p (length body))))) + (ensure-equal 200 (http-response-status response)) + (ensure-equal (octets 0 255) (http-response-body response)) + (ensure-true (>= (binary-session-input-position stream) + (length reset-input))) + (multiple-value-bind (sent count ack) (h2-output-data-summary stream) + (ensure-equal 65535 (length sent)) + (ensure-true (equalp sent (subseq body 0 65535))) + (ensure-equal 4 count) + (ensure-equal 1 ack)) + (let ((data (remove-if-not + (lambda (frame) (= 0 (http-kit/http2::%h2-frame-type frame))) + (h2-output-frames stream)))) + (ensure-equal '(16384 16384 16384 16383) + (mapcar (lambda (frame) + (length (http-kit/http2::%h2-frame-payload frame))) data)) + (ensure-equal '(0 0 0 0) + (mapcar #'http-kit/http2::%h2-frame-flags data)) + (ensure-true (every (lambda (frame) + (= 1 (http-kit/http2::%h2-frame-stream-id frame))) data))) + (ensure-equal 0 closes) + (ensure-true (http-kit/http2:http2-connection-open-p connection)))) + (http-kit/http2:close-http2-connection connection)) + (ensure-equal 1 closes) + (ensure-false (open-stream-p stream))))) + #+sbcl (deftest http2-public-connection-peer-hpack-setting-boundaries (dolist (case (list (list 0 (octets #x20 #x88) nil) @@ -620,6 +686,139 @@ (ensure-equal 3 (http-size-limit-exceeded-observed result)) (ensure-equal (if streaming-p (octets) (octets 7)) body) (ensure-false chunks))))))) +(deftest http2-connection-request-limits-cannot-weaken-connection-caps + (dolist (batch-p (list nil t)) + (dolist (kind (list :headers :body)) + (let* ((header-limit 256) + (body-limit 2) + (header-block + (h2-header-block + (cons ":status" "200") + (cons "x-padding" (make-string 512 :initial-element #\a)))) + (response-headers + (if (eq kind :headers) + header-block + (h2-header-block (cons ":status" "200")))) + (input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 4 1 response-headers) + (if (eq kind :body) + (h2-frame 0 1 1 (octets 1 2 3)) + (octets)))) + (stream (make-instance 'binary-session-stream :input input)) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :max-header-bytes header-limit + :max-body-bytes body-limit + :close-stream (lambda (actual) + (ensure-true (eq stream actual)) + (incf closed) + (close actual)))) + (request + (make-http-request :method "GET" :uri "https://limits.test/")) + (result + (handler-case + (if batch-p + (first + (http-kit/http2:send-http2-requests-over-connection + connection (list request) + :max-header-bytes 4096 + :max-body-bytes 4096)) + (http-kit/http2:send-http2-request-over-connection + connection request + :max-header-bytes 4096 + :max-body-bytes 4096)) + (http-size-limit-exceeded (condition) condition)))) + (ensure-true (typep result 'http-size-limit-exceeded)) + (ensure-equal :response-parse (http-error-operation result)) + (ensure-equal (if (eq kind :headers) :headers :body) + (http-size-limit-exceeded-kind result)) + (ensure-equal (if (eq kind :headers) header-limit body-limit) + (http-size-limit-exceeded-limit result)) + (ensure-equal 1 closed) + (ensure-false + (http-kit/http2:http2-connection-open-p connection)) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 closed))))) +#+sbcl +(deftest http2-scheduler-frame-dispatch-error-fails-all-active-requests + (let* ((input + (concatenate-octets + (h2-frame 4 0 0 (octets)) + (h2-frame 1 4 1 (h2-header-block (cons ":status" "200"))) + (h2-frame 1 4 3 (h2-header-block (cons ":status" "200"))) + (h2-frame 0 1 1 (octets 1 2)))) + (stream (make-instance 'binary-session-stream :input input)) + (closed 0) + (connection + (http-kit/http2:make-http2-connection + :stream stream + :max-body-bytes 1 + :close-stream (lambda (actual) + (ensure-true (eq stream actual)) + (incf closed) + (close actual)))) + (first-opened (sb-thread:make-semaphore :count 0)) + (second-opened (sb-thread:make-semaphore :count 0)) + (release-first (sb-thread:make-semaphore :count 0)) + (first-error nil) + (second-error nil) + (first-thread nil) + (second-thread nil)) + (labels ((send-first () + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" :uri "https://errors.test/first") + :on-stream-open + (lambda (stream-id cancel) + (declare (ignore cancel)) + (ensure-equal 1 stream-id) + (sb-thread:signal-semaphore first-opened) + (sb-thread:wait-on-semaphore release-first :timeout 5))) + (error (condition) + (setf first-error condition)))) + (send-second () + (handler-case + (http-kit/http2:send-http2-request-over-connection + connection + (make-http-request :method "GET" :uri "https://errors.test/second") + :on-stream-open + (lambda (stream-id cancel) + (declare (ignore cancel)) + (ensure-equal 3 stream-id) + (sb-thread:signal-semaphore second-opened))) + (error (condition) + (setf second-error condition))))) + (unwind-protect + (progn + (setf first-thread (sb-thread:make-thread #'send-first)) + (ensure-true + (sb-thread:wait-on-semaphore first-opened :timeout 5)) + (setf second-thread (sb-thread:make-thread #'send-second)) + (ensure-true + (sb-thread:wait-on-semaphore second-opened :timeout 5)) + (sb-thread:signal-semaphore release-first) + (sb-thread:join-thread first-thread) + (setf first-thread nil) + (sb-thread:join-thread second-thread) + (setf second-thread nil) + (ensure-true (typep first-error 'http-size-limit-exceeded)) + (ensure-true (typep second-error 'http-size-limit-exceeded)) + (ensure-false + (http-kit/http2:http2-connection-open-p connection)) + (ensure-equal 1 closed)) + (sb-thread:signal-semaphore second-opened) + (sb-thread:signal-semaphore release-first) + (when first-thread + (ignore-errors (sb-thread:join-thread first-thread))) + (when second-thread + (ignore-errors (sb-thread:join-thread second-thread))) + (http-kit/http2:close-http2-connection connection) + (ensure-equal 1 closed))))) #+sbcl (deftest http2-public-padded-streaming-trailers-cleanup