Skip to content

Commit

Permalink
Merge pull request #94 from cgay/dev
Browse files Browse the repository at this point in the history
http changes needed for web-playground
  • Loading branch information
cgay authored Dec 24, 2020
2 parents cebe499 + a3cdd7f commit 9f30a1d
Show file tree
Hide file tree
Showing 30 changed files with 258 additions and 380 deletions.
20 changes: 20 additions & 0 deletions README.rst
Original file line number Diff line number Diff line change
Expand Up @@ -21,3 +21,23 @@ them on your ``PYTHONPATH``::
You can clone sphinx-extensions with::

git clone [email protected]:dylan-lang/sphinx-extensions


Testing
=======

As of Dec 2020 there are serious problems with the tests and many of them hang.
Fixing this should be #1 priority.

However, in general, to run all the tests::

$ dylan-compiler -build http-test-suite
$ dylan-compiler -build testworks-run
$ _build/bin/testworks-run --load libhttp-test-suite.so

Or you may run one of the more specific test suites::

$ _build/bin/testworks-run --load libhttp-server-test-suite.so
$ _build/bin/testworks-run --load libhttp-client-test-suite.so
$ _build/bin/testworks-run --load libhttp-common-test-suite.so
$ _build/bin/testworks-run --load libhttp-protocol-test-suite.so
3 changes: 2 additions & 1 deletion client/http-client.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -449,7 +449,8 @@ define method read-response
=> (response :: <http-response>)
let socket :: <tcp-socket> = conn.connection-socket;
let (http-version, status-code, reason-phrase) = read-status-line(socket);
let headers :: <header-table> = read-message-headers(socket);
let headers :: <header-table> = make(<header-table>);
read-headers!(socket, make-header-buffer(), headers);
let response = make(response-class,
connection: conn,
// TODO: add version to <http-response> class
Expand Down
12 changes: 0 additions & 12 deletions client/tests/http-client-test-suite-app-library.dylan

This file was deleted.

4 changes: 0 additions & 4 deletions client/tests/http-client-test-suite-app.dylan

This file was deleted.

3 changes: 0 additions & 3 deletions client/tests/http-client-test-suite-app.lid

This file was deleted.

177 changes: 81 additions & 96 deletions common/headers.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -38,33 +38,6 @@ define method content-length
get-header(headers, "Content-Length", parsed: #t)
end;

// Read message headers into a <header-table> and return it.
// If the "headers" argument is supplied then it is side-effected.
// Otherwise a new <header-table> is created and returned.
//
define function read-message-headers
(stream :: <stream>,
#key buffer :: <byte-string> = grow-header-buffer("", 0),
start :: <integer> = 0,
headers :: <header-table> = make(<header-table>),
require-crlf? :: <boolean> = #t)
=> (headers :: <header-table>, buffer :: <byte-string>, epos :: <integer>)
iterate loop (buffer :: <byte-string> = buffer,
bpos :: <integer> = start,
peek-ch :: false-or(<character>) = #f)
let (buffer, bpos, epos, peek-ch)
= read-header-line(stream, buffer, bpos, peek-ch, require-crlf?);
if (bpos == epos) // blank line, done.
values(headers, buffer, epos)
else
let (key, data) = split-header(buffer, bpos, epos);
log-debug(*http-common-log*, "Received header %s: %s", key, data);
set-header(headers, key, data);
loop(buffer, epos, peek-ch)
end if
end iterate
end function read-message-headers;

define open generic set-header
(object :: <object>, header :: <byte-string>, value :: <object>,
#key if-exists? :: one-of(#"replace", #"append", #"ignore", #"error"));
Expand Down Expand Up @@ -152,86 +125,98 @@ define function grow-header-buffer (old :: <byte-string>, len :: <integer>)
end;
end function grow-header-buffer;

// Read a header line, including continuation lines, if any.
// If require-crlf? is #t then lines MUST be terminated by CRLF, otherwise
// they may be terminated by CRLF or LF. Either way, the EOL characters
// are not included in the result. require-crlf?: #f is intended for use
// reading headers generated by CGI scripts.
// Make a header buffer of a standard size, chosen based on what other web
// servers are documented to do.
//
// Note that this implementation has a drawback: it stores the CR in the
// buffer and then later removes it if LF follows. This greatly simplifies
// the code but that last CR could unnecessarily grow the buffer.
// TODO(cgay): should be configurable.
// TODO(cgay): should be only one of these per worker thread.
define inline function make-header-buffer
() => (buffer :: <byte-string>)
make(<byte-string>, size: 8192)
end function;

// Read message headers into `headers` using `buffer` for temporary storage.
// It is valid to read zero headers, e.g., if the first line is a blank line.
// If the caller cares about this case it should check the size of `headers`.
// This is so that this code may be used to parse multipart/form-data in
// addition to HTTP request headers.
//
define function read-header-line
(stream :: <stream>,
buffer :: <byte-string>,
bpos :: <integer>,
peek-ch :: false-or(<byte-character>),
require-crlf? :: <boolean>)
=> (buffer :: <byte-string>,
bpos :: <integer>,
epos :: <integer>,
peek-ch :: false-or(<byte-character>))
iterate loop (buffer :: <byte-string> = buffer,
bpos :: <integer> = bpos,
epos :: <integer> = buffer.size,
pos :: <integer> = bpos,
peek-ch :: false-or(<byte-character>) = peek-ch)
// Complain even if don't really need room for one more char, makes the
// program logic simpler...
if (pos == epos)
if (*max-single-header-size* & epos - bpos >= *max-single-header-size*)
header-too-large-error(max-size: *max-single-header-size*);
else
let len = epos - bpos;
let new = grow-header-buffer(buffer, len);
loop(new, 0, new.size, len, peek-ch);
end;
// Parameters:
// stream - Stream from which to read header data.
// buffer - Temporary work space. May be reused for each call.
// headers - Table in which to store header name -> unparsed-header-value mappings.
// Values:
// nbytes - The total number of bytes read from `stream`.
// Signals:
// <bad-header-error>
define function read-headers!
(stream :: <stream>, buffer :: <byte-string>, headers :: <header-table>)
=> (nbytes :: <integer>)
iterate loop (nbytes = 0)
let (epos, n) = read-header-line!(stream, buffer);
if (epos > 0)
let (name, value) = split-header(buffer, epos);
log-debug(*http-common-log*, "Received header %s: %s", name, value);
set-header(headers, name, value);
loop(nbytes + n);
else
let ch :: <byte-character> = peek-ch | read-element(stream);
let prev-was-cr? = (pos > bpos & buffer[pos - 1] == $cr);
if (ch == $lf & (~require-crlf? | prev-was-cr?))
if (prev-was-cr?)
pos := pos - 1; // don't include CR in result
end;
if (bpos == pos) // empty line means end
values(buffer, bpos, pos, #f)
else
let ch = read-element(stream);
if (ch == ' ' | ch == '\t') // continuation line
// should canonicalize whitespace to a single SP here?
loop(buffer, bpos, epos, pos, ch)
else
values(buffer, bpos, pos, ch)
end
end
nbytes + n
end
end;
end function;

// Read a header line from `stream` into `buffer`, including any continuation
// lines. The CRLF preceding continuation lines is removed, but other
// whitespace is retained.
//
// Returns:
// epos - The end index, excluding the final CRLF.
// nbytes - The total number of bytes read from `stream`.
// Signals:
// <bad-header-error>
define function read-header-line!
(stream :: <stream>, buffer :: <byte-string>)
=> (epos :: <integer>, nbytes :: <integer>)
iterate loop (pos = 0, prev = #f, nbytes = 0)
let ch = read-element(stream, on-end-of-stream: #f)
| bad-header-error(message: "end of data");
if (ch == $lf & prev == $cr)
// Always drop the CRLF, whether for continuation lines or end of header.
pos := pos - 1;
// Avoid calling peek if this is the blank line terminating the headers
// since message body may be empty.
let char = pos > 0 & peek(stream, on-end-of-stream: #f);
if (char == ' ' | char == '\t')
loop(pos, char, nbytes + 1)
else
buffer[pos] := ch;
loop(buffer, bpos, epos, pos + 1, #f)
values(pos, nbytes + 1)
end
else
buffer[pos] := ch;
loop(pos + 1, ch, nbytes + 1)
end
end iterate
end function read-header-line;


end function;

// Split header into header name (the part preceding the ':') and header value.
// Note that this will happily accept "name:value" with no whitespace after the
// colon and "name:" with no data after the colon (in which case an empty
// string is returned).
//
// Signals:
// <bad-header-error>
define function split-header
(buffer :: <byte-string>, bpos :: <integer>, epos :: <integer>)
=> (header-key :: <string>, header-data :: <string>)
let pos = char-position(':', buffer, bpos, epos);
(buffer :: <byte-string>, epos :: <integer>)
=> (name :: <byte-string>, value :: <byte-string>)
let pos = char-position(':', buffer, 0, epos);
if (~pos)
bad-header-error(message: "Header line contained no colon")
else
// We don't use keywords for header keys, because don't want to end
// up interning some huge bogus header that would then drag us down
// for the rest of eternity...
let key = substring(buffer, bpos, pos);
let (data-start, data-end) = trim-whitespace(buffer, pos + 1, epos);
let data = substring(buffer, data-start, data-end);
values(key, data)
end
end function split-header;
bad-header-error(message: "no colon found")
end;
let name = copy-sequence(buffer, start: 0, end: pos);
let (start, _end) = trim-whitespace(buffer, pos + 1, epos);
values(name,
copy-sequence(buffer, start: start, end: _end))
end function;

////////////////////////////////////////////////////////////////////////////////

Expand Down
5 changes: 1 addition & 4 deletions common/http-common.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -426,10 +426,7 @@ end method chunked-transfer-encoding?;
// The string returned does not include the CRLF. Second return value
// is the end-of-line index.
//
// See also: read-header-line
// todo -- Callers of this that are in the server should pass a max-size
// argument, at which point an error should be signaled.
//
// TODO(cgay): Redo this to be more like read-http-line!.
define method read-http-line
(stream :: <stream>)
=> (buffer :: <byte-string>, len :: <integer>)
Expand Down
9 changes: 5 additions & 4 deletions common/library.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -268,7 +268,7 @@ define module http-common
<header-table>,
get-header,
set-header,
read-message-headers,
read-headers!,
raw-headers,
parsed-headers,
<avalue>,
Expand All @@ -285,10 +285,11 @@ define module http-common

// lower level header APIs...
create
read-header-line,
read-http-line,
grow-header-buffer,
make-header-buffer,
parse-header-value,
grow-header-buffer;
read-header-line!,
read-http-line;

// Cookies
create
Expand Down
62 changes: 62 additions & 0 deletions common/tests/headers-tests.dylan
Original file line number Diff line number Diff line change
@@ -0,0 +1,62 @@
Module: http-common-test-suite

// Verify that the CRLF following the last header line is consumed, i.e., that
// epos includes it.
define test test-read-headers! ()
let text = "Content-Disposition: form-data; name=\"main-code\"\r\n\r\ndef";
let buffer = make-header-buffer();
let headers = make(<header-table>);
with-input-from-string (stream = text)
let epos = read-headers!(stream, buffer, headers);
test-output("up to 52: %=\n", copy-sequence(text, end: 52));
assert-equal(52, epos);
assert-equal("form-data; name=\"main-code\"",
headers["content-disposition"],
"content-disposition header correct?");
assert-equal(1, headers.size);
assert-equal("def", read-to-end(stream));
end;
end test;

define test test-read-headers!-valid ()
let items
= list(list("x: y\r\n\r\n", #("x", "y")),
list("x: y\r\nz: a\r\n\r\n", #("x", "y", "z", "a")),
list("x:y\r\n\r\n", #("x", "y")),
list("x:\r\n\r\n", #("x", "")),
list("x: y\r\n z\r\n\r\n", #("x", "y z")),
list("x: y\rz\r\n\r\n", #("x", "y\rz")),
list("x: y\nz\r\n\r\n", #("x", "y\nz")),
list("\r\nmessage body", #()),
list("x: y: z\r\n\r\n", #("x", "y: z")));
for (item in items)
let (input, want) = apply(values, item);
let buffer = make-header-buffer();
let headers = make(<header-table>);
with-input-from-string (stream = input)
read-headers!(stream, buffer, headers);
end;
let description = format-to-string("input: %=", input);
assert-equal(floor/(want.size, 2), headers.size, description);
for (i from 0 below want.size by 2)
let name = want[i];
let value = want[i + 1];
assert-equal(value, headers[name], description);
end;
end for;
end test;

define test test-read-headers!-invalid ()
let error-cases = list("x:y\r\n", // no LWS
"x: y", // no CRLF
"x y\r\n"); // no colon
for (message in error-cases)
let buffer = make-header-buffer();
let headers = make(<header-table>);
assert-signals(<http-error>,
with-input-from-string (stream = message)
read-headers!(stream, buffer, headers);
end,
format-to-string("message: %=", message));
end;
end test;
12 changes: 0 additions & 12 deletions common/tests/http-common-test-suite-app-library.dylan

This file was deleted.

4 changes: 0 additions & 4 deletions common/tests/http-common-test-suite-app.dylan

This file was deleted.

3 changes: 0 additions & 3 deletions common/tests/http-common-test-suite-app.lid

This file was deleted.

6 changes: 3 additions & 3 deletions common/tests/http-common-test-suite-library.dylan
Original file line number Diff line number Diff line change
Expand Up @@ -8,14 +8,14 @@ define library http-common-test-suite
use testworks;
use io;
export http-common-test-suite;
end;
end library;

define module http-common-test-suite
use common-dylan;
use http-common;
use http-common-internals;
use streams;
use testworks;
use format;
export http-common-test-suite;
end;
end module;

Loading

0 comments on commit 9f30a1d

Please sign in to comment.