Permalink
Browse files

Merge pull request #10 from cgay/new-strings

Update for new strings library.
  • Loading branch information...
cgay committed May 19, 2012
2 parents 3c9f58b + 8172418 commit 0d6a69b5fff7fc9ba446d02e42b52227610e6e3c
View
@@ -61,6 +61,7 @@ define module http-client-internals
use format;
use http-client, export: all;
use http-common;
+ use %http-common-byte-string;
use logging;
use sockets,
exclude: { start-server };
View
@@ -0,0 +1,125 @@
+Module: %http-common-byte-string
+Author: Gail Zacharias, Carl Gay
+Synopsis: Low-level string utilities designed to be as fast as possible.
+ This code assumes <byte-string>s only. It was originally written
+ for use in the HTTP server. (Note that a different definition of
+ whitespace is used in this file.)
+
+
+define constant $cr = as(<character>, 13); // \r
+define constant $lf = as(<character>, 10); // \n
+
+define inline function char-position-if (test? :: <function>,
+ buf :: <byte-string>,
+ bpos :: <integer>,
+ epos :: <integer>)
+ => (pos :: false-or(<integer>))
+ iterate loop (pos :: <integer> = bpos)
+ unless (pos == epos)
+ if (test?(buf[pos])) pos else loop(pos + 1) end;
+ end;
+ end;
+end;
+
+define function char-position (ch :: <byte-character>,
+ buf :: <byte-string>,
+ bpos :: <integer>,
+ epos :: <integer>)
+ => (pos :: false-or(<integer>))
+ char-position-if(method(c) c == ch end, buf, bpos, epos);
+end char-position;
+
+define function char-position-from-end (ch :: <byte-character>,
+ buf :: <byte-string>,
+ bpos :: <integer>,
+ epos :: <integer>)
+ => (pos :: false-or(<integer>))
+ iterate loop (pos :: <integer> = epos)
+ unless (pos == bpos)
+ let npos = pos - 1;
+ if (ch == buf[npos]) npos else loop(npos) end;
+ end;
+ end;
+end char-position-from-end;
+
+// Note that this doesn't check for stray cr's or lf's, because
+// those are just random control chars, proper crlf's got
+// eliminated during header reading.
+define inline function %whitespace? (ch :: <byte-character>)
+ ch == '\t' | ch == ' '
+end;
+
+define function whitespace-position (buf :: <byte-string>,
+ bpos :: <integer>,
+ epos :: <integer>)
+ => (pos :: false-or(<integer>))
+ char-position-if(%whitespace?, buf, bpos, epos);
+end whitespace-position;
+
+define function skip-whitespace (buffer :: <byte-string>,
+ bpos :: <integer>,
+ epos :: <integer>)
+ => (pos :: <integer>)
+ iterate fwd (pos :: <integer> = bpos)
+ if (pos >= epos | ~%whitespace?(buffer[pos]))
+ pos
+ else
+ fwd(pos + 1)
+ end;
+ end;
+end skip-whitespace;
+
+define function trim-whitespace (buffer :: <byte-string>,
+ start :: <integer>,
+ endp :: <integer>)
+ => (start :: <integer>, endp :: <integer>)
+ let pos = skip-whitespace(buffer, start, endp);
+ values(pos,
+ if (pos == endp)
+ endp
+ else
+ iterate bwd (epos :: <integer> = endp)
+ let last = epos - 1;
+ if (last >= start & %whitespace?(buffer[last]))
+ bwd(last)
+ else
+ epos
+ end;
+ end;
+ end)
+end trim-whitespace;
+
+define function digit-weight (ch :: <byte-character>) => (n :: false-or(<integer>))
+ when (ch >= '0')
+ let n = logior(as(<integer>, ch), 32) - as(<integer>, '0');
+ if (n <= 9)
+ n
+ else
+ let n = n - (as(<integer>, 'a') - as(<integer>, '0') - 10);
+ 10 <= n & n <= 15 & n
+ end;
+ end;
+end digit-weight;
+
+
+define function substring
+ (str :: <byte-string>, bpos :: <integer>, epos :: <integer>)
+ if(bpos == 0 & epos == str.size)
+ str
+ else
+ copy-sequence(str, start: bpos, end: epos)
+ end
+end function substring;
+
+define function string-extent
+ (str :: <byte-string>)
+ => (str :: <byte-string>, bpos :: <integer>, epos :: <integer>)
+ values(str, 0, str.size)
+end;
+
+// Does pattern occur in string starting at bpos?
+define function looking-at?
+ (pattern :: <byte-string>, string :: <byte-string>, bpos :: <integer>)
+ => (found? :: <boolean>)
+ string-equal-ic?(pattern, string, start2: bpos)
+end;
View
@@ -291,7 +291,7 @@ define function parse-authorization-value (str :: <byte-string>,
let dpos = whitespace-position(str, bpos, epos) | epos;
let (b, e) = trim-whitespace(str, dpos, epos);
- if (string-match("Basic", str, bpos, dpos))
+ if (string-equal-ic?("Basic", str, start2: bpos, end2: dpos))
// base64 encoding of userid:password. Should decode and return
// (userid . password). or maybe avalue with "userid"=userid, etc.
let username+password = split(base64-decode(trimmed-substring(str, dpos, epos)), ":");
@@ -350,10 +350,10 @@ end;
define function parse-entity-tag-value
(str :: <byte-string>, bpos :: <integer>, epos :: <integer>)
- if (string-match("*", str, bpos, epos))
+ if (string-equal-ic?("*", str, start2: bpos, end2: epos))
#("*" . #f)
else
- let weak? = looking-at?("W/", str, bpos, epos)
+ let weak? = string-equal-ic?("W/", str, start2: bpos, end2: epos)
& (bpos := skip-whitespace(str, bpos + 2, epos));
unless (bpos < epos & str[bpos] == '"')
bad-header-error(message: "invalid entity tag; expected '\"'");
@@ -442,7 +442,7 @@ define function parse-ranges-value (str :: <byte-string>,
let pos = char-position('=', str, bpos, epos)
| bad-header-error(message: "invalid ranges value");
let (b, e) = trim-whitespace(str, bpos, pos);
- string-match("bytes", str, b, e)
+ string-equal-ic?("bytes", str, start2: b, end2: e)
| bad-header-error(message: "invalid range unit; expected 'bytes'");
iterate loop (pos = pos, ranges = #())
let bpos = skip-whitespace(str, pos + 1, epos);
@@ -469,7 +469,7 @@ define function parse-range-value
(str :: <byte-string>, bpos :: <integer>, epos :: <integer>)
=> (range :: <pair>)
let pos = token-end-position(str, bpos, epos);
- unless (pos & string-match("bytes", str, bpos, pos))
+ unless (pos & string-equal-ic?("bytes", str, start2: bpos, end2: pos))
bad-header-error(message: "invalid range unit; expected 'bytes'");
end;
let bpos = skip-whitespace(str, pos, epos);
View
@@ -237,13 +237,9 @@ end;
define sealed method table-protocol (table :: <header-table>)
=> (test-fn :: <function>, hash-fn :: <function>);
ignore(table);
- values(string-equal?, sstring-hash);
+ values(string-equal-ic?, sstring-hash);
end method table-protocol;
-define method sstring-hash (s :: <substring>, state)
- values(string-hash-2(s.substring-base, s.substring-start, s.size), state)
-end;
-
define method sstring-hash (s :: <byte-string>, state)
values(string-hash-2(s, 0, s.size), state)
end;
View
@@ -6,3 +6,4 @@ files: library
header-values
headers
http-common
+ byte-string
View
@@ -4,10 +4,13 @@ Synopsis: Code shared by HTTP client and server
define library http-common
use base64;
use common-dylan,
- import: { dylan,
+ import: { common-dylan,
common-extensions,
- threads,
- simple-random };
+ dylan,
+ simple-random,
+ threads };
+ use dylan,
+ import: { dylan-extensions };
use io,
import: { format,
standard-io,
@@ -24,7 +27,8 @@ define library http-common
use uri;
export
http-common,
- http-common-internals;
+ http-common-internals,
+ %http-common-byte-string;
end library http-common;
define module http-common
@@ -297,6 +301,25 @@ define module http-common
$default-cookie-version; // get rid of this
end module http-common;
+define module %http-common-byte-string
+ use common-dylan;
+ use dylan-extensions;
+ use strings;
+ export
+ $cr,
+ $lf,
+ char-position,
+ char-position-from-end,
+ char-position-if,
+ digit-weight,
+ looking-at?,
+ skip-whitespace,
+ substring,
+ string-extent,
+ trim-whitespace,
+ whitespace-position;
+end module %http-common-byte-string;
+
define module http-common-internals
use base64;
use common-extensions,
@@ -309,6 +332,7 @@ define module http-common-internals
<pathname> };
use format;
use http-common;
+ use %http-common-byte-string;
use locators,
import: { <locator>,
<file-locator>,
@@ -189,30 +189,23 @@ define constant $file-extension-regex :: <regex>
// Get locators for all the files matching the given locator prefix. e.g., if the
// locator is for /foo/bar then we would return bar.html, bar.txt, etc.
+// TODO(cgay): This assumes case-sensitive file system.
define method locators-matching
(document :: <locator>)
=> (locators :: <sequence>)
let document-name :: <string> = concatenate(locator-name(document), ".");
let length :: <integer> = document-name.size;
- log-debug("document-name = %=, length = %=", document-name, length);
let locators = make(<stretchy-vector>);
local method match (directory, name, type)
- log-debug("match: directory = %s, name = %s, type = %s",
- directory, name, type);
if (type = #"file"
& (name.size >= document-name.size)
- & equal?(document-name, name, end2: length))
+ & string-equal?(document-name, name, end2: length))
log-debug("document name matched");
if (regex-search($file-extension-regex, name, start: length))
- log-debug("regex matched");
add!(locators, make(<file-locator>,
directory: document.locator-directory,
name: name));
- else
- log-debug("regex didn't match");
end;
- else
- log-debug("document name didn't match")
end;
end;
do-directory(match, locator-directory(document));
@@ -207,6 +207,7 @@ define module httpi // http internals
use file-system; // from system lib
use format;
use http-common;
+ use %http-common-byte-string;
use koala;
use koala-unit;
use locators,
@@ -21,7 +21,7 @@ define method show-element
// IIRC <option name="foo" selected> used to be valid. Not sure there's
// much point in supporting this anymore, but it doesn't seem to hurt.
if (value)
- let value = as(<string>, trim(value));
+ let value = as(<string>, strip(value));
if (~empty?(value))
format(stream, "=\"%s\"", quote-html(value));
end;
@@ -89,7 +89,7 @@ end tag get;
define method get-context-value
(name :: <string>, context :: false-or(<string>), #key tag)
=> (value :: <object>)
- let name = trim(name);
+ let name = strip(name);
local method get-context-value-internal ()
block (return)
// Search contexts in order to find a value. First one is displayed.
@@ -690,7 +690,7 @@ define method validate-form-field
field-value := percent-decode(field-value);
end;
if (trim?)
- field-value := trim(field-value);
+ field-value := strip(field-value);
end;
if (error-if-empty & empty?(field-value))
add-field-error(field-name, "The %s field is required.", field-name);
View
@@ -35,6 +35,7 @@ define module dsp
use format,
rename: { format-to-string => sformat };
use http-common;
+ use %http-common-byte-string;
use koala;
use locators,
import: { <locator>,
@@ -82,7 +82,7 @@ define test cgi-required-environment-variables-test ()
let eol-regex = compile-regex("\r?\n");
do(method (line)
let (var, val) = apply(values, split(line, "=", count: 2));
- var := trim(var);
+ var := strip(var);
if (val & var.size > 0)
env[var] := val;
end;

0 comments on commit 0d6a69b

Please sign in to comment.