+++ /dev/null
-! Copyright (C) 2021 Your name.
-! See http://factorcode.org/license.txt for BSD license.
-USING: byte-arrays help.markup help.syntax kernel sequences strings ;
-IN: http2.hpack
-
-HELP: hpack-context
-{ $class-description "Stores the context for a hpack decoder or encoder. This is primarily the current state of the dynamic table." } ;
-
-HELP: hpack-decode
-{ $values
- { "decode-context" hpack-context } { "block" byte-array }
- { "updated-context" hpack-context } { "decoded" sequence }
-}
-{ $description "Decodes the given byte array (or byte vector) in the given hpack context. Outputs the updated context, and the decoded header block as a sequence of pairs." } ;
-
-HELP: hpack-decode-error
-{ $values
- { "error-msg" string }
-}
-{ $description "Throws a " { $link hpack-decode-error } " error." }
-{ $error-description "Thrown for any of the possible errors specified in RFC7541 for decoding hpack encoded byte strings." } ;
-
-HELP: hpack-encode
-{ $values
- { "encode-context" hpack-context } { "headers" sequence }
- { "updated-context" hpack-context } { "block" byte-array }
-}
-{ $description "Encodes the sequence of headers using the given context. Outputs the updated context and the encoded header block, as a byte array." } ;
-
-ARTICLE: "http2.hpack" "HTTP/2 HPACK"
-{ $vocab-link "http2.hpack" }
-;
-
-{ hpack-encode hpack-decode } related-words
-
-ABOUT: "http2.hpack"
+++ /dev/null
-! Copyright (C) 2021 Your name.
-! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test http2.hpack http2.hpack.private accessors
-kernel sequences ;
-IN: http2.hpack.tests
-
-! constants are from RFC 7541, appendix C, various sections
-CONSTANT: c1 B{ 234 31 154 10 42 }
-CONSTANT: c21 B{ 0x40 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
- 0x6b 0x65 0x79 0x0d 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
- 0x68 0x65 0x61 0x64 0x65 0x72 }
-CONSTANT: c22 B{ 0x04 0x0c 0x2f 0x73 0x61 0x6d 0x70 0x6c 0x65
- 0x2f 0x70 0x61 0x74 0x68 }
-CONSTANT: c23 B{ 0x10 0x08 0x70 0x61 0x73 0x73 0x77 0x6f 0x72
- 0x64 0x06 0x73 0x65 0x63 0x72 0x65 0x74 }
-CONSTANT: c24 B{ 0x82 }
-
-CONSTANT: c31 B{ 0x82 0x86 0x84 0x41 0x0f 0x77 0x77 0x77 0x2e
- 0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
-CONSTANT: c32 B{ 0x82 0x86 0x84 0xbe 0x58 0x08 0x6e 0x6f 0x2d
- 0x63 0x61 0x63 0x68 0x65 }
-CONSTANT: c33 B{ 0x82 0x87 0x85 0xbf 0x40 0x0a 0x63 0x75 0x73
- 0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 0x0c 0x63 0x75 0x73
- 0x74 0x6f 0x6d 0x2d 0x76 0x61 0x6c 0x75 0x65 }
-
-CONSTANT: c41 B{ 0x82 0x86 0x84 0x41 0x8c 0xf1 0xe3 0xc2 0xe5
- 0xf2 0x3a 0x6b 0xa0 0xab 0x90 0xf4 0xff }
-CONSTANT: c42 B{ 0x82 0x86 0x84 0xbe 0x58 0x86 0xa8 0xeb 0x10
- 0x64 0x9c 0xbf }
-CONSTANT: c43 B{ 0x82 0x87 0x85 0xbf 0x40 0x88 0x25 0xa8 0x49
- 0xe9 0x5b 0xa9 0x7d 0x7f 0x89 0x25 0xa8 0x49 0xe9 0x5b
- 0xb8 0xe8 0xb4 0xbf }
-
-! These headers are the same as those for section 4
-CONSTANT: c31h { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" } }
-CONSTANT: c32h { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" }
- { "cache-control" "no-cache" } }
-CONSTANT: c33h { { ":method" "GET" } { ":scheme" "https" }
- { ":path" "/index.html" } { ":authority" "www.example.com" }
- { "custom-key" "custom-value" } }
-
-CONSTANT: c51 B{ 0x48 0x03 0x33 0x30 0x32 0x58 0x07 0x70 0x72
-0x69 0x76 0x61 0x74 0x65 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20 0x32
-0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
-0x30 0x3a 0x31 0x33 0x3a 0x32 0x31 0x20 0x47 0x4d 0x54 0x6e
-0x17 0x68 0x74 0x74 0x70 0x73 0x3a 0x2f 0x2f 0x77 0x77 0x77
-0x2e 0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
-CONSTANT: c52 B{ 0x48 0x03 0x33 0x30 0x37 0xc1 0xc0 0xbf }
-CONSTANT: c53 B{ 0x88 0xc1 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20
-0x32 0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
-0x30 0x3a 0x31 0x33 0x3a 0x32 0x32 0x20 0x47 0x4d 0x54 0xc0
-0x5a 0x04 0x67 0x7a 0x69 0x70 0x77 0x38 0x66 0x6f 0x6f 0x3d
-0x41 0x53 0x44 0x4a 0x4b 0x48 0x51 0x4b 0x42 0x5a 0x58 0x4f
-0x51 0x57 0x45 0x4f 0x50 0x49 0x55 0x41 0x58 0x51 0x57 0x45
-0x4f 0x49 0x55 0x3b 0x20 0x6d 0x61 0x78 0x2d 0x61 0x67 0x65
-0x3d 0x33 0x36 0x30 0x30 0x3b 0x20 0x76 0x65 0x72 0x73 0x69
-0x6f 0x6e 0x3d 0x31 }
-
-CONSTANT: c61 B{ 0x48 0x82 0x64 0x02 0x58 0x85 0xae 0xc3 0x77
- 0x1a 0x4b 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10 0x54 0xd4
- 0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66 0xe0 0x82 0xa6
- 0x2d 0x1b 0xff 0x6e 0x91 0x9d 0x29 0xad 0x17 0x18 0x63 0xc7
- 0x8f 0x0b 0x97 0xc8 0xe9 0xae 0x82 0xae 0x43 0xd3 }
-CONSTANT: c62 B{ 0x48 0x83 0x64 0x0e 0xff 0xc1 0xc0 0xbf }
-CONSTANT: c63 B{ 0x88 0xc1 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10
- 0x54 0xd4 0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66
- 0xe0 0x84 0xa6 0x2d 0x1b 0xff 0xc0 0x5a 0x83 0x9b 0xd9 0xab
- 0x77 0xad 0x94 0xe7 0x82 0x1d 0xd7 0xf2 0xe6 0xc7 0xb3 0x35
- 0xdf 0xdf 0xcd 0x5b 0x39 0x60 0xd5 0xaf 0x27 0x08 0x7f 0x36
- 0x72 0xc1 0xab 0x27 0x0f 0xb5 0x29 0x1f 0x95 0x87 0x31 0x60
- 0x65 0xc0 0x03 0xed 0x4e 0xe5 0xb1 0x06 0x3d 0x50 0x07 }
-
-! These headers are the same as those for section 6
-CONSTANT: c51h { { ":status" "302" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" } }
-CONSTANT: c52h { { ":status" "307" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" } }
-CONSTANT: c53h { { ":status" "200" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
- { "location" "https://www.example.com" }
- { "content-encoding" "gzip" }
- { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" } }
-
-
-! tests come from RFC 7541, Appendix C
-
-! RFC7541 Appendex C.1
-{ 1 10 } [ c1 0 5 decode-integer nipd ] unit-test
-{ 4 1337 } [ c1 1 5 decode-integer nipd ] unit-test
-{ 5 42 } [ c1 4 8 decode-integer nipd ] unit-test
-
-
-! RFC7541 Appendix C.2.1 subset
-{ 12 "custom-key" }
-[ c21 1 decode-string nipd ] unit-test
-
-! RFC7541 Appendix C.4.3 subset
-{ 24 "custom-value" }
-[ c43 14 decode-string nipd ] unit-test
-
-! RFC7541 Appendix C.2.1
-{ T{ hpack-context f 4096 { { "custom-key" "custom-header" } } }
- 26 { "custom-key" "custom-header" } }
-[ hpack-context new c21 0 decode-field nipd ] unit-test
-
-! RFC7541 Appendix C.2.2
-{ T{ hpack-context f 4096 { } } 14 { ":path" "/sample/path" } }
-[ hpack-context new c22 0 decode-field nipd ] unit-test
-
-! RFC7541 Appendix C.2.3
-{ T{ hpack-context f 4096 { } } 17 { "password" "secret" } }
-[ hpack-context new c23 0 decode-field nipd ] unit-test
-
-! RFC7541 Appendix C.2.4
-{ T{ hpack-context f 4096 { } } 1 { ":method" "GET" } }
-[ hpack-context new c24 0 decode-field nipd ] unit-test
-
-
-! RFC7541 Appendix C.3
-{
- { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" } }
- { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" }
- { "cache-control" "no-cache" } }
- { { ":method" "GET" } { ":scheme" "https" }
- { ":path" "/index.html" } { ":authority" "www.example.com" }
- { "custom-key" "custom-value" } }
- T{ hpack-context f 4096 { { "custom-key" "custom-value" }
- { "cache-control" "no-cache" }
- { ":authority" "www.example.com" } } }
-}
-[ hpack-context new c31 c32 c33 [ hpack-decode swap ] tri@ ] unit-test
-
-! RFC7541 Appendix C.4
-{
- { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" } }
- { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" }
- { "cache-control" "no-cache" } }
- { { ":method" "GET" } { ":scheme" "https" }
- { ":path" "/index.html" } { ":authority" "www.example.com" }
- { "custom-key" "custom-value" } }
- T{ hpack-context f 4096 { { "custom-key" "custom-value" }
- { "cache-control" "no-cache" }
- { ":authority" "www.example.com" } } }
-}
-[ hpack-context new c41 c42 c43 [ hpack-decode swap ] tri@ ] unit-test
-
-! RFC7541 Appendix C.5
-{
- {
- { ":status" "302" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" }
- }
- {
- { ":status" "307" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" }
- }
- {
- { ":status" "200" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
- { "location" "https://www.example.com" }
- { "content-encoding" "gzip" }
- { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
- }
- T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
- { "content-encoding" "gzip" }
- { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
-}
-[ hpack-context new 256 >>max-size c51 c52 c53
- [ hpack-decode swap ] tri@ ] unit-test
-
-! RFC7541 Appendix C.6
-{
- {
- { ":status" "302" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" }
- }
- {
- { ":status" "307" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" }
- }
- {
- { ":status" "200" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
- { "location" "https://www.example.com" }
- { "content-encoding" "gzip" }
- { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
- }
- T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
- { "content-encoding" "gzip" }
- { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
-}
-[ hpack-context new 256 >>max-size c61 c62 c63
- [ hpack-decode swap ] tri@ ] unit-test
-
-
-! encoding can be tested primarily by ensuring the encoding and
-! decoding of an object yields the same object (since encoding
-! does not have a well defined output other then `decodable').
-
-
-! integer and string encoding tests
-{ B{ 0b00101010 } } [ 0b00100000 10 5 encode-integer ] unit-test
-{ B{ 0b01011111 0b10011010 0b00001010 } } [ 0b01000000 1337 5 encode-integer ] unit-test
-{ B{ 0b00101010 } } [ 0b00000000 42 8 encode-integer ] unit-test
-
-{ B{ 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 } }
-[ "custom-key" encode-string-raw ] unit-test
-
-{ B{ 0x88 0x25 0xa8 0x49 0xe9 0x5b 0xa9 0x7d 0x7f } }
-[ "custom-key" encode-string-huffman ] unit-test
-
-
-! single header encoding check, mirrors the tests from RFC 7541, Appendix C.2
-{ t t { "custom-key" "custom-header" } }
-[ hpack-context new { "custom-key" "custom-header" } encode-field
- hpack-context new swap 0 decode-field
- [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
-] unit-test
-
-{ t t { ":path" "/sample/path" } }
-[ hpack-context new { ":path" "/sample/path" } encode-field
- hpack-context new swap 0 decode-field
- [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
-] unit-test
-
-{ t t { "password" "secret" } }
-[ hpack-context new { "password" "secret" } encode-field
- hpack-context new swap 0 decode-field
- [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
-] unit-test
-
-{ t t { ":method" "GET" } }
-[ hpack-context new { ":method" "GET" } encode-field
- hpack-context new swap 0 decode-field
- [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
-] unit-test
-
-
-! many header encoding check, using same values from RFC7541 Appendix C.3 and C.5
-{
- { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" } }
- { { ":method" "GET" } { ":scheme" "http" }
- { ":path" "/" } { ":authority" "www.example.com" }
- { "cache-control" "no-cache" } }
- { { ":method" "GET" } { ":scheme" "https" }
- { ":path" "/index.html" } { ":authority" "www.example.com" }
- { "custom-key" "custom-value" } }
- t
-}
-[ hpack-context new c31h c32h c33h [ hpack-encode swap ] tri@
- [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
- = ! check that the encode and decode contexts are identical
-] unit-test
-
-{
- {
- { ":status" "302" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" }
- }
- {
- { ":status" "307" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
- { "location" "https://www.example.com" }
- }
- {
- { ":status" "200" }
- { "cache-control" "private" }
- { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
- { "location" "https://www.example.com" }
- { "content-encoding" "gzip" }
- { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
- }
- t
-}
-[ hpack-context new c51h c52h c53h [ hpack-encode swap ] tri@
- [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
- = ! check that the encode and decode contexts are identical
-] unit-test
-
+++ /dev/null
-USING: accessors arrays byte-arrays byte-vectors combinators fry
-http2.hpack.huffman io.encodings.string io.encodings.utf8 locals
-kernel math math.functions math.bitwise multiline sequences ;
-
-IN: http2.hpack
-
-TUPLE: hpack-context
- { max-size integer initial: 4096 } { dynamic-table initial: { } } ;
- ! default the max size to 4096 according to RFC7540
-
-ERROR: hpack-decode-error error-msg ;
-
-<PRIVATE
-
-! The static table for hpack compression/decompression,
-! from RFC 7541, Appendix A.
-CONSTANT: static-table {
- { f f } ! allows indexing to work out properly
- { ":authority" f }
- { ":method" "GET" }
- { ":method" "POST" }
- { ":path" "/" }
- { ":path" "/index.html" }
- { ":scheme" "http" }
- { ":scheme" "https" }
- { ":status" "200" }
- { ":status" "204" }
- { ":status" "206" }
- { ":status" "304" }
- { ":status" "400" }
- { ":status" "404" }
- { ":status" "500" }
- { "accept-charset" f }
- { "accept-encoding" "gzip, deflate" }
- { "accept-language" f }
- { "accept-ranges" f }
- { "accept" f }
- { "access-control-allow-origin" f }
- { "age" f }
- { "allow" f }
- { "authorization" f }
- { "cache-control" f }
- { "content-disposition" f }
- { "content-encoding" f }
- { "content-language" f }
- { "content-length" f }
- { "content-location" f }
- { "content-range" f }
- { "content-type" f }
- { "cookie" f }
- { "date" f }
- { "etag" f }
- { "expect" f }
- { "expires" f }
- { "from" f }
- { "host" f }
- { "if-match" f }
- { "if-modified-since" f }
- { "if-none-match" f }
- { "if-range" f }
- { "if-unmodified-since" f }
- { "last-modified" f }
- { "link" f }
- { "location" f }
- { "max-forwards" f }
- { "proxy-authenticate" f }
- { "proxy-authorization" f }
- { "range" f }
- { "referer" f }
- { "refresh" f }
- { "retry-after" f }
- { "server" f }
- { "set-cookie" f }
- { "strict-transport-security" f }
- { "transfer-encoding" f }
- { "user-agent" f }
- { "vary" f }
- { "via" f }
- { "www-authenticate" f }
-}
-
-: header-size ( header -- size )
- sum-lengths 32 +
- ;
-
-! gives the index in the dynamic table such that the sum of the
-! size of the elements before the index is less than or equal to
-! the desired-size, or f if no entries need to be removed to
-! attain the desired size
-:: dynamic-table-remove-index ( dynamic-table desired-size -- i/f )
- 0 dynamic-table [ header-size + dup desired-size >= ] find drop nip
- ;
-
-! shrinks the dynamic table size to the given size (size, *not*
-! length) (doesn't affect the max-size of the context)
-: shrink-dynamic-table ( dynamic-table shrink-to -- shrunk-dynamic-table )
- dupd dynamic-table-remove-index [ head ] when*
- ;
-
-:: add-header-to-table ( hpack-context header -- updated-context )
- hpack-context dynamic-table>> hpack-context max-size>>
- header header-size - shrink-dynamic-table
- header header-size hpack-context max-size>> <= [ header prefix ] when
- hpack-context swap >>dynamic-table
- ;
-
-: set-dynamic-table-size ( hpack-context new-size -- updated-decode-context )
- [ >>max-size ] keep
- [ dup dynamic-table>> ] dip shrink-dynamic-table >>dynamic-table
- ;
-
-! check bounds: i < len(static-table++decode-context) and i > 0
-: check-index-bounds ( index decode-context -- )
- [ drop 0 > ] [ dynamic-table>> length static-table length + < ] 2bi
- and [ "invalid index given" hpack-decode-error ] unless ! if not valid throw error
- ;
-
-: get-header-from-table ( hpack-context table-index -- field )
- [ swap check-index-bounds ] 2keep
- dup static-table length < ! check if in static table
- [ static-table nth nip ]
- [ static-table length - swap dynamic-table>> nth ]
- if ;
-
-: search-imperfect ( header table -- imperfect/f )
- swap first '[ _ first = ] find drop
- ;
-
-: search-given-table ( header table -- imperfect/f perfect/f )
- [ search-imperfect ] [ index ] 2bi
- ;
-
-: correct-dynamic-index ( dynamic-index/f -- whole-table-index/f )
- [ static-table length + ] [ f ] if*
- ;
-
-: search-static-table ( header -- imperfect/f perfect/f )
- static-table search-given-table ;
-
-: search-dynamic-table ( header hpack-context -- imperfect/f perfect/f )
- dynamic-table>> search-given-table
- [ correct-dynamic-index ] bi@
- ;
-
-: search-table ( header hpack-context -- imperfect/f perfect/f )
- [ drop search-static-table ] [ search-dynamic-table ] 2bi
- ! combine results from static and dynamic tables
- swapd [ or ] 2bi@
- ;
-
-
-! assumes the first-byte respects the prefix-length, such that
-! the last prefix-length bits are all 0.
-: encode-integer ( first-byte int prefix-length -- bytes )
- 2^ 1 - 2dup <
- [ drop bitor 1byte-array ]
- [ swap over [ bitor 1byte-array >byte-vector ] [ - ] 2bi*
- [ dup 128 >= ] [ [ 128 mod 128 + over push ] [ 128 /i ] bi ]
- while over push >byte-array
- ] if ;
-
-! encodes a string without huffman encoding.
-: encode-string-raw ( string -- bytes )
- utf8 encode
- 0 over length 7 encode-integer
- prepend
- ;
-
-: encode-string-huffman ( string -- bytes )
- huffman-encode
- 128 over length 7 encode-integer
- prepend
- ;
-
-:: encode-field ( encode-context header -- updated-context block )
- header encode-context search-table
- [ 128 swap 7 encode-integer encode-context swap nipd ]
- [ [ 64 swap 6 encode-integer ]
- [ 64 0 6 encode-integer header first encode-string-huffman append
- ] if*
- header second encode-string-huffman append
- encode-context header add-header-to-table swap ]
- if*
- ;
-
-! /*
-! version of decode integer that tries to be clever for less
-! stack stuff, but not sure if it actually is...
-:: decode-integer ( block current-index prefix-length -- block new-index number )
- current-index 1 + :> end-index!
- current-index block nth prefix-length 2^ 1 - [ mask ] keep over =
- [
- current-index 1 + block [ 7 bit? not ] find-from drop 1 + end-index!
- current-index 1 + end-index block subseq reverse
- 0 [ 127 mask swap 128 * + ] reduce
- +
- ] when
- [ block end-index ] dip ; ! */
-
-/*
-! initial version of decode-integer, which closely follows the
-! pseudocode from the rfc (RFC 7541, section 5.1)
-: decode-integer-fragment ( block index I M -- block index+1 I' M+7 block[index+1] )
- ! increment index and get block[index]
- [ 1 + 2dup swap nth ] 2dip
- ! stack: block index+1 block[index+1] I M
- ! compute I' = (block[index+1] & 127) * 2^M + I
- pick 127 mask 2 pick ^ * '[ _ + ] dip
- 7 + rot ;
-
-: decode-integer ( block current-index prefix-length -- block new-index number )
- ! get the current octet, compute mask, apply mask
- [ 2dup swap nth ] dip 2^ 1 - [ mask ] keep
- over =
- ! stack: block index I loop?
- [ 0
- [ 7 bit? ] [ decode-integer-fragment ] do while
- ! stack: block index I M, get rid of M, we don't need it
- drop ]
- when ! the prefix matches the mask (exactly all 1s), must loop
- [ 1 + ] dip ! increment the index before return
- ; ! */
-
-: decode-raw-string ( block current-index string-length -- block new-index string )
- over + dup [ pick subseq utf8 decode ] dip swap ;
-
-: decode-huffman-string ( block current-index string-length -- block new-index string )
- over + dup [ pick subseq huffman-decode ] dip swap
- ;
-
-: decode-string ( block current-index -- block new-index string )
- [ 7 decode-integer ] [ swap nth 7 bit? ] 2bi
- [ decode-huffman-string ] [ decode-raw-string ] if ;
-
-: decode-literal-header ( decode-context block index index-length -- decode-context block new-index field )
- decode-integer
- ! string name if 0, else indexed
- [ decode-string ] [ pickd get-header-from-table first ] if-zero
- [ decode-string ] dip swap 2array
- ;
-
-! block will be a byte array
-:: decode-field ( decode-context block index -- updated-context block new-index field/f )
- decode-context block index
- {
- ! indexed header field
- { [ index block nth 7 bit? ] [ 7 decode-integer
- decode-context swap get-header-from-table ] }
- ! Literal header field with incremental indexing
- { [ index block nth 6 bit? ] [ 6 decode-literal-header
- [ 2nip add-header-to-table ] 3keep ] }
- ! dynamic table size update
- { [ index block nth 5 bit? ] [ 5 decode-integer -rot f
- [ set-dynamic-table-size ] 3dip ] }
- ! literal header field without indexing
- [ 4 decode-literal-header ]
- } cond ;
-
-PRIVATE>
-
-! headers is a sequence of tuples represented the unencoded headers
-: hpack-encode ( encode-context headers -- updated-context block )
- [ encode-field ] map concat ;
-
-
-! should give the updated dtable, and the list of decoded
-! header fields. block is the bytestring (byte array) for the header block
-: hpack-decode ( decode-context block -- updated-context decoded )
- [let V{ } clone :> decoded-list
- 0 ! index in the block
- [ 2dup swap length < ] ! check that the block is longer than the index
- ! call decode-field and add the (possibly) decoded field to the list
- [ decode-field [ decoded-list push ]
- [ decoded-list [ "Table size update not at start of header block"
- hpack-decode-error ] unless-empty ] if* ]
- ! if the table was not empty, and we didn't get a header, throw an error.
- while
- 2drop decoded-list >array
- ! double check the header list size?
- ] ;
-
+++ /dev/null
-USING: accessors arrays assocs bit-arrays http2.hpack
-io.encodings.string io.encodings.utf8 kernel literals locals
-make math sequences ;
-
-IN: http2.hpack.huffman
-
-<<
-! Table contents from RFC 7541 Appendix B
-CONSTANT: huffman-table {
- { 0x1ff8 13 }
- { 0x7fffd8 23 }
- { 0xfffffe2 28 }
- { 0xfffffe3 28 }
- { 0xfffffe4 28 }
- { 0xfffffe5 28 }
- { 0xfffffe6 28 }
- { 0xfffffe7 28 }
- { 0xfffffe8 28 }
- { 0xffffea 24 }
- { 0x3ffffffc 30 }
- { 0xfffffe9 28 }
- { 0xfffffea 28 }
- { 0x3ffffffd 30 }
- { 0xfffffeb 28 }
- { 0xfffffec 28 }
- { 0xfffffed 28 }
- { 0xfffffee 28 }
- { 0xfffffef 28 }
- { 0xffffff0 28 }
- { 0xffffff1 28 }
- { 0xffffff2 28 }
- { 0x3ffffffe 30 }
- { 0xffffff3 28 }
- { 0xffffff4 28 }
- { 0xffffff5 28 }
- { 0xffffff6 28 }
- { 0xffffff7 28 }
- { 0xffffff8 28 }
- { 0xffffff9 28 }
- { 0xffffffa 28 }
- { 0xffffffb 28 }
- { 0x14 6 }
- { 0x3f8 10 }
- { 0x3f9 10 }
- { 0xffa 12 }
- { 0x1ff9 13 }
- { 0x15 6 }
- { 0xf8 8 }
- { 0x7fa 11 }
- { 0x3fa 10 }
- { 0x3fb 10 }
- { 0xf9 8 }
- { 0x7fb 11 }
- { 0xfa 8 }
- { 0x16 6 }
- { 0x17 6 }
- { 0x18 6 }
- { 0x0 5 }
- { 0x1 5 }
- { 0x2 5 }
- { 0x19 6 }
- { 0x1a 6 }
- { 0x1b 6 }
- { 0x1c 6 }
- { 0x1d 6 }
- { 0x1e 6 }
- { 0x1f 6 }
- { 0x5c 7 }
- { 0xfb 8 }
- { 0x7ffc 15 }
- { 0x20 6 }
- { 0xffb 12 }
- { 0x3fc 10 }
- { 0x1ffa 13 }
- { 0x21 6 }
- { 0x5d 7 }
- { 0x5e 7 }
- { 0x5f 7 }
- { 0x60 7 }
- { 0x61 7 }
- { 0x62 7 }
- { 0x63 7 }
- { 0x64 7 }
- { 0x65 7 }
- { 0x66 7 }
- { 0x67 7 }
- { 0x68 7 }
- { 0x69 7 }
- { 0x6a 7 }
- { 0x6b 7 }
- { 0x6c 7 }
- { 0x6d 7 }
- { 0x6e 7 }
- { 0x6f 7 }
- { 0x70 7 }
- { 0x71 7 }
- { 0x72 7 }
- { 0xfc 8 }
- { 0x73 7 }
- { 0xfd 8 }
- { 0x1ffb 13 }
- { 0x7fff0 19 }
- { 0x1ffc 13 }
- { 0x3ffc 14 }
- { 0x22 6 }
- { 0x7ffd 15 }
- { 0x3 5 }
- { 0x23 6 }
- { 0x4 5 }
- { 0x24 6 }
- { 0x5 5 }
- { 0x25 6 }
- { 0x26 6 }
- { 0x27 6 }
- { 0x6 5 }
- { 0x74 7 }
- { 0x75 7 }
- { 0x28 6 }
- { 0x29 6 }
- { 0x2a 6 }
- { 0x7 5 }
- { 0x2b 6 }
- { 0x76 7 }
- { 0x2c 6 }
- { 0x8 5 }
- { 0x9 5 }
- { 0x2d 6 }
- { 0x77 7 }
- { 0x78 7 }
- { 0x79 7 }
- { 0x7a 7 }
- { 0x7b 7 }
- { 0x7ffe 15 }
- { 0x7fc 11 }
- { 0x3ffd 14 }
- { 0x1ffd 13 }
- { 0xffffffc 28 }
- { 0xfffe6 20 }
- { 0x3fffd2 22 }
- { 0xfffe7 20 }
- { 0xfffe8 20 }
- { 0x3fffd3 22 }
- { 0x3fffd4 22 }
- { 0x3fffd5 22 }
- { 0x7fffd9 23 }
- { 0x3fffd6 22 }
- { 0x7fffda 23 }
- { 0x7fffdb 23 }
- { 0x7fffdc 23 }
- { 0x7fffdd 23 }
- { 0x7fffde 23 }
- { 0xffffeb 24 }
- { 0x7fffdf 23 }
- { 0xffffec 24 }
- { 0xffffed 24 }
- { 0x3fffd7 22 }
- { 0x7fffe0 23 }
- { 0xffffee 24 }
- { 0x7fffe1 23 }
- { 0x7fffe2 23 }
- { 0x7fffe3 23 }
- { 0x7fffe4 23 }
- { 0x1fffdc 21 }
- { 0x3fffd8 22 }
- { 0x7fffe5 23 }
- { 0x3fffd9 22 }
- { 0x7fffe6 23 }
- { 0x7fffe7 23 }
- { 0xffffef 24 }
- { 0x3fffda 22 }
- { 0x1fffdd 21 }
- { 0xfffe9 20 }
- { 0x3fffdb 22 }
- { 0x3fffdc 22 }
- { 0x7fffe8 23 }
- { 0x7fffe9 23 }
- { 0x1fffde 21 }
- { 0x7fffea 23 }
- { 0x3fffdd 22 }
- { 0x3fffde 22 }
- { 0xfffff0 24 }
- { 0x1fffdf 21 }
- { 0x3fffdf 22 }
- { 0x7fffeb 23 }
- { 0x7fffec 23 }
- { 0x1fffe0 21 }
- { 0x1fffe1 21 }
- { 0x3fffe0 22 }
- { 0x1fffe2 21 }
- { 0x7fffed 23 }
- { 0x3fffe1 22 }
- { 0x7fffee 23 }
- { 0x7fffef 23 }
- { 0xfffea 20 }
- { 0x3fffe2 22 }
- { 0x3fffe3 22 }
- { 0x3fffe4 22 }
- { 0x7ffff0 23 }
- { 0x3fffe5 22 }
- { 0x3fffe6 22 }
- { 0x7ffff1 23 }
- { 0x3ffffe0 26 }
- { 0x3ffffe1 26 }
- { 0xfffeb 20 }
- { 0x7fff1 19 }
- { 0x3fffe7 22 }
- { 0x7ffff2 23 }
- { 0x3fffe8 22 }
- { 0x1ffffec 25 }
- { 0x3ffffe2 26 }
- { 0x3ffffe3 26 }
- { 0x3ffffe4 26 }
- { 0x7ffffde 27 }
- { 0x7ffffdf 27 }
- { 0x3ffffe5 26 }
- { 0xfffff1 24 }
- { 0x1ffffed 25 }
- { 0x7fff2 19 }
- { 0x1fffe3 21 }
- { 0x3ffffe6 26 }
- { 0x7ffffe0 27 }
- { 0x7ffffe1 27 }
- { 0x3ffffe7 26 }
- { 0x7ffffe2 27 }
- { 0xfffff2 24 }
- { 0x1fffe4 21 }
- { 0x1fffe5 21 }
- { 0x3ffffe8 26 }
- { 0x3ffffe9 26 }
- { 0xffffffd 28 }
- { 0x7ffffe3 27 }
- { 0x7ffffe4 27 }
- { 0x7ffffe5 27 }
- { 0xfffec 20 }
- { 0xfffff3 24 }
- { 0xfffed 20 }
- { 0x1fffe6 21 }
- { 0x3fffe9 22 }
- { 0x1fffe7 21 }
- { 0x1fffe8 21 }
- { 0x7ffff3 23 }
- { 0x3fffea 22 }
- { 0x3fffeb 22 }
- { 0x1ffffee 25 }
- { 0x1ffffef 25 }
- { 0xfffff4 24 }
- { 0xfffff5 24 }
- { 0x3ffffea 26 }
- { 0x7ffff4 23 }
- { 0x3ffffeb 26 }
- { 0x7ffffe6 27 }
- { 0x3ffffec 26 }
- { 0x3ffffed 26 }
- { 0x7ffffe7 27 }
- { 0x7ffffe8 27 }
- { 0x7ffffe9 27 }
- { 0x7ffffea 27 }
- { 0x7ffffeb 27 }
- { 0xffffffe 28 }
- { 0x7ffffec 27 }
- { 0x7ffffed 27 }
- { 0x7ffffee 27 }
- { 0x7ffffef 27 }
- { 0x7fffff0 27 }
- { 0x3ffffee 26 }
- { 0x3fffffff 30 }
- }
-
-:: R2, ( n -- ) n , n 2 64 * + , n 1 64 * + , n 3 64 * + , ;
-:: R4, ( n -- ) n R2, n 2 16 * + R2, n 1 16 * + R2, n 3 16 * + R2, ;
-:: R6, ( n -- ) n R4, n 2 4 * + R4, n 1 4 * + R4, n 3 4 * + R4, ;
->>
-
-! The codes for each entry in the huffman table
-CONSTANT: huffman-encode-table $[
- huffman-table [
- [ integer>bit-array ] dip f pad-tail reverse
- ] { } assoc>map
-]
-
-CONSTANT: EOS 256
-
-CONSTANT: bit-reverse-table $[
- [ 0 R6, 2 R6, 1 R6, 3 R6, ] B{ } make
-]
-
-: reverse-bits ( byte-array -- byte-array' )
- [ bit-reverse-table nth ] B{ } map-as ;
-
-: byte-array>bit-array ( byte-array -- bit-array )
- [ length 8 * ] [ bit-array boa ] bi ;
-
-! converts a byte array/vector/sequence to a bit array, with
-! each byte in descending order, such that the most significant
-! bit of the first byte is the first bit in the sequence.
-: bytes-to-bits ( bytes -- bits )
- reverse-bits byte-array>bit-array ;
-
-! most significant bit first.
-: bits-to-bytes ( bits -- bytes )
- underlying>> reverse-bits ;
-
-ERROR: hpack-huffman-error message ;
-
-! probably inefficient, but it works.
-! just loops over the bits, adding each bit to the current code and searching for
-! the current code, adding the corresponding symbol if the code
-! is found in the table.
-:: huffman-decode ( bytes -- string )
- BV{ } clone :> byte-vector
- 0 0 ! current code and length
- bytes bytes-to-bits [
- [ 2 * ] 2dip 1 0 ? swap 1 [ + ] 2bi@
- 2dup 2array huffman-table index
- [
- dup EOS = [ "End of Stream in huffman encoded string" hpack-huffman-error ] when
- byte-vector push 2drop 0 0
- ] when*
- ] each
-
- 7 > [ "Padding is too long in huffman encoded string" hpack-huffman-error ] when
-
- EOS huffman-table nth first integer>bit-array
- swap integer>bit-array tail?
- [ "Padding is not the most significant bits of the End of Stream code in huffman encoded string" hpack-huffman-error ] unless
-
- byte-vector utf8 decode ;
-
-: huffman-encode ( string -- bytes )
- [ huffman-encode-table nth ] { } map-as concat
- EOS huffman-encode-table nth over length neg 8 rem head
- append bits-to-bytes ;
-
+++ /dev/null
-USING: accessors continuations http http.server http.server.requests
-io io.encodings.ascii io.servers io.sockets io.streams.peek
-io.streams.limited kernel namespaces openssl.libssl ;
-
-IN: http2.server
-
-! individual connection stuff
-TUPLE: http2-stream ; ! do I even need this?
-
-TUPLE: http2-connection streams settings hpack-decode-context
-hpack-encode-context ;
-
-CONSTANT: client-connection-prefix "PRI * HTTP/2.0\r\n\r\nSM\r\n\r\n"
-
-: start-http2-connection ( threaded-server prev-req/f -- )
- 2drop
- ! TODO: establish http2 connection and carry out requests
- ! send settings frame.
- ! listen for connection prefix and settings from client.
- ! save settings and send ack.
- ;
-
-! the server stuff
-TUPLE: http2-server < http-server ;
-
-! stack effect: ( threaded-server -- )
-M: http2-server handle-client*
- ! check if this is a secure connection or not
- ?refresh-all
- request-limit get limited-input
- secure-addr dup port>> local-address get port>> = and
- [ t ! get tls(1.2?) negotiated thing: replace with get_alpn_selected
- [ f start-http2-connection ] ! if h2, send prefix and start full http2
- [ call-next-method ] ! else, revert to http1?
- if ] ! secure case
- [ ! first, check if the thing sent is connection prefix, and
- ! if so, start connection
- ! this line should check for the connection prefix, but
- ! seems to mess up the stream for when the the request is
- ! read in read-request.
- f ! 24 input-stream get <peek-stream> stream-peek client-connection-prefix =
- [ f start-http2-connection ]
- [
- [
- [ read-request ] ?benchmark
- dup "Upgrade" header
- "h2c" =
- [ start-http2-connection ] ! if so, send 101 switching protocols response, start http2,
- ! including sending prefix and response to initial request.
- [
- ! else, finish processing as http1.
- nip
- [ do-request ] ?benchmark
- [ do-response ] ?benchmark
- ] if
- ]
- [ nip handle-client-error ] recover
- ]
- if ] ! insecure case
- if
- ;
-
-: <http2-server> ( -- server )
- ascii http2-server new-threaded-server
- "http2.server" >>name
- "http" protocol-port >>insecure
- "https" protocol-port >>secure ;
-
--- /dev/null
+! Copyright (C) 2021 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: byte-arrays help.markup help.syntax kernel sequences strings ;
+IN: http2.hpack
+
+HELP: hpack-context
+{ $class-description "Stores the context for a hpack decoder or encoder. This is primarily the current state of the dynamic table." } ;
+
+HELP: hpack-decode
+{ $values
+ { "decode-context" hpack-context } { "block" byte-array }
+ { "updated-context" hpack-context } { "decoded" sequence }
+}
+{ $description "Decodes the given byte array (or byte vector) in the given hpack context. Outputs the updated context, and the decoded header block as a sequence of pairs." } ;
+
+HELP: hpack-decode-error
+{ $values
+ { "error-msg" string }
+}
+{ $description "Throws a " { $link hpack-decode-error } " error." }
+{ $error-description "Thrown for any of the possible errors specified in RFC7541 for decoding hpack encoded byte strings." } ;
+
+HELP: hpack-encode
+{ $values
+ { "encode-context" hpack-context } { "headers" sequence }
+ { "updated-context" hpack-context } { "block" byte-array }
+}
+{ $description "Encodes the sequence of headers using the given context. Outputs the updated context and the encoded header block, as a byte array." } ;
+
+ARTICLE: "http2.hpack" "HTTP/2 HPACK"
+{ $vocab-link "http2.hpack" }
+;
+
+{ hpack-encode hpack-decode } related-words
+
+ABOUT: "http2.hpack"
--- /dev/null
+! Copyright (C) 2021 Your name.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test http2.hpack http2.hpack.private accessors
+kernel sequences ;
+IN: http2.hpack.tests
+
+! constants are from RFC 7541, appendix C, various sections
+CONSTANT: c1 B{ 234 31 154 10 42 }
+CONSTANT: c21 B{ 0x40 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
+ 0x6b 0x65 0x79 0x0d 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d
+ 0x68 0x65 0x61 0x64 0x65 0x72 }
+CONSTANT: c22 B{ 0x04 0x0c 0x2f 0x73 0x61 0x6d 0x70 0x6c 0x65
+ 0x2f 0x70 0x61 0x74 0x68 }
+CONSTANT: c23 B{ 0x10 0x08 0x70 0x61 0x73 0x73 0x77 0x6f 0x72
+ 0x64 0x06 0x73 0x65 0x63 0x72 0x65 0x74 }
+CONSTANT: c24 B{ 0x82 }
+
+CONSTANT: c31 B{ 0x82 0x86 0x84 0x41 0x0f 0x77 0x77 0x77 0x2e
+ 0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
+CONSTANT: c32 B{ 0x82 0x86 0x84 0xbe 0x58 0x08 0x6e 0x6f 0x2d
+ 0x63 0x61 0x63 0x68 0x65 }
+CONSTANT: c33 B{ 0x82 0x87 0x85 0xbf 0x40 0x0a 0x63 0x75 0x73
+ 0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 0x0c 0x63 0x75 0x73
+ 0x74 0x6f 0x6d 0x2d 0x76 0x61 0x6c 0x75 0x65 }
+
+CONSTANT: c41 B{ 0x82 0x86 0x84 0x41 0x8c 0xf1 0xe3 0xc2 0xe5
+ 0xf2 0x3a 0x6b 0xa0 0xab 0x90 0xf4 0xff }
+CONSTANT: c42 B{ 0x82 0x86 0x84 0xbe 0x58 0x86 0xa8 0xeb 0x10
+ 0x64 0x9c 0xbf }
+CONSTANT: c43 B{ 0x82 0x87 0x85 0xbf 0x40 0x88 0x25 0xa8 0x49
+ 0xe9 0x5b 0xa9 0x7d 0x7f 0x89 0x25 0xa8 0x49 0xe9 0x5b
+ 0xb8 0xe8 0xb4 0xbf }
+
+! These headers are the same as those for section 4
+CONSTANT: c31h { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" } }
+CONSTANT: c32h { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" }
+ { "cache-control" "no-cache" } }
+CONSTANT: c33h { { ":method" "GET" } { ":scheme" "https" }
+ { ":path" "/index.html" } { ":authority" "www.example.com" }
+ { "custom-key" "custom-value" } }
+
+CONSTANT: c51 B{ 0x48 0x03 0x33 0x30 0x32 0x58 0x07 0x70 0x72
+0x69 0x76 0x61 0x74 0x65 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20 0x32
+0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
+0x30 0x3a 0x31 0x33 0x3a 0x32 0x31 0x20 0x47 0x4d 0x54 0x6e
+0x17 0x68 0x74 0x74 0x70 0x73 0x3a 0x2f 0x2f 0x77 0x77 0x77
+0x2e 0x65 0x78 0x61 0x6d 0x70 0x6c 0x65 0x2e 0x63 0x6f 0x6d }
+CONSTANT: c52 B{ 0x48 0x03 0x33 0x30 0x37 0xc1 0xc0 0xbf }
+CONSTANT: c53 B{ 0x88 0xc1 0x61 0x1d 0x4d 0x6f 0x6e 0x2c 0x20
+0x32 0x31 0x20 0x4f 0x63 0x74 0x20 0x32 0x30 0x31 0x33 0x20 0x32
+0x30 0x3a 0x31 0x33 0x3a 0x32 0x32 0x20 0x47 0x4d 0x54 0xc0
+0x5a 0x04 0x67 0x7a 0x69 0x70 0x77 0x38 0x66 0x6f 0x6f 0x3d
+0x41 0x53 0x44 0x4a 0x4b 0x48 0x51 0x4b 0x42 0x5a 0x58 0x4f
+0x51 0x57 0x45 0x4f 0x50 0x49 0x55 0x41 0x58 0x51 0x57 0x45
+0x4f 0x49 0x55 0x3b 0x20 0x6d 0x61 0x78 0x2d 0x61 0x67 0x65
+0x3d 0x33 0x36 0x30 0x30 0x3b 0x20 0x76 0x65 0x72 0x73 0x69
+0x6f 0x6e 0x3d 0x31 }
+
+CONSTANT: c61 B{ 0x48 0x82 0x64 0x02 0x58 0x85 0xae 0xc3 0x77
+ 0x1a 0x4b 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10 0x54 0xd4
+ 0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66 0xe0 0x82 0xa6
+ 0x2d 0x1b 0xff 0x6e 0x91 0x9d 0x29 0xad 0x17 0x18 0x63 0xc7
+ 0x8f 0x0b 0x97 0xc8 0xe9 0xae 0x82 0xae 0x43 0xd3 }
+CONSTANT: c62 B{ 0x48 0x83 0x64 0x0e 0xff 0xc1 0xc0 0xbf }
+CONSTANT: c63 B{ 0x88 0xc1 0x61 0x96 0xd0 0x7a 0xbe 0x94 0x10
+ 0x54 0xd4 0x44 0xa8 0x20 0x05 0x95 0x04 0x0b 0x81 0x66
+ 0xe0 0x84 0xa6 0x2d 0x1b 0xff 0xc0 0x5a 0x83 0x9b 0xd9 0xab
+ 0x77 0xad 0x94 0xe7 0x82 0x1d 0xd7 0xf2 0xe6 0xc7 0xb3 0x35
+ 0xdf 0xdf 0xcd 0x5b 0x39 0x60 0xd5 0xaf 0x27 0x08 0x7f 0x36
+ 0x72 0xc1 0xab 0x27 0x0f 0xb5 0x29 0x1f 0x95 0x87 0x31 0x60
+ 0x65 0xc0 0x03 0xed 0x4e 0xe5 0xb1 0x06 0x3d 0x50 0x07 }
+
+! These headers are the same as those for section 6
+CONSTANT: c51h { { ":status" "302" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" } }
+CONSTANT: c52h { { ":status" "307" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" } }
+CONSTANT: c53h { { ":status" "200" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+ { "location" "https://www.example.com" }
+ { "content-encoding" "gzip" }
+ { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" } }
+
+
+! tests come from RFC 7541, Appendix C
+
+! RFC7541 Appendex C.1
+{ 1 10 } [ c1 0 5 decode-integer nipd ] unit-test
+{ 4 1337 } [ c1 1 5 decode-integer nipd ] unit-test
+{ 5 42 } [ c1 4 8 decode-integer nipd ] unit-test
+
+
+! RFC7541 Appendix C.2.1 subset
+{ 12 "custom-key" }
+[ c21 1 decode-string nipd ] unit-test
+
+! RFC7541 Appendix C.4.3 subset
+{ 24 "custom-value" }
+[ c43 14 decode-string nipd ] unit-test
+
+! RFC7541 Appendix C.2.1
+{ T{ hpack-context f 4096 { { "custom-key" "custom-header" } } }
+ 26 { "custom-key" "custom-header" } }
+[ hpack-context new c21 0 decode-field nipd ] unit-test
+
+! RFC7541 Appendix C.2.2
+{ T{ hpack-context f 4096 { } } 14 { ":path" "/sample/path" } }
+[ hpack-context new c22 0 decode-field nipd ] unit-test
+
+! RFC7541 Appendix C.2.3
+{ T{ hpack-context f 4096 { } } 17 { "password" "secret" } }
+[ hpack-context new c23 0 decode-field nipd ] unit-test
+
+! RFC7541 Appendix C.2.4
+{ T{ hpack-context f 4096 { } } 1 { ":method" "GET" } }
+[ hpack-context new c24 0 decode-field nipd ] unit-test
+
+
+! RFC7541 Appendix C.3
+{
+ { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" } }
+ { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" }
+ { "cache-control" "no-cache" } }
+ { { ":method" "GET" } { ":scheme" "https" }
+ { ":path" "/index.html" } { ":authority" "www.example.com" }
+ { "custom-key" "custom-value" } }
+ T{ hpack-context f 4096 { { "custom-key" "custom-value" }
+ { "cache-control" "no-cache" }
+ { ":authority" "www.example.com" } } }
+}
+[ hpack-context new c31 c32 c33 [ hpack-decode swap ] tri@ ] unit-test
+
+! RFC7541 Appendix C.4
+{
+ { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" } }
+ { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" }
+ { "cache-control" "no-cache" } }
+ { { ":method" "GET" } { ":scheme" "https" }
+ { ":path" "/index.html" } { ":authority" "www.example.com" }
+ { "custom-key" "custom-value" } }
+ T{ hpack-context f 4096 { { "custom-key" "custom-value" }
+ { "cache-control" "no-cache" }
+ { ":authority" "www.example.com" } } }
+}
+[ hpack-context new c41 c42 c43 [ hpack-decode swap ] tri@ ] unit-test
+
+! RFC7541 Appendix C.5
+{
+ {
+ { ":status" "302" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" }
+ }
+ {
+ { ":status" "307" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" }
+ }
+ {
+ { ":status" "200" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+ { "location" "https://www.example.com" }
+ { "content-encoding" "gzip" }
+ { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+ }
+ T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+ { "content-encoding" "gzip" }
+ { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
+}
+[ hpack-context new 256 >>max-size c51 c52 c53
+ [ hpack-decode swap ] tri@ ] unit-test
+
+! RFC7541 Appendix C.6
+{
+ {
+ { ":status" "302" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" }
+ }
+ {
+ { ":status" "307" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" }
+ }
+ {
+ { ":status" "200" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+ { "location" "https://www.example.com" }
+ { "content-encoding" "gzip" }
+ { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+ }
+ T{ hpack-context f 256 { { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+ { "content-encoding" "gzip" }
+ { "date" "Mon, 21 Oct 2013 20:13:22 GMT" } } }
+}
+[ hpack-context new 256 >>max-size c61 c62 c63
+ [ hpack-decode swap ] tri@ ] unit-test
+
+
+! encoding can be tested primarily by ensuring the encoding and
+! decoding of an object yields the same object (since encoding
+! does not have a well defined output other then `decodable').
+
+
+! integer and string encoding tests
+{ B{ 0b00101010 } } [ 0b00100000 10 5 encode-integer ] unit-test
+{ B{ 0b01011111 0b10011010 0b00001010 } } [ 0b01000000 1337 5 encode-integer ] unit-test
+{ B{ 0b00101010 } } [ 0b00000000 42 8 encode-integer ] unit-test
+
+{ B{ 0x0a 0x63 0x75 0x73 0x74 0x6f 0x6d 0x2d 0x6b 0x65 0x79 } }
+[ "custom-key" encode-string-raw ] unit-test
+
+{ B{ 0x88 0x25 0xa8 0x49 0xe9 0x5b 0xa9 0x7d 0x7f } }
+[ "custom-key" encode-string-huffman ] unit-test
+
+
+! single header encoding check, mirrors the tests from RFC 7541, Appendix C.2
+{ t t { "custom-key" "custom-header" } }
+[ hpack-context new { "custom-key" "custom-header" } encode-field
+ hpack-context new swap 0 decode-field
+ [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
+] unit-test
+
+{ t t { ":path" "/sample/path" } }
+[ hpack-context new { ":path" "/sample/path" } encode-field
+ hpack-context new swap 0 decode-field
+ [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
+] unit-test
+
+{ t t { "password" "secret" } }
+[ hpack-context new { "password" "secret" } encode-field
+ hpack-context new swap 0 decode-field
+ [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
+] unit-test
+
+{ t t { ":method" "GET" } }
+[ hpack-context new { ":method" "GET" } encode-field
+ hpack-context new swap 0 decode-field
+ [ [ = ] [ swap length = ] 2bi* ] dip ! check contexts are the same and the entire block used for decoding
+] unit-test
+
+
+! many header encoding check, using same values from RFC7541 Appendix C.3 and C.5
+{
+ { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" } }
+ { { ":method" "GET" } { ":scheme" "http" }
+ { ":path" "/" } { ":authority" "www.example.com" }
+ { "cache-control" "no-cache" } }
+ { { ":method" "GET" } { ":scheme" "https" }
+ { ":path" "/index.html" } { ":authority" "www.example.com" }
+ { "custom-key" "custom-value" } }
+ t
+}
+[ hpack-context new c31h c32h c33h [ hpack-encode swap ] tri@
+ [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
+ = ! check that the encode and decode contexts are identical
+] unit-test
+
+{
+ {
+ { ":status" "302" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" }
+ }
+ {
+ { ":status" "307" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:21 GMT" }
+ { "location" "https://www.example.com" }
+ }
+ {
+ { ":status" "200" }
+ { "cache-control" "private" }
+ { "date" "Mon, 21 Oct 2013 20:13:22 GMT" }
+ { "location" "https://www.example.com" }
+ { "content-encoding" "gzip" }
+ { "set-cookie" "foo=ASDJKHQKBZXOQWEOPIUAXQWEOIU; max-age=3600; version=1" }
+ }
+ t
+}
+[ hpack-context new c51h c52h c53h [ hpack-encode swap ] tri@
+ [ [ hpack-context new ] 3dip [ hpack-decode swap ] tri@ ] dip
+ = ! check that the encode and decode contexts are identical
+] unit-test
+
--- /dev/null
+USING: accessors arrays byte-arrays byte-vectors combinators fry
+http2.hpack.huffman io.encodings.string io.encodings.utf8 locals
+kernel math math.functions math.bitwise multiline sequences ;
+
+IN: http2.hpack
+
+TUPLE: hpack-context
+ { max-size integer initial: 4096 } { dynamic-table initial: { } } ;
+ ! default the max size to 4096 according to RFC7540
+
+ERROR: hpack-decode-error error-msg ;
+
+<PRIVATE
+
+! The static table for hpack compression/decompression,
+! from RFC 7541, Appendix A.
+CONSTANT: static-table {
+ { f f } ! allows indexing to work out properly
+ { ":authority" f }
+ { ":method" "GET" }
+ { ":method" "POST" }
+ { ":path" "/" }
+ { ":path" "/index.html" }
+ { ":scheme" "http" }
+ { ":scheme" "https" }
+ { ":status" "200" }
+ { ":status" "204" }
+ { ":status" "206" }
+ { ":status" "304" }
+ { ":status" "400" }
+ { ":status" "404" }
+ { ":status" "500" }
+ { "accept-charset" f }
+ { "accept-encoding" "gzip, deflate" }
+ { "accept-language" f }
+ { "accept-ranges" f }
+ { "accept" f }
+ { "access-control-allow-origin" f }
+ { "age" f }
+ { "allow" f }
+ { "authorization" f }
+ { "cache-control" f }
+ { "content-disposition" f }
+ { "content-encoding" f }
+ { "content-language" f }
+ { "content-length" f }
+ { "content-location" f }
+ { "content-range" f }
+ { "content-type" f }
+ { "cookie" f }
+ { "date" f }
+ { "etag" f }
+ { "expect" f }
+ { "expires" f }
+ { "from" f }
+ { "host" f }
+ { "if-match" f }
+ { "if-modified-since" f }
+ { "if-none-match" f }
+ { "if-range" f }
+ { "if-unmodified-since" f }
+ { "last-modified" f }
+ { "link" f }
+ { "location" f }
+ { "max-forwards" f }
+ { "proxy-authenticate" f }
+ { "proxy-authorization" f }
+ { "range" f }
+ { "referer" f }
+ { "refresh" f }
+ { "retry-after" f }
+ { "server" f }
+ { "set-cookie" f }
+ { "strict-transport-security" f }
+ { "transfer-encoding" f }
+ { "user-agent" f }
+ { "vary" f }
+ { "via" f }
+ { "www-authenticate" f }
+}
+
+: header-size ( header -- size )
+ sum-lengths 32 +
+ ;
+
+! gives the index in the dynamic table such that the sum of the
+! size of the elements before the index is less than or equal to
+! the desired-size, or f if no entries need to be removed to
+! attain the desired size
+:: dynamic-table-remove-index ( dynamic-table desired-size -- i/f )
+ 0 dynamic-table [ header-size + dup desired-size >= ] find drop nip
+ ;
+
+! shrinks the dynamic table size to the given size (size, *not*
+! length) (doesn't affect the max-size of the context)
+: shrink-dynamic-table ( dynamic-table shrink-to -- shrunk-dynamic-table )
+ dupd dynamic-table-remove-index [ head ] when*
+ ;
+
+:: add-header-to-table ( hpack-context header -- updated-context )
+ hpack-context dynamic-table>> hpack-context max-size>>
+ header header-size - shrink-dynamic-table
+ header header-size hpack-context max-size>> <= [ header prefix ] when
+ hpack-context swap >>dynamic-table
+ ;
+
+: set-dynamic-table-size ( hpack-context new-size -- updated-decode-context )
+ [ >>max-size ] keep
+ [ dup dynamic-table>> ] dip shrink-dynamic-table >>dynamic-table
+ ;
+
+! check bounds: i < len(static-table++decode-context) and i > 0
+: check-index-bounds ( index decode-context -- )
+ [ drop 0 > ] [ dynamic-table>> length static-table length + < ] 2bi
+ and [ "invalid index given" hpack-decode-error ] unless ! if not valid throw error
+ ;
+
+: get-header-from-table ( hpack-context table-index -- field )
+ [ swap check-index-bounds ] 2keep
+ dup static-table length < ! check if in static table
+ [ static-table nth nip ]
+ [ static-table length - swap dynamic-table>> nth ]
+ if ;
+
+: search-imperfect ( header table -- imperfect/f )
+ swap first '[ _ first = ] find drop
+ ;
+
+: search-given-table ( header table -- imperfect/f perfect/f )
+ [ search-imperfect ] [ index ] 2bi
+ ;
+
+: correct-dynamic-index ( dynamic-index/f -- whole-table-index/f )
+ [ static-table length + ] [ f ] if*
+ ;
+
+: search-static-table ( header -- imperfect/f perfect/f )
+ static-table search-given-table ;
+
+: search-dynamic-table ( header hpack-context -- imperfect/f perfect/f )
+ dynamic-table>> search-given-table
+ [ correct-dynamic-index ] bi@
+ ;
+
+: search-table ( header hpack-context -- imperfect/f perfect/f )
+ [ drop search-static-table ] [ search-dynamic-table ] 2bi
+ ! combine results from static and dynamic tables
+ swapd [ or ] 2bi@
+ ;
+
+
+! assumes the first-byte respects the prefix-length, such that
+! the last prefix-length bits are all 0.
+: encode-integer ( first-byte int prefix-length -- bytes )
+ 2^ 1 - 2dup <
+ [ drop bitor 1byte-array ]
+ [ swap over [ bitor 1byte-array >byte-vector ] [ - ] 2bi*
+ [ dup 128 >= ] [ [ 128 mod 128 + over push ] [ 128 /i ] bi ]
+ while over push >byte-array
+ ] if ;
+
+! encodes a string without huffman encoding.
+: encode-string-raw ( string -- bytes )
+ utf8 encode
+ 0 over length 7 encode-integer
+ prepend
+ ;
+
+: encode-string-huffman ( string -- bytes )
+ huffman-encode
+ 128 over length 7 encode-integer
+ prepend
+ ;
+
+:: encode-field ( encode-context header -- updated-context block )
+ header encode-context search-table
+ [ 128 swap 7 encode-integer encode-context swap nipd ]
+ [ [ 64 swap 6 encode-integer ]
+ [ 64 0 6 encode-integer header first encode-string-huffman append
+ ] if*
+ header second encode-string-huffman append
+ encode-context header add-header-to-table swap ]
+ if*
+ ;
+
+! /*
+! version of decode integer that tries to be clever for less
+! stack stuff, but not sure if it actually is...
+:: decode-integer ( block current-index prefix-length -- block new-index number )
+ current-index 1 + :> end-index!
+ current-index block nth prefix-length 2^ 1 - [ mask ] keep over =
+ [
+ current-index 1 + block [ 7 bit? not ] find-from drop 1 + end-index!
+ current-index 1 + end-index block subseq reverse
+ 0 [ 127 mask swap 128 * + ] reduce
+ +
+ ] when
+ [ block end-index ] dip ; ! */
+
+/*
+! initial version of decode-integer, which closely follows the
+! pseudocode from the rfc (RFC 7541, section 5.1)
+: decode-integer-fragment ( block index I M -- block index+1 I' M+7 block[index+1] )
+ ! increment index and get block[index]
+ [ 1 + 2dup swap nth ] 2dip
+ ! stack: block index+1 block[index+1] I M
+ ! compute I' = (block[index+1] & 127) * 2^M + I
+ pick 127 mask 2 pick ^ * '[ _ + ] dip
+ 7 + rot ;
+
+: decode-integer ( block current-index prefix-length -- block new-index number )
+ ! get the current octet, compute mask, apply mask
+ [ 2dup swap nth ] dip 2^ 1 - [ mask ] keep
+ over =
+ ! stack: block index I loop?
+ [ 0
+ [ 7 bit? ] [ decode-integer-fragment ] do while
+ ! stack: block index I M, get rid of M, we don't need it
+ drop ]
+ when ! the prefix matches the mask (exactly all 1s), must loop
+ [ 1 + ] dip ! increment the index before return
+ ; ! */
+
+: decode-raw-string ( block current-index string-length -- block new-index string )
+ over + dup [ pick subseq utf8 decode ] dip swap ;
+
+: decode-huffman-string ( block current-index string-length -- block new-index string )
+ over + dup [ pick subseq huffman-decode ] dip swap
+ ;
+
+: decode-string ( block current-index -- block new-index string )
+ [ 7 decode-integer ] [ swap nth 7 bit? ] 2bi
+ [ decode-huffman-string ] [ decode-raw-string ] if ;
+
+: decode-literal-header ( decode-context block index index-length -- decode-context block new-index field )
+ decode-integer
+ ! string name if 0, else indexed
+ [ decode-string ] [ pickd get-header-from-table first ] if-zero
+ [ decode-string ] dip swap 2array
+ ;
+
+! block will be a byte array
+:: decode-field ( decode-context block index -- updated-context block new-index field/f )
+ decode-context block index
+ {
+ ! indexed header field
+ { [ index block nth 7 bit? ] [ 7 decode-integer
+ decode-context swap get-header-from-table ] }
+ ! Literal header field with incremental indexing
+ { [ index block nth 6 bit? ] [ 6 decode-literal-header
+ [ 2nip add-header-to-table ] 3keep ] }
+ ! dynamic table size update
+ { [ index block nth 5 bit? ] [ 5 decode-integer -rot f
+ [ set-dynamic-table-size ] 3dip ] }
+ ! literal header field without indexing
+ [ 4 decode-literal-header ]
+ } cond ;
+
+PRIVATE>
+
+! headers is a sequence of tuples represented the unencoded headers
+: hpack-encode ( encode-context headers -- updated-context block )
+ [ encode-field ] map concat ;
+
+
+! should give the updated dtable, and the list of decoded
+! header fields. block is the bytestring (byte array) for the header block
+: hpack-decode ( decode-context block -- updated-context decoded )
+ [let V{ } clone :> decoded-list
+ 0 ! index in the block
+ [ 2dup swap length < ] ! check that the block is longer than the index
+ ! call decode-field and add the (possibly) decoded field to the list
+ [ decode-field [ decoded-list push ]
+ [ decoded-list [ "Table size update not at start of header block"
+ hpack-decode-error ] unless-empty ] if* ]
+ ! if the table was not empty, and we didn't get a header, throw an error.
+ while
+ 2drop decoded-list >array
+ ! double check the header list size?
+ ] ;
+
--- /dev/null
+USING: accessors arrays assocs bit-arrays http2.hpack
+io.encodings.string io.encodings.utf8 kernel literals locals
+make math sequences ;
+
+IN: http2.hpack.huffman
+
+<<
+! Table contents from RFC 7541 Appendix B
+CONSTANT: huffman-table {
+ { 0x1ff8 13 }
+ { 0x7fffd8 23 }
+ { 0xfffffe2 28 }
+ { 0xfffffe3 28 }
+ { 0xfffffe4 28 }
+ { 0xfffffe5 28 }
+ { 0xfffffe6 28 }
+ { 0xfffffe7 28 }
+ { 0xfffffe8 28 }
+ { 0xffffea 24 }
+ { 0x3ffffffc 30 }
+ { 0xfffffe9 28 }
+ { 0xfffffea 28 }
+ { 0x3ffffffd 30 }
+ { 0xfffffeb 28 }
+ { 0xfffffec 28 }
+ { 0xfffffed 28 }
+ { 0xfffffee 28 }
+ { 0xfffffef 28 }
+ { 0xffffff0 28 }
+ { 0xffffff1 28 }
+ { 0xffffff2 28 }
+ { 0x3ffffffe 30 }
+ { 0xffffff3 28 }
+ { 0xffffff4 28 }
+ { 0xffffff5 28 }
+ { 0xffffff6 28 }
+ { 0xffffff7 28 }
+ { 0xffffff8 28 }
+ { 0xffffff9 28 }
+ { 0xffffffa 28 }
+ { 0xffffffb 28 }
+ { 0x14 6 }
+ { 0x3f8 10 }
+ { 0x3f9 10 }
+ { 0xffa 12 }
+ { 0x1ff9 13 }
+ { 0x15 6 }
+ { 0xf8 8 }
+ { 0x7fa 11 }
+ { 0x3fa 10 }
+ { 0x3fb 10 }
+ { 0xf9 8 }
+ { 0x7fb 11 }
+ { 0xfa 8 }
+ { 0x16 6 }
+ { 0x17 6 }
+ { 0x18 6 }
+ { 0x0 5 }
+ { 0x1 5 }
+ { 0x2 5 }
+ { 0x19 6 }
+ { 0x1a 6 }
+ { 0x1b 6 }
+ { 0x1c 6 }
+ { 0x1d 6 }
+ { 0x1e 6 }
+ { 0x1f 6 }
+ { 0x5c 7 }
+ { 0xfb 8 }
+ { 0x7ffc 15 }
+ { 0x20 6 }
+ { 0xffb 12 }
+ { 0x3fc 10 }
+ { 0x1ffa 13 }
+ { 0x21 6 }
+ { 0x5d 7 }
+ { 0x5e 7 }
+ { 0x5f 7 }
+ { 0x60 7 }
+ { 0x61 7 }
+ { 0x62 7 }
+ { 0x63 7 }
+ { 0x64 7 }
+ { 0x65 7 }
+ { 0x66 7 }
+ { 0x67 7 }
+ { 0x68 7 }
+ { 0x69 7 }
+ { 0x6a 7 }
+ { 0x6b 7 }
+ { 0x6c 7 }
+ { 0x6d 7 }
+ { 0x6e 7 }
+ { 0x6f 7 }
+ { 0x70 7 }
+ { 0x71 7 }
+ { 0x72 7 }
+ { 0xfc 8 }
+ { 0x73 7 }
+ { 0xfd 8 }
+ { 0x1ffb 13 }
+ { 0x7fff0 19 }
+ { 0x1ffc 13 }
+ { 0x3ffc 14 }
+ { 0x22 6 }
+ { 0x7ffd 15 }
+ { 0x3 5 }
+ { 0x23 6 }
+ { 0x4 5 }
+ { 0x24 6 }
+ { 0x5 5 }
+ { 0x25 6 }
+ { 0x26 6 }
+ { 0x27 6 }
+ { 0x6 5 }
+ { 0x74 7 }
+ { 0x75 7 }
+ { 0x28 6 }
+ { 0x29 6 }
+ { 0x2a 6 }
+ { 0x7 5 }
+ { 0x2b 6 }
+ { 0x76 7 }
+ { 0x2c 6 }
+ { 0x8 5 }
+ { 0x9 5 }
+ { 0x2d 6 }
+ { 0x77 7 }
+ { 0x78 7 }
+ { 0x79 7 }
+ { 0x7a 7 }
+ { 0x7b 7 }
+ { 0x7ffe 15 }
+ { 0x7fc 11 }
+ { 0x3ffd 14 }
+ { 0x1ffd 13 }
+ { 0xffffffc 28 }
+ { 0xfffe6 20 }
+ { 0x3fffd2 22 }
+ { 0xfffe7 20 }
+ { 0xfffe8 20 }
+ { 0x3fffd3 22 }
+ { 0x3fffd4 22 }
+ { 0x3fffd5 22 }
+ { 0x7fffd9 23 }
+ { 0x3fffd6 22 }
+ { 0x7fffda 23 }
+ { 0x7fffdb 23 }
+ { 0x7fffdc 23 }
+ { 0x7fffdd 23 }
+ { 0x7fffde 23 }
+ { 0xffffeb 24 }
+ { 0x7fffdf 23 }
+ { 0xffffec 24 }
+ { 0xffffed 24 }
+ { 0x3fffd7 22 }
+ { 0x7fffe0 23 }
+ { 0xffffee 24 }
+ { 0x7fffe1 23 }
+ { 0x7fffe2 23 }
+ { 0x7fffe3 23 }
+ { 0x7fffe4 23 }
+ { 0x1fffdc 21 }
+ { 0x3fffd8 22 }
+ { 0x7fffe5 23 }
+ { 0x3fffd9 22 }
+ { 0x7fffe6 23 }
+ { 0x7fffe7 23 }
+ { 0xffffef 24 }
+ { 0x3fffda 22 }
+ { 0x1fffdd 21 }
+ { 0xfffe9 20 }
+ { 0x3fffdb 22 }
+ { 0x3fffdc 22 }
+ { 0x7fffe8 23 }
+ { 0x7fffe9 23 }
+ { 0x1fffde 21 }
+ { 0x7fffea 23 }
+ { 0x3fffdd 22 }
+ { 0x3fffde 22 }
+ { 0xfffff0 24 }
+ { 0x1fffdf 21 }
+ { 0x3fffdf 22 }
+ { 0x7fffeb 23 }
+ { 0x7fffec 23 }
+ { 0x1fffe0 21 }
+ { 0x1fffe1 21 }
+ { 0x3fffe0 22 }
+ { 0x1fffe2 21 }
+ { 0x7fffed 23 }
+ { 0x3fffe1 22 }
+ { 0x7fffee 23 }
+ { 0x7fffef 23 }
+ { 0xfffea 20 }
+ { 0x3fffe2 22 }
+ { 0x3fffe3 22 }
+ { 0x3fffe4 22 }
+ { 0x7ffff0 23 }
+ { 0x3fffe5 22 }
+ { 0x3fffe6 22 }
+ { 0x7ffff1 23 }
+ { 0x3ffffe0 26 }
+ { 0x3ffffe1 26 }
+ { 0xfffeb 20 }
+ { 0x7fff1 19 }
+ { 0x3fffe7 22 }
+ { 0x7ffff2 23 }
+ { 0x3fffe8 22 }
+ { 0x1ffffec 25 }
+ { 0x3ffffe2 26 }
+ { 0x3ffffe3 26 }
+ { 0x3ffffe4 26 }
+ { 0x7ffffde 27 }
+ { 0x7ffffdf 27 }
+ { 0x3ffffe5 26 }
+ { 0xfffff1 24 }
+ { 0x1ffffed 25 }
+ { 0x7fff2 19 }
+ { 0x1fffe3 21 }
+ { 0x3ffffe6 26 }
+ { 0x7ffffe0 27 }
+ { 0x7ffffe1 27 }
+ { 0x3ffffe7 26 }
+ { 0x7ffffe2 27 }
+ { 0xfffff2 24 }
+ { 0x1fffe4 21 }
+ { 0x1fffe5 21 }
+ { 0x3ffffe8 26 }
+ { 0x3ffffe9 26 }
+ { 0xffffffd 28 }
+ { 0x7ffffe3 27 }
+ { 0x7ffffe4 27 }
+ { 0x7ffffe5 27 }
+ { 0xfffec 20 }
+ { 0xfffff3 24 }
+ { 0xfffed 20 }
+ { 0x1fffe6 21 }
+ { 0x3fffe9 22 }
+ { 0x1fffe7 21 }
+ { 0x1fffe8 21 }
+ { 0x7ffff3 23 }
+ { 0x3fffea 22 }
+ { 0x3fffeb 22 }
+ { 0x1ffffee 25 }
+ { 0x1ffffef 25 }
+ { 0xfffff4 24 }
+ { 0xfffff5 24 }
+ { 0x3ffffea 26 }
+ { 0x7ffff4 23 }
+ { 0x3ffffeb 26 }
+ { 0x7ffffe6 27 }
+ { 0x3ffffec 26 }
+ { 0x3ffffed 26 }
+ { 0x7ffffe7 27 }
+ { 0x7ffffe8 27 }
+ { 0x7ffffe9 27 }
+ { 0x7ffffea 27 }
+ { 0x7ffffeb 27 }
+ { 0xffffffe 28 }
+ { 0x7ffffec 27 }
+ { 0x7ffffed 27 }
+ { 0x7ffffee 27 }
+ { 0x7ffffef 27 }
+ { 0x7fffff0 27 }
+ { 0x3ffffee 26 }
+ { 0x3fffffff 30 }
+ }
+
+:: R2, ( n -- ) n , n 2 64 * + , n 1 64 * + , n 3 64 * + , ;
+:: R4, ( n -- ) n R2, n 2 16 * + R2, n 1 16 * + R2, n 3 16 * + R2, ;
+:: R6, ( n -- ) n R4, n 2 4 * + R4, n 1 4 * + R4, n 3 4 * + R4, ;
+>>
+
+! The codes for each entry in the huffman table
+CONSTANT: huffman-encode-table $[
+ huffman-table [
+ [ integer>bit-array ] dip f pad-tail reverse
+ ] { } assoc>map
+]
+
+CONSTANT: EOS 256
+
+CONSTANT: bit-reverse-table $[
+ [ 0 R6, 2 R6, 1 R6, 3 R6, ] B{ } make
+]
+
+: reverse-bits ( byte-array -- byte-array' )
+ [ bit-reverse-table nth ] B{ } map-as ;
+
+: byte-array>bit-array ( byte-array -- bit-array )
+ [ length 8 * ] [ bit-array boa ] bi ;
+
+! converts a byte array/vector/sequence to a bit array, with
+! each byte in descending order, such that the most significant
+! bit of the first byte is the first bit in the sequence.
+: bytes-to-bits ( bytes -- bits )
+ reverse-bits byte-array>bit-array ;
+
+! most significant bit first.
+: bits-to-bytes ( bits -- bytes )
+ underlying>> reverse-bits ;
+
+ERROR: hpack-huffman-error message ;
+
+! probably inefficient, but it works.
+! just loops over the bits, adding each bit to the current code and searching for
+! the current code, adding the corresponding symbol if the code
+! is found in the table.
+:: huffman-decode ( bytes -- string )
+ BV{ } clone :> byte-vector
+ 0 0 ! current code and length
+ bytes bytes-to-bits [
+ [ 2 * ] 2dip 1 0 ? swap 1 [ + ] 2bi@
+ 2dup 2array huffman-table index
+ [
+ dup EOS = [ "End of Stream in huffman encoded string" hpack-huffman-error ] when
+ byte-vector push 2drop 0 0
+ ] when*
+ ] each
+
+ 7 > [ "Padding is too long in huffman encoded string" hpack-huffman-error ] when
+
+ EOS huffman-table nth first integer>bit-array
+ swap integer>bit-array tail?
+ [ "Padding is not the most significant bits of the End of Stream code in huffman encoded string" hpack-huffman-error ] unless
+
+ byte-vector utf8 decode ;
+
+: huffman-encode ( string -- bytes )
+ [ huffman-encode-table nth ] { } map-as concat
+ EOS huffman-encode-table nth over length neg 8 rem head
+ append bits-to-bytes ;
+
--- /dev/null
+USING: accessors continuations http http.server http.server.requests
+io io.encodings.ascii io.servers io.sockets io.streams.peek
+io.streams.limited kernel namespaces openssl.libssl ;
+
+IN: http2.server
+
+! individual connection stuff
+TUPLE: http2-stream ; ! do I even need this?
+
+TUPLE: http2-connection streams settings hpack-decode-context
+hpack-encode-context ;
+
+CONSTANT: client-connection-prefix "PRI * HTTP/2.0\r\n\r\nSM\r\n\r\n"
+
+: start-http2-connection ( threaded-server prev-req/f -- )
+ 2drop
+ ! TODO: establish http2 connection and carry out requests
+ ! send settings frame.
+ ! listen for connection prefix and settings from client.
+ ! save settings and send ack.
+ ;
+
+! the server stuff
+TUPLE: http2-server < http-server ;
+
+! stack effect: ( threaded-server -- )
+M: http2-server handle-client*
+ ! check if this is a secure connection or not
+ ?refresh-all
+ request-limit get limited-input
+ secure-addr dup port>> local-address get port>> = and
+ [ t ! get tls(1.2?) negotiated thing: replace with get_alpn_selected
+ [ f start-http2-connection ] ! if h2, send prefix and start full http2
+ [ call-next-method ] ! else, revert to http1?
+ if ] ! secure case
+ [ ! first, check if the thing sent is connection prefix, and
+ ! if so, start connection
+ ! this line should check for the connection prefix, but
+ ! seems to mess up the stream for when the the request is
+ ! read in read-request.
+ f ! 24 input-stream get <peek-stream> stream-peek client-connection-prefix =
+ [ f start-http2-connection ]
+ [
+ [
+ [ read-request ] ?benchmark
+ dup "Upgrade" header
+ "h2c" =
+ [ start-http2-connection ] ! if so, send 101 switching protocols response, start http2,
+ ! including sending prefix and response to initial request.
+ [
+ ! else, finish processing as http1.
+ nip
+ [ do-request ] ?benchmark
+ [ do-response ] ?benchmark
+ ] if
+ ]
+ [ nip handle-client-error ] recover
+ ]
+ if ] ! insecure case
+ if
+ ;
+
+: <http2-server> ( -- server )
+ ascii http2-server new-threaded-server
+ "http2.server" >>name
+ "http" protocol-port >>insecure
+ "https" protocol-port >>secure ;
+