From 19fa8ea6193a687690f97cb92a4a7ee31b2937da Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 25 Dec 2002 14:59:13 +0000 Subject: [PATCH] - new module which contains 'sanity' functions previously included in Http_parser --- helm/DEVEL/ocaml-http/http_parser_sanity.ml | 89 ++++++++++++++++++++ helm/DEVEL/ocaml-http/http_parser_sanity.mli | 31 +++++++ 2 files changed, 120 insertions(+) create mode 100644 helm/DEVEL/ocaml-http/http_parser_sanity.ml create mode 100644 helm/DEVEL/ocaml-http/http_parser_sanity.mli diff --git a/helm/DEVEL/ocaml-http/http_parser_sanity.ml b/helm/DEVEL/ocaml-http/http_parser_sanity.ml new file mode 100644 index 000000000..19204e870 --- /dev/null +++ b/helm/DEVEL/ocaml-http/http_parser_sanity.ml @@ -0,0 +1,89 @@ + +open Neturl;; +open Printf;; + +open Http_types;; +open Http_constants;; + +(* +type url_syntax_option = + Url_part_not_recognized + | Url_part_allowed + | Url_part_required + +* (1) scheme://user:password@host:port/path;params?query#fragment +*) + +let request_uri_syntax = { + url_enable_scheme = Url_part_not_recognized; + url_enable_user = Url_part_not_recognized; + url_enable_password = Url_part_not_recognized; + url_enable_host = Url_part_not_recognized; + url_enable_port = Url_part_not_recognized; + url_enable_path = Url_part_required; + url_enable_param = Url_part_not_recognized; + url_enable_query = Url_part_allowed; + url_enable_fragment = Url_part_not_recognized; + url_enable_other = Url_part_not_recognized; + url_accepts_8bits = false; + url_is_valid = (fun _ -> true); +} + + (* convention: + foo_RE_raw is the uncompiled regexp matching foo + foo_RE is the compiled regexp matching foo + is_foo is the predicate over string matching foo + *) + +let separators_RE_raw = "()<>@,;:\\\\\"/\\[\\]?={} \t" +let ctls_RE_raw = "\\x00-\\x1F\\x7F" +let token_RE_raw = "[^" ^ separators_RE_raw ^ ctls_RE_raw ^ "]+" +let lws_RE_raw = "(\r\n)?[ \t]" +let quoted_string_RE_raw = "\"(([^\"])|(\\\\\"))*\"" +let text_RE_raw = "(([^" ^ ctls_RE_raw ^ "])|(" ^ lws_RE_raw ^ "))+" +let field_content_RE_raw = + sprintf + "^(((%s)|(%s)|(%s))|(%s))*$" + token_RE_raw + separators_RE_raw + quoted_string_RE_raw + text_RE_raw +(* + (* following RFC 2616 specifications *) +let field_value_RE_raw = "((" ^ field_content_RE_raw ^ ")|(" ^ lws_RE_raw^ "))*" +*) + (* smarter implementation: TEXT production is included in the regexp below *) +let field_value_RE_raw = + sprintf + "^((%s)|(%s)|(%s)|(%s))*$" + token_RE_raw + separators_RE_raw + quoted_string_RE_raw + lws_RE_raw + +let token_RE = Pcre.regexp ("^" ^ token_RE_raw ^ "$") +let field_value_RE = Pcre.regexp ("^" ^ field_value_RE_raw ^ "$") +let heading_lws_RE = Pcre.regexp (sprintf "^%s*" lws_RE_raw) +let trailing_lws_RE = Pcre.regexp (sprintf "%s*$" lws_RE_raw) + +let is_token s = Pcre.pmatch ~rex:token_RE s +let is_field_name = is_token +let is_field_value s = Pcre.pmatch ~rex:field_value_RE s + +let heal_header_name s = + if not (is_field_name s) then raise (Invalid_header_name s) else () + +let heal_header_value s = + if not (is_field_value s) then raise (Invalid_header_value s) else () + +let normalize_header_value s = + Pcre.replace ~rex:trailing_lws_RE + (Pcre.replace ~rex:heading_lws_RE s) + +let heal_header (name, value) = + heal_header_name name; + heal_header_value name + +let url_of_string = url_of_string request_uri_syntax +let string_of_url = Neturl.string_of_url + diff --git a/helm/DEVEL/ocaml-http/http_parser_sanity.mli b/helm/DEVEL/ocaml-http/http_parser_sanity.mli new file mode 100644 index 000000000..3076a42a6 --- /dev/null +++ b/helm/DEVEL/ocaml-http/http_parser_sanity.mli @@ -0,0 +1,31 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +val heal_header_name: string -> unit +val heal_header_value: string -> unit +val heal_header: string * string -> unit + + (** remove heading and/or trailing LWS sequences as per RFC2616 *) +val normalize_header_value: string -> string + +val url_of_string: string -> Neturl.url +val string_of_url: Neturl.url -> string + -- 2.39.2