Merge pull request #94 from cgay/dev

http changes needed for web-playground

README.rst

@@ -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

client/http-client.dylan

@@ -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

common/headers.dylan

@@ -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"));
@@ -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;
 
 ////////////////////////////////////////////////////////////////////////////////
 

common/http-common.dylan

@@ -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>)

common/library.dylan

@@ -268,7 +268,7 @@ define module http-common
     <header-table>,
     get-header,
     set-header,
-    read-message-headers,
+    read-headers!,
     raw-headers,
     parsed-headers,
     <avalue>,
@@ -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

common/tests/headers-tests.dylan

@@ -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;

common/tests/http-common-test-suite-library.dylan

@@ -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;