From 7b56b45ca2bed7080dc75a581bfbb96fff160828 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Wed, 22 May 2024 22:11:53 +0200 Subject: [PATCH] ocamlformat 0.26.1 --- .ocamlformat | 2 +- src/baselib/ocsigen_cache.ml | 18 +-- src/baselib/ocsigen_cache.mli | 34 ++--- src/baselib/ocsigen_config_static.ml.in | 4 +- src/baselib/ocsigen_lib.ml | 42 +++--- src/baselib/ocsigen_lib.mli | 14 +- src/baselib/ocsigen_lib_base.ml | 10 +- src/baselib/ocsigen_loader.ml | 2 +- src/baselib/ocsigen_stream.ml | 35 +++-- src/baselib/polytables/polytables.ml | 6 +- src/baselib/tests/test_wrapping.ml | 16 +- src/extensions/accesscontrol.ml | 21 +-- src/extensions/accesscontrol.mli | 2 +- src/extensions/authbasic.ml | 10 +- src/extensions/cors.ml | 40 ++--- src/extensions/deflatemod.ml | 8 +- src/extensions/deflatemod.mli | 4 +- src/extensions/extendconfiguration.ml | 78 +++++----- src/extensions/outputfilter.ml | 34 ++--- src/extensions/outputfilter.mli | 8 +- src/extensions/redirectmod.ml | 20 +-- src/extensions/redirectmod.mli | 4 +- src/extensions/revproxy.ml | 192 ++++++++++++------------ src/extensions/rewritemod.ml | 4 +- src/extensions/staticmod.ml | 77 +++++----- src/extensions/userconf.ml | 81 +++++----- src/http/ocsigen_charset_mime.mli | 4 +- src/http/ocsigen_cookie_map.ml | 6 +- src/http/ocsigen_cookie_map.mli | 8 +- src/http/ocsigen_header.ml | 10 +- src/server/ocsigen_cohttp.ml | 116 +++++++------- src/server/ocsigen_cohttp.mli | 4 +- src/server/ocsigen_command.ml | 6 +- src/server/ocsigen_command.mli | 8 +- src/server/ocsigen_config.ml | 2 - src/server/ocsigen_extensions.ml | 62 ++++---- src/server/ocsigen_extensions.mli | 64 ++++---- src/server/ocsigen_local_files.mli | 6 +- src/server/ocsigen_messages.ml | 48 +++--- src/server/ocsigen_messages.mli | 4 +- src/server/ocsigen_multipart.ml | 110 +++++++------- src/server/ocsigen_multipart.mli | 8 +- src/server/ocsigen_request.ml | 10 +- src/server/ocsigen_request.mli | 16 +- src/server/ocsigen_response.ml | 7 +- src/server/ocsigen_response.mli | 12 +- src/server/ocsigen_server.ml | 72 ++++----- src/server/ocsigen_server.mli | 20 +-- 48 files changed, 683 insertions(+), 686 deletions(-) diff --git a/.ocamlformat b/.ocamlformat index 64d047218..a8e766218 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.19.0 +version=0.26.1 break-cases = fit break-collection-expressions = fit-or-vertical break-fun-decl = wrap diff --git a/src/baselib/ocsigen_cache.ml b/src/baselib/ocsigen_cache.ml index 8f86b34d2..608c15b26 100644 --- a/src/baselib/ocsigen_cache.ml +++ b/src/baselib/ocsigen_cache.ml @@ -407,11 +407,11 @@ end = struct end module Weak = Weak.Make (struct - type t = unit -> unit + type t = unit -> unit - let hash = Hashtbl.hash - let equal = ( == ) -end) + let hash = Hashtbl.hash + let equal = ( == ) + end) let clear_all = Weak.create 17 @@ -424,18 +424,18 @@ functor -> struct module H = Hashtbl.Make (struct - type t = A.key + type t = A.key - let equal a a' = a = a' - let hash = Hashtbl.hash - end) + let equal a a' = a = a' + let hash = Hashtbl.hash + end) type t = { mutable pointers : A.key Dlist.t ; mutable table : (A.value * A.key Dlist.node) H.t ; finder : A.key -> A.value Lwt.t ; clear : unit -> unit - (* This function clears the cache. It is put inside the + (* This function clears the cache. It is put inside the cache structure so that it is garbage-collected only when the cache is no longer referenced, as the functions themselves are put inside a weak hash table *) diff --git a/src/baselib/ocsigen_cache.mli b/src/baselib/ocsigen_cache.mli index f0e9cfd39..79299ad98 100644 --- a/src/baselib/ocsigen_cache.mli +++ b/src/baselib/ocsigen_cache.mli @@ -35,11 +35,11 @@ *) module Make : functor - (A : sig - type key - type value - end) - -> sig + (A : sig + type key + type value + end) + -> sig (** [new cache finder ?timer size] creates a cache object where [finder] is the function responsible for retrieving non-cached data, [timer] (if any) is the life span of cached values (in seconds) (values in the @@ -53,25 +53,21 @@ module Make : functor Using [timer] allow one to create a cache bounded both in space and time. It is to be noted that real lifespan of values is always slightly greater than [timer]. *) - class cache : - (A.key -> A.value Lwt.t) - -> ?timer:float - -> int - -> object - method find : A.key -> A.value Lwt.t - (** Find the cached value associated to the key, or binds this + class cache : (A.key -> A.value Lwt.t) -> ?timer:float -> int -> object + method find : A.key -> A.value Lwt.t + (** Find the cached value associated to the key, or binds this value in the cache using the function [finder] passed as argument to [create], and returns this value *) - method find_in_cache : A.key -> A.value - (** Find the cached value associated to the key. Raises [Not_found] + method find_in_cache : A.key -> A.value + (** Find the cached value associated to the key. Raises [Not_found] if the key is not present in the cache *) - method remove : A.key -> unit - method add : A.key -> A.value -> unit - method clear : unit -> unit - method size : int - end + method remove : A.key -> unit + method add : A.key -> A.value -> unit + method clear : unit -> unit + method size : int + end end val clear_all_caches : unit -> unit diff --git a/src/baselib/ocsigen_config_static.ml.in b/src/baselib/ocsigen_config_static.ml.in index f074a559a..b62eebca2 100644 --- a/src/baselib/ocsigen_config_static.ml.in +++ b/src/baselib/ocsigen_config_static.ml.in @@ -29,8 +29,8 @@ let datadir = ref "_DATADIR_" let bindir = ref "_BINDIR_" let extdir = ref "_EXTDIR_" let command_pipe = ref "_COMMANDPIPE_" + let builtin_packages = List.fold_left (fun a s -> Ocsigen_lib.String.Set.add s a) - Ocsigen_lib.String.Set.empty - [_DEPS_] + Ocsigen_lib.String.Set.empty [_DEPS_] diff --git a/src/baselib/ocsigen_lib.ml b/src/baselib/ocsigen_lib.ml index dfebfceb9..0f7073e2a 100644 --- a/src/baselib/ocsigen_lib.ml +++ b/src/baselib/ocsigen_lib.ml @@ -33,8 +33,8 @@ module Ip_address = struct in let options = [ (if v6 - then Lwt_unix.AI_FAMILY Lwt_unix.PF_INET6 - else Lwt_unix.AI_FAMILY Lwt_unix.PF_INET) ] + then Lwt_unix.AI_FAMILY Lwt_unix.PF_INET6 + else Lwt_unix.AI_FAMILY Lwt_unix.PF_INET) ] in Lwt.bind (Lwt_unix.getaddrinfo host "" options) aux @@ -181,7 +181,7 @@ module Url = struct let fixup_url_string1 = Netstring_pcre.global_substitute problem_re1 (fun m s -> - Printf.sprintf "%%%02x" (Char.code s.[fst (Pcre.get_substring_ofs m 0)])) + Printf.sprintf "%%%02x" (Char.code s.[fst (Pcre.get_substring_ofs m 0)])) (* I add this fixup to handle %uxxxx sent by browsers. Translated to %xx%xx *) @@ -191,11 +191,11 @@ module Url = struct fixup_url_string1 (Netstring_pcre.global_substitute problem_re2 (fun m s -> - String.concat "" - [ "%" - ; Netstring_pcre.matched_group m 1 s - ; "%" - ; Netstring_pcre.matched_group m 2 s ]) + String.concat "" + [ "%" + ; Netstring_pcre.matched_group m 1 s + ; "%" + ; Netstring_pcre.matched_group m 2 s ]) s) (*VVV This is in Netencoding but we have a problem with ~ @@ -296,19 +296,19 @@ module Url = struct let l = String.length s1 in Netstring_pcre.global_substitute url_decoding_re (fun r _ -> - match Netstring_pcre.matched_string r s1 with - | "+" -> if plus then " " else "+" - | _ -> ( - let i = fst (Pcre.get_substring_ofs r 0) in - (* Assertion: s1.[i] = '%' *) - if i + 2 >= l then failwith "decode"; - let c1 = s1.[i + 1] in - let c2 = s1.[i + 2] in - try - let k1 = of_hex1 c1 in - let k2 = of_hex1 c2 in - String.make 1 (Char.chr ((k1 lsl 4) lor k2)) - with Not_found -> failwith "decode")) + match Netstring_pcre.matched_string r s1 with + | "+" -> if plus then " " else "+" + | _ -> ( + let i = fst (Pcre.get_substring_ofs r 0) in + (* Assertion: s1.[i] = '%' *) + if i + 2 >= l then failwith "decode"; + let c1 = s1.[i + 1] in + let c2 = s1.[i + 2] in + try + let k1 = of_hex1 c1 in + let k2 = of_hex1 c2 in + String.make 1 (Char.chr ((k1 lsl 4) lor k2)) + with Not_found -> failwith "decode")) s1 let make_encoded_parameters params = diff --git a/src/baselib/ocsigen_lib.mli b/src/baselib/ocsigen_lib.mli index 7f6746c5c..27c864522 100644 --- a/src/baselib/ocsigen_lib.mli +++ b/src/baselib/ocsigen_lib.mli @@ -23,11 +23,11 @@ include module type of Ocsigen_lib_base - with type poly = Ocsigen_lib_base.poly - and type yesnomaybe = Ocsigen_lib_base.yesnomaybe - and type ('a, 'b) leftright = ('a, 'b) Ocsigen_lib_base.leftright - and type 'a Clist.t = 'a Ocsigen_lib_base.Clist.t - and type 'a Clist.node = 'a Ocsigen_lib_base.Clist.node + with type poly = Ocsigen_lib_base.poly + and type yesnomaybe = Ocsigen_lib_base.yesnomaybe + and type ('a, 'b) leftright = ('a, 'b) Ocsigen_lib_base.leftright + and type 'a Clist.t = 'a Ocsigen_lib_base.Clist.t + and type 'a Clist.node = 'a Ocsigen_lib_base.Clist.node val make_cryptographic_safe_string : unit -> string (** Generate an unique and cryptographically safe random string. @@ -60,8 +60,8 @@ module Url : sig val make_encoded_parameters : (string * string) list -> string val string_of_url_path : encode:bool -> path -> uri - val parse - : t + val parse : + t -> bool option * string option * int option diff --git a/src/baselib/ocsigen_lib_base.ml b/src/baselib/ocsigen_lib_base.ml index 51a3ab901..0404d37fe 100644 --- a/src/baselib/ocsigen_lib_base.ml +++ b/src/baselib/ocsigen_lib_base.ml @@ -220,10 +220,10 @@ end module Int = struct module Table = Map.Make (struct - type t = int + type t = int - let compare = compare - end) + let compare = compare + end) end (*****************************************************************************) @@ -312,8 +312,8 @@ module Url_base = struct (if https then "https://" else "http://") ^ host ^ (if (port = 80 && not https) || (https && port = 443) - then "" - else ":" ^ string_of_int port) + then "" + else ":" ^ string_of_int port) ^ uri let remove_dotdot = diff --git a/src/baselib/ocsigen_loader.ml b/src/baselib/ocsigen_loader.ml index 6cccd934a..2714ccc89 100644 --- a/src/baselib/ocsigen_loader.ml +++ b/src/baselib/ocsigen_loader.ml @@ -158,7 +158,7 @@ let findfiles = let deps = List.filter (fun a -> - not @@ String.Set.mem a Ocsigen_config_static.builtin_packages) + not @@ String.Set.mem a Ocsigen_config_static.builtin_packages) (Findlib.package_deep_ancestors preds [package]) in Lwt_log.ign_info_f ~section "Dependencies of %s: %s" package diff --git a/src/baselib/ocsigen_stream.ml b/src/baselib/ocsigen_stream.ml index bff13f641..18c7c5606 100644 --- a/src/baselib/ocsigen_stream.ml +++ b/src/baselib/ocsigen_stream.ml @@ -59,15 +59,15 @@ let rec get_aux st = (Lwt.try_bind (fun () -> Lazy.force st.stream) (fun e -> - Lwt.return - (match e with - | Cont (s, rem) -> - st.stream <- rem; - Cont (s, get_aux st) - | _ -> e)) + Lwt.return + (match e with + | Cont (s, rem) -> + st.stream <- rem; + Cont (s, get_aux st) + | _ -> e)) (fun e -> - st.stream <- lazy (Lwt.fail e); - Lwt.fail (Interrupted e))) + st.stream <- lazy (Lwt.fail e); + Lwt.fail (Interrupted e))) let get st = if st.in_use then raise Already_read; @@ -141,7 +141,7 @@ let enlarge_stream = function else let long4 = long3 - max in cont (String.sub new_s 0 max) (fun () -> - Lwt.return (Cont (String.sub new_s max long4, ff)))) + Lwt.return (Cont (String.sub new_s max long4, ff)))) let rec stream_want s len = (* returns a stream with at least len bytes read if possible *) @@ -154,7 +154,7 @@ let rec stream_want s len = Lwt.catch (fun () -> enlarge_stream s >>= fun r -> Lwt.return (`OK r)) (function - | Stream_too_small -> Lwt.return `Too_small | e -> Lwt.fail e) + | Stream_too_small -> Lwt.return `Too_small | e -> Lwt.fail e) >>= function | `OK r -> stream_want r len | `Too_small -> Lwt.return s) @@ -191,17 +191,16 @@ let substream delim s = try let p, _ = Ocsigen_lib.Netstring_pcre.search_forward rdelim s 0 in cont (String.sub s 0 p) (fun () -> - empty - (Some - (fun () -> - Lwt.return (Cont (String.sub s p (len - p), f))))) + empty + (Some + (fun () -> Lwt.return (Cont (String.sub s p (len - p), f))))) with Not_found -> let pos = len + 1 - ldelim in cont (String.sub s 0 pos) (fun () -> - next f >>= function - | Finished _ -> Lwt.fail Stream_too_small - | Cont (s', f') -> - aux (Cont (String.sub s pos (len - pos) ^ s', f')))) + next f >>= function + | Finished _ -> Lwt.fail Stream_too_small + | Cont (s', f') -> + aux (Cont (String.sub s pos (len - pos) ^ s', f')))) in aux s diff --git a/src/baselib/polytables/polytables.ml b/src/baselib/polytables/polytables.ml index e54b3ea55..4ac945a01 100644 --- a/src/baselib/polytables/polytables.ml +++ b/src/baselib/polytables/polytables.ml @@ -23,10 +23,10 @@ type 'a key = int * 'a option ref module T = Map.Make (struct - type t = int + type t = int - let compare = compare -end) + let compare = compare + end) type t = (unit -> unit) T.t ref diff --git a/src/baselib/tests/test_wrapping.ml b/src/baselib/tests/test_wrapping.ml index d1fcb2d48..35baf99b9 100644 --- a/src/baselib/tests/test_wrapping.ml +++ b/src/baselib/tests/test_wrapping.ml @@ -7,7 +7,7 @@ type a = {a : float; a_wrap : a Ocsigen_wrap.wrapper} let a_wrap () = Ocsigen_wrap.create_wrapper (fun t -> - {a = t.a +. 1.; a_wrap = Ocsigen_wrap.empty_wrapper}) + {a = t.a +. 1.; a_wrap = Ocsigen_wrap.empty_wrapper}) let a i = {a = i; a_wrap = a_wrap ()} let va = a 3.14 @@ -64,7 +64,7 @@ let ( -- ) x y = aux y x [] (* -type l = + type l = | A | L of l * int @@ -116,8 +116,8 @@ let i = ref 0 let mtoto () = Ocsigen_wrap.create_wrapper (fun t -> - incr i; - string_of_float t.a, !i) + incr i; + string_of_float t.a, !i) let mt () = Ocsigen_wrap.create_wrapper (fun t -> incr i; t.v2) let toto i = {a = i; mtoto = mtoto ()} @@ -140,13 +140,13 @@ let r3 = ref 88 let t1mark () = Ocsigen_wrap.create_wrapper (fun t -> - incr r1; - {t1a = 3.14; t1mark = Ocsigen_wrap.empty_wrapper}) + incr r1; + {t1a = 3.14; t1mark = Ocsigen_wrap.empty_wrapper}) let t2mark () = Ocsigen_wrap.create_wrapper (fun t -> - (match t.t2f with Some f -> f r2 | None -> assert false); - {t with t2f = None; t2mark = Ocsigen_wrap.empty_wrapper}) + (match t.t2f with Some f -> f r2 | None -> assert false); + {t with t2f = None; t2mark = Ocsigen_wrap.empty_wrapper}) let t1 = {t1a = 1.1; t1mark = t1mark ()} let t2 = {t2t1 = t1; t2f = Some (fun r -> incr r; incr r3); t2mark = t2mark ()} diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml index 0228ff4e4..b6797eae8 100644 --- a/src/extensions/accesscontrol.ml +++ b/src/extensions/accesscontrol.ml @@ -90,10 +90,10 @@ let rec parse_condition = function let r = List.exists (fun a -> - let r = Netstring_pcre.string_match regexp a 0 <> None in - if r - then Lwt_log.ign_info_f "HEADER: header %s matches %S" name reg; - r) + let r = Netstring_pcre.string_match regexp a 0 <> None in + if r + then Lwt_log.ign_info_f "HEADER: header %s matches %S" name reg; + r) (Ocsigen_request.header_multi ri (Ocsigen_header.Name.of_string name)) in @@ -187,12 +187,13 @@ let parse_config parse_fun = function | Ocsigen_extensions.Req_not_found (_, ri) -> Lwt.return (if condition ri.Ocsigen_extensions.request_info - then ( - Lwt_log.ign_info ~section "COND: going into branch"; - Ocsigen_extensions.Ext_sub_result ithen) - else ( - Lwt_log.ign_info ~section "COND: going into branch, if any"; - Ocsigen_extensions.Ext_sub_result ielse))) + then ( + Lwt_log.ign_info ~section "COND: going into branch"; + Ocsigen_extensions.Ext_sub_result ithen) + else ( + Lwt_log.ign_info ~section + "COND: going into branch, if any"; + Ocsigen_extensions.Ext_sub_result ielse))) | Element (("if" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Element ("notfound", [], []) -> diff --git a/src/extensions/accesscontrol.mli b/src/extensions/accesscontrol.mli index 5ef45d76e..5886925be 100644 --- a/src/extensions/accesscontrol.mli +++ b/src/extensions/accesscontrol.mli @@ -19,7 +19,7 @@ *) (* -val parse_condition : + val parse_condition : Xml.xml -> Ocsigen_extensions.request_info -> bool *) diff --git a/src/extensions/authbasic.ml b/src/extensions/authbasic.ml index 1dc6b2f25..7fabcd384 100644 --- a/src/extensions/authbasic.ml +++ b/src/extensions/authbasic.ml @@ -29,7 +29,7 @@ exception Bad_config_tag_for_auth of string let register_basic_authentication_method, get_basic_authentication_method = let fun_auth = ref (fun _config -> - raise (Bad_config_tag_for_auth "")) + raise (Bad_config_tag_for_auth "")) in (* register_basic_authentication_method *) ( (fun new_fun_auth -> @@ -91,7 +91,7 @@ let parse_config element = [ Configuration.element ~name:"authbasic" ~attributes: [ Configuration.attribute ~name:"realm" ~obligatory:true (fun s -> - realm_ref := s) ] + realm_ref := s) ] ~other_elements:(fun name attrs content -> rest_ref := Xml.Element (name, attrs, content) :: !rest_ref) () ] @@ -116,6 +116,6 @@ let auth = Ocsigen_server.Site.Config.key () let extension = Ocsigen_server.Site.create_extension (fun {Ocsigen_server.Site.Config.accessor} -> - match accessor realm, accessor auth with - | Some realm, Some auth -> gen ~realm ~auth - | _, _ -> failwith "Authbasic realm and/or auth not set") + match accessor realm, accessor auth with + | Some realm, Some auth -> gen ~realm ~auth + | _, _ -> failwith "Authbasic realm and/or auth not set") diff --git a/src/extensions/cors.ml b/src/extensions/cors.ml index b1cba2913..dd541beb4 100644 --- a/src/extensions/cors.ml +++ b/src/extensions/cors.ml @@ -131,22 +131,22 @@ let parse_config _ _ _parse_fun config_elem = [ Configuration.element ~name:"cors" ~attributes: [ Configuration.attribute ~name:"credentials" (fun s -> - let s = bool_of_string s in - config := {!config with credentials = s}) + let s = bool_of_string s in + config := {!config with credentials = s}) ; Configuration.attribute ~name:"max_age" (fun s -> - let s = Some (int_of_string s) in - config := {!config with max_age = s}) + let s = Some (int_of_string s) in + config := {!config with max_age = s}) ; Configuration.attribute ~name:"exposed_headers" (fun s -> - let s = - Ocsigen_lib.Netstring_pcre.split comma_space_regexp s - in - config := {!config with exposed_headers = s}) + let s = + Ocsigen_lib.Netstring_pcre.split comma_space_regexp s + in + config := {!config with exposed_headers = s}) ; Configuration.attribute ~name:"methods" (fun s -> - let s = - Ocsigen_lib.Netstring_pcre.split comma_space_regexp s - in - let s = Some (List.map Cohttp.Code.method_of_string s) in - config := {!config with methods = s}) ] + let s = + Ocsigen_lib.Netstring_pcre.split comma_space_regexp s + in + let s = Some (List.map Cohttp.Code.method_of_string s) in + config := {!config with methods = s}) ] () ] config_elem); main !config @@ -164,10 +164,10 @@ let methods = Ocsigen_server.Site.Config.key () let extension = Ocsigen_server.Site.create_extension (fun {Ocsigen_server.Site.Config.accessor} -> - let methods = accessor methods - and credentials = Ocsigen_lib.Option.get' false (accessor credentials) - and max_age = accessor max_age - and exposed_headers = - Ocsigen_lib.Option.get' [] (accessor exposed_headers) - in - main {credentials; methods; max_age; exposed_headers}) + let methods = accessor methods + and credentials = Ocsigen_lib.Option.get' false (accessor credentials) + and max_age = accessor max_age + and exposed_headers = + Ocsigen_lib.Option.get' [] (accessor exposed_headers) + in + main {credentials; methods; max_age; exposed_headers}) diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml index 50290c97f..7ae5f6ee8 100644 --- a/src/extensions/deflatemod.ml +++ b/src/extensions/deflatemod.ml @@ -189,7 +189,7 @@ let compress deflate stream : string Ocsigen_stream.t = then Ocsigen_stream.make ~finalize new_stream else Ocsigen_stream.make ~finalize (fun () -> - Ocsigen_stream.cont gzip_header new_stream) + Ocsigen_stream.cont gzip_header new_stream) (* We implement Content-Encoding, not Transfer-Encoding *) type encoding = Deflate | Gzip | Id | Star | Not_acceptable @@ -382,6 +382,6 @@ let mode = Ocsigen_server.Site.Config.key () let extension = Ocsigen_server.Site.create_extension (fun {Ocsigen_server.Site.Config.accessor} -> - match accessor mode with - | Some mode -> filter mode - | None -> failwith "Deflatemod.mode not set") + match accessor mode with + | Some mode -> filter mode + | None -> failwith "Deflatemod.mode not set") diff --git a/src/extensions/deflatemod.mli b/src/extensions/deflatemod.mli index b7e1ea1e0..7a56f0c26 100644 --- a/src/extensions/deflatemod.mli +++ b/src/extensions/deflatemod.mli @@ -6,8 +6,8 @@ val buffer_size : int Ocsigen_config.Custom.key type filter = [`Type of string option * string option | `Extension of string] -val mode - : [`All_but of filter list | `Only of filter list] +val mode : + [`All_but of filter list | `Only of filter list] Ocsigen_server.Site.Config.key val extension : Ocsigen_server.Site.extension diff --git a/src/extensions/extendconfiguration.ml b/src/extensions/extendconfiguration.ml index 22ebb5f19..8e965a61d 100644 --- a/src/extensions/extendconfiguration.ml +++ b/src/extensions/extendconfiguration.ml @@ -119,21 +119,21 @@ let fun_site usermode _ _ _ _ _ = function | _ :: _ -> bad_config "invalid subtag in option charset" in gen (fun config -> - let config = - match attrs with - | [("default", s)] -> - { config with - Ocsigen_extensions.charset_assoc = - Ocsigen_charset_mime.set_default_charset - config.Ocsigen_extensions.charset_assoc s } - | [] -> config - | _ -> - bad_config - "Only attribute \"default\" is permitted for option \"charset\"" - in - { config with - Ocsigen_extensions.charset_assoc = - aux config.Ocsigen_extensions.charset_assoc exts }) + let config = + match attrs with + | [("default", s)] -> + { config with + Ocsigen_extensions.charset_assoc = + Ocsigen_charset_mime.set_default_charset + config.Ocsigen_extensions.charset_assoc s } + | [] -> config + | _ -> + bad_config + "Only attribute \"default\" is permitted for option \"charset\"" + in + { config with + Ocsigen_extensions.charset_assoc = + aux config.Ocsigen_extensions.charset_assoc exts }) | Xml.Element ("contenttype", attrs, exts) -> let rec aux mime_assoc = function | [] -> mime_assoc @@ -153,21 +153,21 @@ let fun_site usermode _ _ _ _ _ = function | _ :: _ -> bad_config "invalid subtag in option mime" in gen (fun config -> - let config = - match attrs with - | [("default", s)] -> - { config with - Ocsigen_extensions.mime_assoc = - Ocsigen_charset_mime.set_default_mime - config.Ocsigen_extensions.mime_assoc s } - | [] -> config - | _ -> - bad_config - "Only attribute \"default\" is permitted for option \"contenttype\"" - in - { config with - Ocsigen_extensions.mime_assoc = - aux config.Ocsigen_extensions.mime_assoc exts }) + let config = + match attrs with + | [("default", s)] -> + { config with + Ocsigen_extensions.mime_assoc = + Ocsigen_charset_mime.set_default_mime + config.Ocsigen_extensions.mime_assoc s } + | [] -> config + | _ -> + bad_config + "Only attribute \"default\" is permitted for option \"contenttype\"" + in + { config with + Ocsigen_extensions.mime_assoc = + aux config.Ocsigen_extensions.mime_assoc exts }) | Xml.Element ("defaultindex", [], l) -> let rec aux indexes = function | [] -> List.rev indexes @@ -177,7 +177,7 @@ let fun_site usermode _ _ _ _ _ = function "subtags must be of the form ... in option defaultindex" in gen (fun config -> - {config with Ocsigen_extensions.default_directory_index = aux [] l}) + {config with Ocsigen_extensions.default_directory_index = aux [] l}) | Xml.Element (("defaultindex" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Xml.Element ("hidefile", [], l) -> ( @@ -185,10 +185,10 @@ let fun_site usermode _ _ _ _ _ = function try check_regexp_list do_not_serve.Ocsigen_extensions.do_not_serve_regexps; gen (fun config -> - { config with - Ocsigen_extensions.do_not_serve_404 = - Ocsigen_extensions.join_do_not_serve do_not_serve - config.Ocsigen_extensions.do_not_serve_404 }) + { config with + Ocsigen_extensions.do_not_serve_404 = + Ocsigen_extensions.join_do_not_serve do_not_serve + config.Ocsigen_extensions.do_not_serve_404 }) with Bad_regexp r -> Ocsigen_extensions.badconfig "Invalid regexp %s in %s" r "hidefile") | Xml.Element (("hidefile" as s), _, _) -> @@ -198,10 +198,10 @@ let fun_site usermode _ _ _ _ _ = function try check_regexp_list do_not_serve.Ocsigen_extensions.do_not_serve_regexps; gen (fun config -> - { config with - Ocsigen_extensions.do_not_serve_403 = - Ocsigen_extensions.join_do_not_serve do_not_serve - config.Ocsigen_extensions.do_not_serve_403 }) + { config with + Ocsigen_extensions.do_not_serve_403 = + Ocsigen_extensions.join_do_not_serve do_not_serve + config.Ocsigen_extensions.do_not_serve_403 }) with Bad_regexp r -> Ocsigen_extensions.badconfig "Invalid regexp %s in %s" r "forbidfile") | Xml.Element (("forbidfile" as s), _, _) -> diff --git a/src/extensions/outputfilter.ml b/src/extensions/outputfilter.ml index b2a3ceddd..c0f28bd53 100644 --- a/src/extensions/outputfilter.ml +++ b/src/extensions/outputfilter.ml @@ -73,26 +73,26 @@ let parse_config config_elem = [ Configuration.element ~name:"outputfilter" ~attributes: [ Configuration.attribute ~name:"header" (fun s -> - header := Some s) + header := Some s) ; Configuration.attribute ~name:"regexp" (fun s -> - regexp := Some (Ocsigen_lib.Netstring_pcre.regexp s)) + regexp := Some (Ocsigen_lib.Netstring_pcre.regexp s)) ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) ; Configuration.attribute ~name:"replace" (fun s -> - try replace := Some (bool_of_string s) - with Invalid_argument _ -> - badconfig - "Wrong value for attribute replace of : %s. It should be true or false" - s) ] + try replace := Some (bool_of_string s) + with Invalid_argument _ -> + badconfig + "Wrong value for attribute replace of : %s. It should be true or false" + s) ] () ; Configuration.element ~name:"sethttpcode" ~attributes: [ Configuration.attribute ~name:"code" (fun s -> - try - match Cohttp.Code.status_of_code (int_of_string s) with - | #Cohttp.Code.status as status -> code := Some status - | `Code _ -> failwith "Invalid code" - with Failure _ -> - badconfig "Invalid code attribute in ") ] + try + match Cohttp.Code.status_of_code (int_of_string s) with + | #Cohttp.Code.status as status -> code := Some status + | `Code _ -> failwith "Invalid code" + with Failure _ -> + badconfig "Invalid code attribute in ") ] () ] config_elem); match !code with @@ -121,7 +121,7 @@ let mode = Ocsigen_server.Site.Config.key () let extension = Ocsigen_server.Site.create_extension (fun {Ocsigen_server.Site.Config.accessor} -> - match accessor mode with - | Some (`Code c) -> gen_code c - | Some (#header_filter as f) -> gen f - | None -> failwith "Outputfilter.mode not set") + match accessor mode with + | Some (`Code c) -> gen_code c + | Some (#header_filter as f) -> gen f + | None -> failwith "Outputfilter.mode not set") diff --git a/src/extensions/outputfilter.mli b/src/extensions/outputfilter.mli index f0b97c517..ec66a5397 100644 --- a/src/extensions/outputfilter.mli +++ b/src/extensions/outputfilter.mli @@ -1,7 +1,7 @@ -val mode - : [ `Rewrite of Ocsigen_header.Name.t * Re.Pcre.regexp * string - | `Add of Ocsigen_header.Name.t * string * bool option - | `Code of Cohttp.Code.status ] +val mode : + [ `Rewrite of Ocsigen_header.Name.t * Re.Pcre.regexp * string + | `Add of Ocsigen_header.Name.t * string * bool option + | `Code of Cohttp.Code.status ] Ocsigen_server.Site.Config.key val extension : Ocsigen_server.Site.extension diff --git a/src/extensions/redirectmod.ml b/src/extensions/redirectmod.ml index ce93992f2..ab359951c 100644 --- a/src/extensions/redirectmod.ml +++ b/src/extensions/redirectmod.ml @@ -82,16 +82,16 @@ let parse_config config_elem = [ Configuration.element ~name:"redirect" ~attributes: [ Configuration.attribute ~name:"regexp" (fun s -> - regexp := Some ("^" ^ s ^ "$"); - mode := `Maybe) + regexp := Some ("^" ^ s ^ "$"); + mode := `Maybe) ; Configuration.attribute ~name:"fullurl" (fun s -> - regexp := Some s; - mode := `Yes) + regexp := Some s; + mode := `Yes) ; Configuration.attribute ~name:"suburl" (fun s -> - regexp := Some s; - mode := `No) + regexp := Some s; + mode := `No) ; Configuration.attribute ~name:"dest" ~obligatory:true (fun s -> - dest := s) + dest := s) ; Configuration.attribute ~name:"temporary" (function | "temporary" -> temporary := true | _ -> ()) ] @@ -113,6 +113,6 @@ let redirection = Ocsigen_server.Site.Config.key () let extension = Ocsigen_server.Site.create_extension (fun {Ocsigen_server.Site.Config.accessor} -> - match accessor redirection with - | Some redirection -> gen redirection - | None -> failwith "Redirectmod.redirection not set") + match accessor redirection with + | Some redirection -> gen redirection + | None -> failwith "Redirectmod.redirection not set") diff --git a/src/extensions/redirectmod.mli b/src/extensions/redirectmod.mli index 38cb0406b..0b16137f4 100644 --- a/src/extensions/redirectmod.mli +++ b/src/extensions/redirectmod.mli @@ -3,8 +3,8 @@ val section : Lwt_log_core.section type redirection -val create_redirection - : ?full:[`Maybe | `No | `Yes] +val create_redirection : + ?full:[`Maybe | `No | `Yes] -> ?temporary:bool -> regexp:string -> string diff --git a/src/extensions/revproxy.ml b/src/extensions/revproxy.ml index 0936c0bf3..8cfcfe5a5 100644 --- a/src/extensions/revproxy.ml +++ b/src/extensions/revproxy.ml @@ -45,101 +45,101 @@ let gen dir = function -> Lwt.catch (* Is it a redirection? *) - (fun () -> - Lwt_log.ign_info ~section "Is it a redirection?"; - let dest = - let fi full = - Ocsigen_extensions.find_redirection dir.regexp full dir.dest - request_info - in - match dir.full_url with - | Ocsigen_lib.Yes -> fi true - | Ocsigen_lib.No -> fi false - | Ocsigen_lib.Maybe -> ( - try fi false with Ocsigen_extensions.Not_concerned -> fi true) - in - let https, host, port, path = - try - (* FIXME: we do not seem to handle GET + (fun () -> + Lwt_log.ign_info ~section "Is it a redirection?"; + let dest = + let fi full = + Ocsigen_extensions.find_redirection dir.regexp full dir.dest + request_info + in + match dir.full_url with + | Ocsigen_lib.Yes -> fi true + | Ocsigen_lib.No -> fi false + | Ocsigen_lib.Maybe -> ( + try fi false with Ocsigen_extensions.Not_concerned -> fi true) + in + let https, host, port, path = + try + (* FIXME: we do not seem to handle GET parameters. Why? *) - match Ocsigen_lib.Url.parse dest with - | Some https, Some host, port, path, _, _, _ -> - let port = - match port with - | None -> if https then 443 else 80 - | Some p -> p - in - https, host, port, path - | _ -> - raise - (Ocsigen_extensions.Error_in_config_file - ("Revproxy : error in destination URL " ^ dest)) - (*VVV catch only URL-related exceptions? *) - with e -> - raise - (Ocsigen_extensions.Error_in_config_file - ("Revproxy : error in destination URL " ^ dest ^ " - " - ^ Printexc.to_string e)) - in - Lwt_log.ign_info_f ~section "YES! Redirection to http%s://%s:%d/%s" - (if https then "s" else "") - host port path; - Ocsigen_lib.Ip_address.get_inet_addr host >>= fun _inet_addr -> - (* It is now safe to start processing next request. + match Ocsigen_lib.Url.parse dest with + | Some https, Some host, port, path, _, _, _ -> + let port = + match port with + | None -> if https then 443 else 80 + | Some p -> p + in + https, host, port, path + | _ -> + raise + (Ocsigen_extensions.Error_in_config_file + ("Revproxy : error in destination URL " ^ dest)) + (*VVV catch only URL-related exceptions? *) + with e -> + raise + (Ocsigen_extensions.Error_in_config_file + ("Revproxy : error in destination URL " ^ dest ^ " - " + ^ Printexc.to_string e)) + in + Lwt_log.ign_info_f ~section "YES! Redirection to http%s://%s:%d/%s" + (if https then "s" else "") + host port path; + Ocsigen_lib.Ip_address.get_inet_addr host >>= fun _inet_addr -> + (* It is now safe to start processing next request. We are sure that the request won't be taken in disorder, so we return. *) - let do_request () = - let headers = - let h = - Cohttp.Request.headers (Ocsigen_request.to_cohttp request_info) - in - let h = - Ocsigen_request.version request_info - |> Cohttp.Code.string_of_version - |> Cohttp.Header.replace h - Ocsigen_header.Name.(to_string x_forwarded_proto) - in - let h = - let forward = - let address = - Unix.string_of_inet_addr - (Ocsigen_request.address request_info) - in - String.concat ", " - (Ocsigen_request.remote_ip request_info - :: Ocsigen_request.forward_ip request_info - @ [address]) - in - Cohttp.Header.replace h - Ocsigen_header.Name.(to_string x_forwarded_for) - forward - in - Cohttp.Header.remove h Ocsigen_header.Name.(to_string host) - and uri = - let scheme = - if Ocsigen_request.ssl request_info then "https" else "http" - and host = - match - if dir.keephost - then Ocsigen_request.host request_info - else None - with - | Some host -> host - | None -> host - in - Uri.make ~scheme ~host ~port ~path () - and body = Ocsigen_request.body request_info - and meth = Ocsigen_request.meth request_info in - Cohttp_lwt_unix.Client.call ~headers ~body meth uri - in - Lwt.return - @@ Ocsigen_extensions.Ext_found - (fun () -> do_request () >|= Ocsigen_response.of_cohttp)) + let do_request () = + let headers = + let h = + Cohttp.Request.headers (Ocsigen_request.to_cohttp request_info) + in + let h = + Ocsigen_request.version request_info + |> Cohttp.Code.string_of_version + |> Cohttp.Header.replace h + Ocsigen_header.Name.(to_string x_forwarded_proto) + in + let h = + let forward = + let address = + Unix.string_of_inet_addr + (Ocsigen_request.address request_info) + in + String.concat ", " + (Ocsigen_request.remote_ip request_info + :: Ocsigen_request.forward_ip request_info + @ [address]) + in + Cohttp.Header.replace h + Ocsigen_header.Name.(to_string x_forwarded_for) + forward + in + Cohttp.Header.remove h Ocsigen_header.Name.(to_string host) + and uri = + let scheme = + if Ocsigen_request.ssl request_info then "https" else "http" + and host = + match + if dir.keephost + then Ocsigen_request.host request_info + else None + with + | Some host -> host + | None -> host + in + Uri.make ~scheme ~host ~port ~path () + and body = Ocsigen_request.body request_info + and meth = Ocsigen_request.meth request_info in + Cohttp_lwt_unix.Client.call ~headers ~body meth uri + in + Lwt.return + @@ Ocsigen_extensions.Ext_found + (fun () -> do_request () >|= Ocsigen_response.of_cohttp)) (function - | Ocsigen_extensions.Not_concerned -> - Lwt.return (Ocsigen_extensions.Ext_next err) - | e -> Lwt.fail e) + | Ocsigen_extensions.Not_concerned -> + Lwt.return (Ocsigen_extensions.Ext_next err) + | e -> Lwt.fail e) let parse_config config_elem = let regexp = ref None in @@ -154,14 +154,14 @@ let parse_config config_elem = [ Configuration.element ~name:"revproxy" ~attributes: [ Configuration.attribute ~name:"regexp" (fun s -> - regexp := Some s; - full_url := Ocsigen_lib.Yes) + regexp := Some s; + full_url := Ocsigen_lib.Yes) ; Configuration.attribute ~name:"fullurl" (fun s -> - regexp := Some s; - full_url := Ocsigen_lib.Yes) + regexp := Some s; + full_url := Ocsigen_lib.Yes) ; Configuration.attribute ~name:"suburl" (fun s -> - regexp := Some s; - full_url := Ocsigen_lib.No) + regexp := Some s; + full_url := Ocsigen_lib.No) ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) ; Configuration.attribute ~name:"keephost" (function | "keephost" -> keephost := true diff --git a/src/extensions/rewritemod.ml b/src/extensions/rewritemod.ml index 7294afebd..e2553cd61 100644 --- a/src/extensions/rewritemod.ml +++ b/src/extensions/rewritemod.ml @@ -104,9 +104,9 @@ let parse_config element = ; Configuration.attribute ~name:"url" (fun s -> dest := Some s) ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) ; Configuration.attribute ~name:"fullrewrite" (fun s -> - fullrewrite := s = "fullrewrite" || s = "true") + fullrewrite := s = "fullrewrite" || s = "true") ; Configuration.attribute ~name:"continue" (fun s -> - continue := s = "continue" || s = "true") ] + continue := s = "continue" || s = "true") ] () ] element); match !dest with diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml index e6ab585ca..e840a7067 100644 --- a/src/extensions/staticmod.ml +++ b/src/extensions/staticmod.ml @@ -229,43 +229,42 @@ let parse_config userconf _ : Ocsigen_extensions.parse_config_aux = [ Configuration.element ~name:"static" ~attributes: [ Configuration.attribute ~name:"dir" (fun s -> - opt := - {!opt with opt_dir = Some (rewrite_local_path userconf s)}) + opt := + {!opt with opt_dir = Some (rewrite_local_path userconf s)}) ; Configuration.attribute ~name:"regexp" (fun s -> - let s = - try Ocsigen_lib.Netstring_pcre.regexp ("^" ^ s ^ "$") - with Re.Pcre.Parse_error | Re.Pcre.Not_supported -> - badconfig - "Bad regexp \"%s\" in " s - in - opt := {!opt with opt_regexp = Some s}) + let s = + try Ocsigen_lib.Netstring_pcre.regexp ("^" ^ s ^ "$") + with Re.Pcre.Parse_error | Re.Pcre.Not_supported -> + badconfig "Bad regexp \"%s\" in " + s + in + opt := {!opt with opt_regexp = Some s}) ; Configuration.attribute ~name:"code" (fun s -> - let c = - try Ocsigen_lib.Netstring_pcre.regexp ("^" ^ s ^ "$") - with Re.Pcre.Parse_error | Re.Pcre.Not_supported -> - badconfig "Bad regexp \"%s\" in " - s - in - opt := {!opt with opt_code = Some c}) + let c = + try Ocsigen_lib.Netstring_pcre.regexp ("^" ^ s ^ "$") + with Re.Pcre.Parse_error | Re.Pcre.Not_supported -> + badconfig "Bad regexp \"%s\" in " s + in + opt := {!opt with opt_code = Some c}) ; Configuration.attribute ~name:"dest" (fun s -> - let s = - Some (parse_user_dir (rewrite_local_path userconf s)) - in - opt := {!opt with opt_dest = s}) + let s = + Some (parse_user_dir (rewrite_local_path userconf s)) + in + opt := {!opt with opt_dest = s}) ; Configuration.attribute ~name:"root" (fun s -> - let s = Some (parse_user_dir s) in - opt := {!opt with opt_root_checks = s}) + let s = Some (parse_user_dir s) in + opt := {!opt with opt_root_checks = s}) ; Configuration.attribute ~name:"cache" (fun s -> - let duration = - match s with - | "no" -> 0 - | s -> ( - try int_of_string s - with Failure _ -> - badconfig - "Bad integer \"%s\" in " s) - in - opt := {!opt with opt_cache = Some duration}) ] + let duration = + match s with + | "no" -> 0 + | s -> ( + try int_of_string s + with Failure _ -> + badconfig + "Bad integer \"%s\" in " s) + in + opt := {!opt with opt_cache = Some duration}) ] () ] element); gen ~usermode:userconf ?cache:!opt.opt_cache @@ -289,10 +288,10 @@ let root_checks = Ocsigen_server.Site.Config.key () let extension = Ocsigen_server.Site.create_extension (fun {Ocsigen_server.Site.Config.accessor} -> - let kind = - kind (accessor dir) - (Ocsigen_lib.Option.map Pcre.regexp (accessor regexp)) - (Ocsigen_lib.Option.map Pcre.regexp (accessor code)) - (accessor dest) (accessor root_checks) - in - gen ~usermode:None kind) + let kind = + kind (accessor dir) + (Ocsigen_lib.Option.map Pcre.regexp (accessor regexp)) + (Ocsigen_lib.Option.map Pcre.regexp (accessor code)) + (accessor dest) (accessor root_checks) + in + gen ~usermode:None kind) diff --git a/src/extensions/userconf.ml b/src/extensions/userconf.ml index f1e5eee35..472d85a24 100644 --- a/src/extensions/userconf.ml +++ b/src/extensions/userconf.ml @@ -52,41 +52,41 @@ let subresult new_req user_parse_site conf previous_err req req_state = (* XXX why is rs above never used ?? *) Lwt.catch (fun () -> - user_parse_site conf cookies_to_set - (Ocsigen_extensions.Req_not_found (previous_err, new_req)) - >>= fun (answer, cookies) -> - (* If the request is not satisfied by userconf, the + user_parse_site conf cookies_to_set + (Ocsigen_extensions.Req_not_found (previous_err, new_req)) + >>= fun (answer, cookies) -> + (* If the request is not satisfied by userconf, the changes in configuration (in request_config) are preserved for the remainder of the enclosing (in the Ext_continue and Ext_found_continue cases below) *) - let rec aux ((answer, cts) as r) = - match answer with - | Ocsigen_extensions.Ext_sub_result sr -> - (* XXX Are these the good cookies ?? *) - sr cookies_to_set req_state >>= aux - | Ocsigen_extensions.Ext_continue_with - ({Ocsigen_extensions.request_config; _}, cookies, err) -> - Lwt.return - ( Ocsigen_extensions.Ext_continue_with - ( {req with Ocsigen_extensions.request_config} - , cookies - , err ) - , cts ) - | Ocsigen_extensions.Ext_found_continue_with r -> - (* We keep config information outside userconf! *) - Lwt.return - ( Ocsigen_extensions.Ext_found_continue_with - (fun () -> - r () - >|= fun (r, {Ocsigen_extensions.request_config; _}) -> - r, {req with Ocsigen_extensions.request_config}) - , cts ) - | _ -> Lwt.return r - in - aux (answer, cookies)) + let rec aux ((answer, cts) as r) = + match answer with + | Ocsigen_extensions.Ext_sub_result sr -> + (* XXX Are these the good cookies ?? *) + sr cookies_to_set req_state >>= aux + | Ocsigen_extensions.Ext_continue_with + ({Ocsigen_extensions.request_config; _}, cookies, err) -> + Lwt.return + ( Ocsigen_extensions.Ext_continue_with + ( {req with Ocsigen_extensions.request_config} + , cookies + , err ) + , cts ) + | Ocsigen_extensions.Ext_found_continue_with r -> + (* We keep config information outside userconf! *) + Lwt.return + ( Ocsigen_extensions.Ext_found_continue_with + (fun () -> + r () + >|= fun (r, {Ocsigen_extensions.request_config; _}) -> + r, {req with Ocsigen_extensions.request_config}) + , cts ) + | _ -> Lwt.return r + in + aux (answer, cookies)) (fun e -> - handle_parsing_error req e >>= fun answer -> - Lwt.return (answer, Ocsigen_cookie_map.empty))) + handle_parsing_error req e >>= fun answer -> + Lwt.return (answer, Ocsigen_cookie_map.empty))) let conf_to_xml conf = try [Xml.parse_file conf] with @@ -128,8 +128,7 @@ let gen hostpattern sitepath (regexp, conf, url, prefix, localpath) = function (* Inside userconf, we create a new virtual site starting after [prefix], and use a request modified accordingly*) let user_parse_site = - Ocsigen_extensions.make_parse_config - (sitepath @ [prefix]) + Ocsigen_extensions.make_parse_config (sitepath @ [prefix]) user_parse_host and req = { req with @@ -159,19 +158,21 @@ let parse_config _ hostpattern _ path _ _ config_elem = ~attributes: [ Configuration.attribute ~name:"regexp" ~obligatory:true (fun s -> - let s = Ocsigen_lib.Netstring_pcre.regexp ("^" ^ s ^ "$") in - regexp := Some s) + let s = + Ocsigen_lib.Netstring_pcre.regexp ("^" ^ s ^ "$") + in + regexp := Some s) ; Configuration.attribute ~name:"conf" ~obligatory:true (fun s -> - let s = Ocsigen_extensions.parse_user_dir s in - conf := Some s) + let s = Ocsigen_extensions.parse_user_dir s in + conf := Some s) ; Configuration.attribute ~name:"url" ~obligatory:true (fun s -> - url := Some s) + url := Some s) ; Configuration.attribute ~name:"prefix" ~obligatory:true (fun s -> prefix := Some s) ; Configuration.attribute ~name:"localpath" ~obligatory:true (fun s -> - let s = Ocsigen_extensions.parse_user_dir s in - localpath := Some s) ] + let s = Ocsigen_extensions.parse_user_dir s in + localpath := Some s) ] () ] config_elem); let info = diff --git a/src/http/ocsigen_charset_mime.mli b/src/http/ocsigen_charset_mime.mli index 88be29a97..5d3c63ae3 100644 --- a/src/http/ocsigen_charset_mime.mli +++ b/src/http/ocsigen_charset_mime.mli @@ -53,8 +53,8 @@ val update_charset_ext : charset_assoc -> extension -> charset -> charset_assoc val update_charset_file : charset_assoc -> filename -> charset -> charset_assoc -val update_charset_regexp - : charset_assoc +val update_charset_regexp : + charset_assoc -> Re.Pcre.regexp -> charset -> charset_assoc diff --git a/src/http/ocsigen_cookie_map.ml b/src/http/ocsigen_cookie_map.ml index 6bd40653c..8f030ebac 100644 --- a/src/http/ocsigen_cookie_map.ml +++ b/src/http/ocsigen_cookie_map.ml @@ -17,10 +17,10 @@ *) module Map_path = Map.Make (struct - type t = string list + type t = string list - let compare = compare -end) + let compare = compare + end) module Map_inner = Map.Make (String) diff --git a/src/http/ocsigen_cookie_map.mli b/src/http/ocsigen_cookie_map.mli index f7c05f9e3..0ecde492b 100644 --- a/src/http/ocsigen_cookie_map.mli +++ b/src/http/ocsigen_cookie_map.mli @@ -51,15 +51,15 @@ val remove : path:Ocsigen_lib_base.Url_base.path -> string -> t -> t (** Polymorphic versions of [add] and [remove] to use when we don't need to OUnset (client-side) *) module Poly : sig - val add - : path:Ocsigen_lib_base.Url_base.path + val add : + path:Ocsigen_lib_base.Url_base.path -> string -> 'a -> 'a Map_inner.t Map_path.t -> 'a Map_inner.t Map_path.t - val remove - : path:Ocsigen_lib_base.Url_base.path + val remove : + path:Ocsigen_lib_base.Url_base.path -> string -> 'a Map_inner.t Map_path.t -> 'a Map_inner.t Map_path.t diff --git a/src/http/ocsigen_header.ml b/src/http/ocsigen_header.ml index caf6313d3..f7f452491 100644 --- a/src/http/ocsigen_header.ml +++ b/src/http/ocsigen_header.ml @@ -152,11 +152,11 @@ module Content_type = struct try List.find (fun content_type -> - let f = function - | (Some a, Some b), _, _ -> a ^ "/" ^ b = content_type - | _ -> false - in - List.exists f accept) + let f = function + | (Some a, Some b), _, _ -> a ^ "/" ^ b = content_type + | _ -> false + in + List.exists f accept) (default :: alt) with Not_found -> default end diff --git a/src/server/ocsigen_cohttp.ml b/src/server/ocsigen_cohttp.ml index f75a592a9..71618b673 100644 --- a/src/server/ocsigen_cohttp.ml +++ b/src/server/ocsigen_cohttp.ml @@ -88,15 +88,15 @@ let make_cookies_header path exp name c _secure = let make_cookies_headers path t hds = Ocsigen_cookie_map.Map_inner.fold (fun name c h -> - let open Ocsigen_cookie_map in - let exp, v, secure = - match c with - | OUnset -> Some 0., "", false - | OSet (t, v, secure) -> t, v, secure - in - Cohttp.Header.add h - Ocsigen_header.Name.(to_string set_cookie) - (make_cookies_header path exp name v secure)) + let open Ocsigen_cookie_map in + let exp, v, secure = + match c with + | OUnset -> Some 0., "", false + | OSet (t, v, secure) -> t, v, secure + in + Cohttp.Header.add h + Ocsigen_header.Name.(to_string set_cookie) + (make_cookies_header path exp name v secure)) t hds let handler ~ssl ~address ~port ~connector (flow, conn) request body = @@ -154,57 +154,57 @@ let handler ~ssl ~address ~port ~connector (flow, conn) request body = in Lwt.finalize (fun () -> - Ocsigen_messages.accesslog - (Format.sprintf "connection for %s from %s (%s)%s: %s" - (match Ocsigen_request.host request with - | None -> "" - | Some h -> h) - (Ocsigen_request.remote_ip request) - (Option.value ~default:"" - (Ocsigen_request.header request Ocsigen_header.Name.user_agent)) - (Option.fold ~none:"" - ~some:(fun s -> " X-Forwarded-For: " ^ s) - (Ocsigen_request.header request - Ocsigen_header.Name.x_forwarded_for)) - (Uri.path (Ocsigen_request.uri request))); - Lwt.catch - (fun () -> - connector request >>= fun response -> - let response, body = Ocsigen_response.to_cohttp response - and cookies = Ocsigen_response.cookies response in - let response = - let headers = - Cohttp.Header.add_unless_exists - (Cohttp.Header.add_unless_exists - (Ocsigen_cookie_map.Map_path.fold make_cookies_headers - cookies - (Cohttp.Response.headers response)) - "server" Ocsigen_config.server_name) - "date" - (Ocsigen_lib.Date.to_string (Unix.time ())) - in - {response with Cohttp.Response.headers} - in - Lwt.return (response, body)) - (function - | Ocsigen_is_dir fun_request -> + Ocsigen_messages.accesslog + (Format.sprintf "connection for %s from %s (%s)%s: %s" + (match Ocsigen_request.host request with + | None -> "" + | Some h -> h) + (Ocsigen_request.remote_ip request) + (Option.value ~default:"" + (Ocsigen_request.header request Ocsigen_header.Name.user_agent)) + (Option.fold ~none:"" + ~some:(fun s -> " X-Forwarded-For: " ^ s) + (Ocsigen_request.header request + Ocsigen_header.Name.x_forwarded_for)) + (Uri.path (Ocsigen_request.uri request))); + Lwt.catch + (fun () -> + connector request >>= fun response -> + let response, body = Ocsigen_response.to_cohttp response + and cookies = Ocsigen_response.cookies response in + let response = let headers = - fun_request request |> Uri.to_string - |> Cohttp.Header.init_with "location" - and status = `Moved_permanently in - Cohttp_lwt_unix.Server.respond ~headers ~status ~body:`Empty () - | exn -> handle_error exn)) + Cohttp.Header.add_unless_exists + (Cohttp.Header.add_unless_exists + (Ocsigen_cookie_map.Map_path.fold make_cookies_headers + cookies + (Cohttp.Response.headers response)) + "server" Ocsigen_config.server_name) + "date" + (Ocsigen_lib.Date.to_string (Unix.time ())) + in + {response with Cohttp.Response.headers} + in + Lwt.return (response, body)) + (function + | Ocsigen_is_dir fun_request -> + let headers = + fun_request request |> Uri.to_string + |> Cohttp.Header.init_with "location" + and status = `Moved_permanently in + Cohttp_lwt_unix.Server.respond ~headers ~status ~body:`Empty () + | exn -> handle_error exn)) (fun () -> - if !filenames <> [] - then - List.iter - (fun a -> - try Unix.unlink a - with Unix.Unix_error _ as exn -> - Lwt_log.ign_warning_f ~section ~exn "Error while removing file %s" - a) - !filenames; - Lwt.return_unit) + if !filenames <> [] + then + List.iter + (fun a -> + try Unix.unlink a + with Unix.Unix_error _ as exn -> + Lwt_log.ign_warning_f ~section ~exn + "Error while removing file %s" a) + !filenames; + Lwt.return_unit) let conn_closed (_flow, conn) = try diff --git a/src/server/ocsigen_cohttp.mli b/src/server/ocsigen_cohttp.mli index 91223a333..29d31b7c0 100644 --- a/src/server/ocsigen_cohttp.mli +++ b/src/server/ocsigen_cohttp.mli @@ -18,8 +18,8 @@ val get_number_of_connected : unit -> int val shutdown : float option -> unit (** Shutdown main loop of server *) -val service - : ?ssl:string * string * (bool -> string) option +val service : + ?ssl:string * string * (bool -> string) option -> address:Ocsigen_config.socket_type -> port:int -> connector:(Ocsigen_request.t -> Ocsigen_response.t Lwt.t) diff --git a/src/server/ocsigen_command.ml b/src/server/ocsigen_command.ml index 04f3d0bbe..fbe38f8b3 100644 --- a/src/server/ocsigen_command.ml +++ b/src/server/ocsigen_command.ml @@ -30,9 +30,9 @@ let register_command_function, get_command_function = Lwt.catch (fun () -> old_command_function ?prefix s c) (function - | Unknown_command -> - if prefix = prefix' then f s c else Lwt.fail Unknown_command - | e -> Lwt.fail e)) + | Unknown_command -> + if prefix = prefix' then f s c else Lwt.fail Unknown_command + | e -> Lwt.fail e)) , fun () -> !command_function ) let () = diff --git a/src/server/ocsigen_command.mli b/src/server/ocsigen_command.mli index da51fa572..a4af753c7 100644 --- a/src/server/ocsigen_command.mli +++ b/src/server/ocsigen_command.mli @@ -22,8 +22,8 @@ exception Unknown_command -val register_command_function - : ?prefix:string +val register_command_function : + ?prefix:string -> (string -> string list -> unit Lwt.t) -> unit (** Use a prefix for all your commands when you want to create @@ -39,8 +39,8 @@ val register_command_function (**/**) -val get_command_function - : unit +val get_command_function : + unit -> ?prefix:string -> string -> string list diff --git a/src/server/ocsigen_config.ml b/src/server/ocsigen_config.ml index f99d880e8..db0994240 100644 --- a/src/server/ocsigen_config.ml +++ b/src/server/ocsigen_config.ml @@ -60,9 +60,7 @@ let minthreads = ref 10 let maxthreads = ref 30 let max_number_of_connections = ref 350 let silent_client_timeout = ref 30 (* without speaking during sending frame *) - let silent_server_timeout = ref 30 (* without speaking during sending frame *) - let filebuffersize = ref 8192 let maxrequestbodysize = ref (Some (Int64.of_int 8000000)) let maxrequestbodysizeinmemory = ref 8192 diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml index 00fa318e5..4ac19f1e3 100644 --- a/src/server/ocsigen_extensions.ml +++ b/src/server/ocsigen_extensions.ml @@ -133,7 +133,7 @@ type config_info = ; mime_assoc : Ocsigen_charset_mime.mime_assoc ; charset_assoc : Ocsigen_charset_mime.charset_assoc ; default_directory_index : string list - (** Default name to use as index file + (** Default name to use as index file when a directory is requested. Use [None] if no index should be tried. The various indexes are @@ -144,11 +144,11 @@ type config_info = according to [list_directry_content] *) ; list_directory_content : bool - (** Should the list of files in a directory be + (** Should the list of files in a directory be displayed if there is no index in this directory ? *) ; follow_symlinks : [`No | `Owner_match | `Always] - (** Should symlinks be + (** Should symlinks be followed when accessign a local file? *) ; do_not_serve_404 : do_not_serve @@ -187,7 +187,7 @@ exception Ocsigen_is_dir = Ocsigen_cohttp.Ocsigen_is_dir type answer = | Ext_do_nothing (** I don't want to do anything *) | Ext_found of (unit -> Ocsigen_response.t Lwt.t) - (** "OK stop! I will take the page. You can start the following + (** "OK stop! I will take the page. You can start the following request of the same pipelined connection. Here is the function to generate the page". The extension must return Ext_found as soon as possible when it is sure it is safe to start next @@ -197,25 +197,25 @@ type answer = requests to another server before returning Ext_found, to ensure that all requests are done in same order). *) | Ext_found_stop of (unit -> Ocsigen_response.t Lwt.t) - (** Found but do not try next extensions *) + (** Found but do not try next extensions *) | Ext_next of Cohttp.Code.status - (** Page not found. Try next extension. The status is usually + (** Page not found. Try next extension. The status is usually `Not_found, but may be for example `Forbidden (403) if you want to try another extension afterwards. Same as Ext_continue_with but does not change the request. *) | Ext_stop_site of (Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Error. Do not try next extension, but try next site. *) + (** Error. Do not try next extension, but try next site. *) | Ext_stop_host of (Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Error. + (** Error. Do not try next extension, do not try next site, but try next host. *) | Ext_stop_all of (Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Error. Do not try next extension, + (** Error. Do not try next extension, do not try next site, do not try next host. *) | Ext_continue_with of (request * Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Used to modify the request before giving it to next extension. + (** Used to modify the request before giving it to next extension. The extension returns the request (possibly modified) and a set of cookies if it wants to set or cookies ({!Ocsigen_cookie_set.empty} for no cookies). You must add @@ -225,7 +225,7 @@ type answer = usually equal to the one received from preceding extension (but you may want to modify it). *) | Ext_retry_with of request * Ocsigen_cookie_map.t - (** Used to retry all the extensions with a new request. The + (** Used to retry all the extensions with a new request. The extension returns the request (possibly modified) and a set of cookies if it wants to set or cookies ({!Ocsigen_cookie_set.empty} for no cookies). You must add @@ -233,15 +233,15 @@ type answer = subsequent extensions, for example using {!Ocsigen_http_frame.compute_new_ri_cookies}. *) | Ext_sub_result of extension_composite - (** Used if your extension want to define option that may contain + (** Used if your extension want to define option that may contain other options from other extensions. In that case, while parsing the configuration file, call the parsing function (of type [parse_fun]), that will return something of type [extension_composite]. *) | Ext_found_continue_with of (unit -> (Ocsigen_response.t * request) Lwt.t) - (** Same as [Ext_found] but may modify the request. *) + (** Same as [Ext_found] but may modify the request. *) | Ext_found_continue_with' of (Ocsigen_response.t * request) - (** Same as [Ext_found_continue_with] but does not allow to delay + (** Same as [Ext_found_continue_with] but does not allow to delay the computation of the page. You should probably not use it, but for output filters. *) @@ -452,15 +452,15 @@ let site_ext ext_of_children charset path cookies_to_set = function (fun () path -> Url.string_of_url_path ~encode:true path) path (fun () oldri -> - Url.string_of_url_path ~encode:true - (Ocsigen_request.path oldri.request_info)) + Url.string_of_url_path ~encode:true + (Ocsigen_request.path oldri.request_info)) oldri; Lwt.return (Ext_next e, cookies_to_set) | Some sub_path -> ( Lwt_log.ign_info_f ~section "site found: url \"%a\" matches \"%a\"." (fun () oldri -> - Url.string_of_url_path ~encode:true - (Ocsigen_request.path oldri.request_info)) + Url.string_of_url_path ~encode:true + (Ocsigen_request.path oldri.request_info)) oldri (fun () path -> Url.string_of_url_path ~encode:true path) path; @@ -524,8 +524,11 @@ let _extension_void_fun_site : parse_config = let register, parse_config_item, get_init_exn_handler = let ref_fun_site = ref default_parse_config in - ( (fun ?fun_site ?end_init ?(exn_handler = raise) ?(respect_pipeline = false) - () -> + ( (fun ?fun_site + ?end_init + ?(exn_handler = raise) + ?(respect_pipeline = false) + () -> if respect_pipeline then Ocsigen_config.set_respect_pipeline (); (match fun_site with | None -> () @@ -563,10 +566,10 @@ let register ~name ?fun_site ?end_init ?init_fun ?exn_handler ?respect_pipeline () = Ocsigen_loader.set_module_init_function name (fun () -> - (match init_fun with - | None -> default_parse_extension name (get_config ()) - | Some f -> f (get_config ())); - register ?fun_site ?end_init ?exn_handler ?respect_pipeline ()) + (match init_fun with + | None -> default_parse_extension name (get_config ()) + | Some f -> f (get_config ())); + register ?fun_site ?end_init ?exn_handler ?respect_pipeline ()) module Configuration = struct type attribute' = @@ -587,8 +590,7 @@ module Configuration = struct and element = string * element' let element ~name ?(obligatory = false) ?(init = ignore) ?(elements = []) - ?(attributes = []) ?pcdata ?other_elements ?other_attributes () - : element + ?(attributes = []) ?pcdata ?other_elements ?other_attributes () : element = ( name , { obligatory @@ -605,10 +607,10 @@ module Configuration = struct let ignore_blank_pcdata ~in_tag str = String.iter (fun c -> - if not (List.mem c [' '; '\n'; '\r'; '\t']) - then - raise - (Error_in_user_config_file ("Non-blank PCDATA in tag " ^ in_tag))) + if not (List.mem c [' '; '\n'; '\r'; '\t']) + then + raise + (Error_in_user_config_file ("Non-blank PCDATA in tag " ^ in_tag))) str let refuse_pcdata ~in_tag _ = diff --git a/src/server/ocsigen_extensions.mli b/src/server/ocsigen_extensions.mli index 144ece092..db1e336ba 100644 --- a/src/server/ocsigen_extensions.mli +++ b/src/server/ocsigen_extensions.mli @@ -58,8 +58,8 @@ type virtual_hosts = (string * Re.Pcre.regexp * int option) list val hash_virtual_hosts : virtual_hosts -> int val equal_virtual_hosts : virtual_hosts -> virtual_hosts -> bool -val host_match - : virtual_hosts:virtual_hosts +val host_match : + virtual_hosts:virtual_hosts -> host:string option -> port:int -> bool @@ -91,16 +91,16 @@ type config_info = ; mime_assoc : Ocsigen_charset_mime.mime_assoc ; charset_assoc : Ocsigen_charset_mime.charset_assoc ; default_directory_index : string list - (** Default name to use as index file when a directory is requested. + (** Default name to use as index file when a directory is requested. Use [None] if no index should be tried. The various indexes are tried in the given order. If no index is specified, or the index does not exists, the content of the directory might be listed, according to [list_directory_content] *) ; list_directory_content : bool - (** Should the list of files in a directory be displayed if there is + (** Should the list of files in a directory be displayed if there is no index in this directory ? *) ; follow_symlinks : [`No | `Owner_match | `Always] - (** Should symlinks be followed when accessing a local file? *) + (** Should symlinks be followed when accessing a local file? *) ; do_not_serve_404 : do_not_serve ; do_not_serve_403 : do_not_serve ; uploaddir : string option @@ -116,7 +116,7 @@ exception Ocsigen_is_dir of (Ocsigen_request.t -> Uri.t) type answer = | Ext_do_nothing (** I don't want to do anything *) | Ext_found of (unit -> Ocsigen_response.t Lwt.t) - (** "OK stop! I will take the page. You can start the following + (** "OK stop! I will take the page. You can start the following request of the same pipelined connection. Here is the function to generate the page". The extension must return Ext_found as soon as possible when it is sure it is safe to start next @@ -126,25 +126,25 @@ type answer = requests to another server before returning Ext_found, to ensure that all requests are done in same order). *) | Ext_found_stop of (unit -> Ocsigen_response.t Lwt.t) - (** Found but do not try next extensions *) + (** Found but do not try next extensions *) | Ext_next of Cohttp.Code.status - (** Page not found. Try next extension. The status is usually + (** Page not found. Try next extension. The status is usually `Not_found, but may be for example `Forbidden (403) if you want to try another extension afterwards. Same as Ext_continue_with but does not change the request. *) | Ext_stop_site of (Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Error. Do not try next extension, but try next site. *) + (** Error. Do not try next extension, but try next site. *) | Ext_stop_host of (Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Error. + (** Error. Do not try next extension, do not try next site, but try next host. *) | Ext_stop_all of (Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Error. Do not try next extension, + (** Error. Do not try next extension, do not try next site, do not try next host. *) | Ext_continue_with of (request * Ocsigen_cookie_map.t * Cohttp.Code.status) - (** Used to modify the request before giving it to next extension. + (** Used to modify the request before giving it to next extension. The extension returns the request (possibly modified) and a set of cookies if it wants to set or cookies ({!Ocsigen_cookie_set.empty} for no cookies). You must add @@ -154,7 +154,7 @@ type answer = usually equal to the one received from preceding extension (but you may want to modify it). *) | Ext_retry_with of request * Ocsigen_cookie_map.t - (** Used to retry all the extensions with a new request. The + (** Used to retry all the extensions with a new request. The extension returns the request (possibly modified) and a set of cookies if it wants to set or cookies ({!Ocsigen_cookie_set.empty} for no cookies). You must add @@ -162,15 +162,15 @@ type answer = subsequent extensions, for example using {!Ocsigen_http_frame.compute_new_ri_cookies}. *) | Ext_sub_result of extension_composite - (** Used if your extension want to define option that may contain + (** Used if your extension want to define option that may contain other options from other extensions. In that case, while parsing the configuration file, call the parsing function (of type [parse_fun]), that will return something of type [extension_composite]. *) | Ext_found_continue_with of (unit -> (Ocsigen_response.t * request) Lwt.t) - (** Same as [Ext_found] but may modify the request. *) + (** Same as [Ext_found] but may modify the request. *) | Ext_found_continue_with' of (Ocsigen_response.t * request) - (** Same as [Ext_found_continue_with] but does not allow to delay + (** Same as [Ext_found_continue_with] but does not allow to delay the computation of the page. You should probably not use it, but for output filters. *) @@ -235,8 +235,8 @@ type parse_config = and parse_config_aux = Ocsigen_lib.Url.path -> parse_host -> parse_fun -> Xml.xml -> extension -val register - : name:string +val register : + name:string -> ?fun_site:parse_config -> ?end_init:(unit -> unit) -> ?init_fun:(Xml.xml list -> unit) @@ -281,8 +281,8 @@ module Configuration : sig type attribute (** Specification of a XML attribute. *) - val element - : name:string + val element : + name:string -> ?obligatory:bool -> ?init:(unit -> unit) -> ?elements:element list @@ -304,8 +304,8 @@ module Configuration : sig @param other_attributes Optional function to be applied on the unspecfied attributes *) - val attribute - : name:string + val attribute : + name:string -> ?obligatory:bool -> (string -> unit) -> attribute @@ -315,8 +315,8 @@ module Configuration : sig @param f Function to be applied on the value string of the attribute *) - val process_element - : in_tag:string + val process_element : + in_tag:string -> elements:element list -> ?pcdata:(string -> unit) -> ?other_elements: @@ -333,8 +333,8 @@ module Configuration : sig and no function [other_elements] (resp. other_attributes) is provided *) - val process_elements - : in_tag:string + val process_elements : + in_tag:string -> elements:element list -> ?pcdata:(string -> unit) -> ?other_elements: @@ -386,8 +386,8 @@ val replace_user_dir : Re.Pcre.regexp -> ud_string -> string -> string exception Not_concerned (** {3 Regular expressions for redirections} *) -val find_redirection - : Re.Pcre.regexp +val find_redirection : + Re.Pcre.regexp -> bool -> string -> Ocsigen_request.t @@ -400,8 +400,8 @@ val compose : extension list -> extension_composite val make_parse_config : Ocsigen_lib.Url.path -> parse_config_aux -> parse_fun val parse_config_item : parse_config -val site_ext - : extension_composite +val site_ext : + extension_composite -> Ocsigen_charset_mime.charset option -> Ocsigen_lib.Url.path -> extension @@ -409,8 +409,8 @@ val site_ext val set_hosts : (virtual_hosts * config_info * extension_composite) list -> unit val get_hosts : unit -> (virtual_hosts * config_info * extension_composite) list -val compute_result - : ?previous_cookies:Ocsigen_cookie_map.t +val compute_result : + ?previous_cookies:Ocsigen_cookie_map.t -> Ocsigen_request.t -> Ocsigen_response.t Lwt.t (** Compute the answer to be sent to the client, by trying all diff --git a/src/server/ocsigen_local_files.mli b/src/server/ocsigen_local_files.mli index 1a687b042..649a77a32 100644 --- a/src/server/ocsigen_local_files.mli +++ b/src/server/ocsigen_local_files.mli @@ -31,7 +31,7 @@ exception NotReadableDirectory (** The file is a directory which we should not display *) (* -(** Default options: + (** Default options: - never follow symlinks - use "index.html" as default index - do not list the content of directories @@ -44,8 +44,8 @@ val default_options : options instead of foo *) type resolved = RFile of string | RDir of string -val resolve - : ?no_check_for:string +val resolve : + ?no_check_for:string -> request:Ocsigen_extensions.request -> filename:string -> unit diff --git a/src/server/ocsigen_messages.ml b/src/server/ocsigen_messages.ml index c49fdc8ee..d1bee2fb4 100644 --- a/src/server/ocsigen_messages.ml +++ b/src/server/ocsigen_messages.ml @@ -49,12 +49,12 @@ let open_files ?(user = Ocsigen_config.get_user ()) Lwt.catch (fun () -> Lwt_log.file ~file_name:path ()) (function - | Unix.Unix_error (error, _, _) -> - Lwt.fail - (Ocsigen_config.Config_file_error - (Printf.sprintf "can't open log file %s: %s" path - (Unix.error_message error))) - | exn -> Lwt.fail exn) + | Unix.Unix_error (error, _, _) -> + Lwt.fail + (Ocsigen_config.Config_file_error + (Printf.sprintf "can't open log file %s: %s" path + (Unix.error_message error))) + | exn -> Lwt.fail exn) in open_log access_file >>= fun acc -> access_logger := acc; @@ -64,17 +64,17 @@ let open_files ?(user = Ocsigen_config.get_user ()) Lwt_log.default := Lwt_log.broadcast [ Lwt_log.dispatch (fun _sect lev -> - match lev with - | Lwt_log.Error | Lwt_log.Fatal -> err - | Lwt_log.Warning -> war - | _ -> Lwt_log.null) + match lev with + | Lwt_log.Error | Lwt_log.Fatal -> err + | Lwt_log.Warning -> war + | _ -> Lwt_log.null) ; Lwt_log.dispatch (fun _sect lev -> - if Ocsigen_config.get_silent () - then Lwt_log.null - else - match lev with - | Lwt_log.Warning | Lwt_log.Error | Lwt_log.Fatal -> stderr - | _ -> stdout) ]; + if Ocsigen_config.get_silent () + then Lwt_log.null + else + match lev with + | Lwt_log.Warning | Lwt_log.Error | Lwt_log.Fatal -> stderr + | _ -> stdout) ]; let gid = match group with | None -> Unix.getgid () @@ -95,15 +95,15 @@ let open_files ?(user = Ocsigen_config.get_user ()) in Lwt.catch (fun () -> - Lwt_unix.chown (full_path access_file) uid gid >>= fun () -> - Lwt_unix.chown (full_path warning_file) uid gid >>= fun () -> - Lwt_unix.chown (full_path error_file) uid gid) + Lwt_unix.chown (full_path access_file) uid gid >>= fun () -> + Lwt_unix.chown (full_path warning_file) uid gid >>= fun () -> + Lwt_unix.chown (full_path error_file) uid gid) (fun e -> - match e with - | Unix.Unix_error (Unix.EPERM, _, _) -> - (* to allow for symlinks to /dev/null *) - Lwt.return_unit - | _ -> Lwt.fail e) + match e with + | Unix.Unix_error (Unix.EPERM, _, _) -> + (* to allow for symlinks to /dev/null *) + Lwt.return_unit + | _ -> Lwt.fail e) (****) diff --git a/src/server/ocsigen_messages.mli b/src/server/ocsigen_messages.mli index dc9c76a58..9a88baaf2 100644 --- a/src/server/ocsigen_messages.mli +++ b/src/server/ocsigen_messages.mli @@ -46,8 +46,8 @@ val error_log_path : unit -> string (**/**) -val open_files - : ?user:string option +val open_files : + ?user:string option -> ?group:string option -> unit -> unit Lwt.t diff --git a/src/server/ocsigen_multipart.ml b/src/server/ocsigen_multipart.ml index ac65cd431..119d26883 100644 --- a/src/server/ocsigen_multipart.ml +++ b/src/server/ocsigen_multipart.ml @@ -62,22 +62,22 @@ let read_header ?downcase ?unfold ?strip s = let rec find_end_of_header s = Lwt.catch (fun () -> - let b = Ocsigen_stream.current_buffer s in - (* Maybe the header is empty. In this case, there is an empty + let b = Ocsigen_stream.current_buffer s in + (* Maybe the header is empty. In this case, there is an empty line right at the beginning *) - match S.string_match empty_line_re b 0 with - | Some r -> Lwt.return (s, match_end r) - | None -> - (* Search for an empty line *) - Lwt.return - (s, match_end (snd (S.search_forward end_of_header_re b 0)))) + match S.string_match empty_line_re b 0 with + | Some r -> Lwt.return (s, match_end r) + | None -> + (* Search for an empty line *) + Lwt.return + (s, match_end (snd (S.search_forward end_of_header_re b 0)))) (function - | Not_found -> ( - Ocsigen_stream.enlarge_stream s >>= function - | Ocsigen_stream.Finished _ -> - Lwt.fail Ocsigen_stream.Stream_too_small - | Ocsigen_stream.Cont _ as s -> find_end_of_header s) - | e -> Lwt.fail e) + | Not_found -> ( + Ocsigen_stream.enlarge_stream s >>= function + | Ocsigen_stream.Finished _ -> + Lwt.fail Ocsigen_stream.Stream_too_small + | Ocsigen_stream.Cont _ as s -> find_end_of_header s) + | e -> Lwt.fail e) in find_end_of_header s >>= fun (s, end_pos) -> let b = Ocsigen_stream.current_buffer s in @@ -99,13 +99,13 @@ let search_end_of_line s k = (* Search LF beginning at position k *) Lwt.catch (fun () -> - search_window s lf_re k >>= fun (s, x) -> Lwt.return (s, match_end x)) + search_window s lf_re k >>= fun (s, x) -> Lwt.return (s, match_end x)) (function - | Not_found -> - Lwt.fail - (Multipart_error - "read_multipart_body: MIME boundary without line end") - | e -> Lwt.fail e) + | Not_found -> + Lwt.fail + (Multipart_error + "read_multipart_body: MIME boundary without line end") + | e -> Lwt.fail e) let search_first_boundary ~boundary s = (* Search boundary per regexp; return the position of the @@ -172,18 +172,18 @@ let read_multipart_body ~boundary ~decode_part s = (* Look for the first boundary *) Lwt.catch (fun () -> - search_first_boundary ~boundary s >>= fun (s, k_eob) -> - search_end_of_line s k_eob >>= fun (s, k_eol) -> - let uses_crlf = (Ocsigen_stream.current_buffer s).[k_eol - 2] = '\r' in - (* Printf.printf "k_eol=%d\n" k_eol; *) - Ocsigen_stream.skip s (Int64.of_int k_eol) >>= fun s -> - (* Begin with first part: *) - parse_parts ~boundary ~decode_part s uses_crlf) + search_first_boundary ~boundary s >>= fun (s, k_eob) -> + search_end_of_line s k_eob >>= fun (s, k_eol) -> + let uses_crlf = (Ocsigen_stream.current_buffer s).[k_eol - 2] = '\r' in + (* Printf.printf "k_eol=%d\n" k_eol; *) + Ocsigen_stream.skip s (Int64.of_int k_eol) >>= fun s -> + (* Begin with first part: *) + parse_parts ~boundary ~decode_part s uses_crlf) (function - | Not_found -> - (* No boundary at all, empty body *) - Lwt.return [] - | e -> Lwt.fail e) + | Not_found -> + (* No boundary at all, empty body *) + Lwt.return [] + | e -> Lwt.fail e) let empty_stream = Ocsigen_stream.get (Ocsigen_stream.make (fun () -> Ocsigen_stream.empty None)) @@ -208,21 +208,21 @@ let decode_part ~max_size ~create ~add ~stop stream = in Lwt.catch (fun () -> - while_stream Int64.zero s >>= fun (size, s) -> - stop size p >>= fun r -> Lwt.return (r, s)) + while_stream Int64.zero s >>= fun (size, s) -> + stop size p >>= fun r -> Lwt.return (r, s)) (fun error -> stop Int64.zero p >>= fun _ -> Lwt.fail error) let scan_multipart_body_from_stream ?max_size ~boundary ~create ~add ~stop s = let decode_part = decode_part ~max_size ~create ~add ~stop in Lwt.catch (fun () -> - (* read the multipart body: *) - Ocsigen_stream.next s >>= fun s -> - read_multipart_body ~boundary ~decode_part s >>= fun _ -> Lwt.return ()) + (* read the multipart body: *) + Ocsigen_stream.next s >>= fun s -> + read_multipart_body ~boundary ~decode_part s >>= fun _ -> Lwt.return ()) (function - | Ocsigen_stream.Stream_too_small -> - Lwt.fail Ocsigen_lib.Ocsigen_Bad_Request - | e -> Lwt.fail e) + | Ocsigen_stream.Stream_too_small -> + Lwt.fail Ocsigen_lib.Ocsigen_Bad_Request + | e -> Lwt.fail e) let get_boundary ctparams = List.assoc "boundary" ctparams @@ -265,24 +265,24 @@ type post_data = (string * string) list * (string * file_info) list let post_params_form_urlencoded body_gen _ _ = Lwt.catch (fun () -> - let body = Ocsigen_stream.get body_gen in - (* BY, adapted from a previous comment. Should this stream be + let body = Ocsigen_stream.get body_gen in + (* BY, adapted from a previous comment. Should this stream be consumed in case of error? *) - Ocsigen_stream.string_of_stream - (Ocsigen_config.get_maxrequestbodysizeinmemory ()) - body - >>= fun r -> - let r = Ocsigen_lib.Url.fixup_url_string r in - let l = - Uri.query_of_encoded r - |> List.map (fun (s, l) -> List.map (fun v -> s, v) l) - |> List.concat - in - Lwt.return (l, [])) + Ocsigen_stream.string_of_stream + (Ocsigen_config.get_maxrequestbodysizeinmemory ()) + body + >>= fun r -> + let r = Ocsigen_lib.Url.fixup_url_string r in + let l = + Uri.query_of_encoded r + |> List.map (fun (s, l) -> List.map (fun v -> s, v) l) + |> List.concat + in + Lwt.return (l, [])) (function - | Ocsigen_stream.String_too_large -> - Lwt.fail Ocsigen_lib.Input_is_too_large - | e -> Lwt.fail e) + | Ocsigen_stream.String_too_large -> + Lwt.fail Ocsigen_lib.Input_is_too_large + | e -> Lwt.fail e) let post_params_multipart_form_data ctparams body_gen upload_dir max_size = (* Same question here, should this stream be consumed after an diff --git a/src/server/ocsigen_multipart.mli b/src/server/ocsigen_multipart.mli index e4cbfddae..fcdda8575 100644 --- a/src/server/ocsigen_multipart.mli +++ b/src/server/ocsigen_multipart.mli @@ -1,8 +1,8 @@ val section : Lwt_log_core.section (** use Lwt_log.Section.set_level in order to debug *) -val scan_multipart_body_from_stream - : ?max_size:Int64.t +val scan_multipart_body_from_stream : + ?max_size:Int64.t -> boundary:string -> create:((string * string) list -> 'a) -> add:('a -> string -> unit Lwt.t) @@ -20,8 +20,8 @@ type file_info = type post_data = (string * string) list * (string * file_info) list -val post_params - : content_type:content_type +val post_params : + content_type:content_type -> Cohttp_lwt.Body.t -> (string option -> Int64.t option -> post_data Lwt.t) option diff --git a/src/server/ocsigen_request.ml b/src/server/ocsigen_request.ml index 8d5d00c0d..a66c3c670 100644 --- a/src/server/ocsigen_request.ml +++ b/src/server/ocsigen_request.ml @@ -29,7 +29,7 @@ let unflatten_get_params l = M.bindings (List.fold_left (fun acc (id, v) -> - M.add id (try v :: M.find id acc with Not_found -> [v]) acc) + M.add id (try v :: M.find id acc with Not_found -> [v]) acc) M.empty l) let flatten_get_params l = @@ -226,10 +226,10 @@ let parse_cookies s = try List.fold_left (fun beg a -> - try - let n, v = Ocsigen_lib.String.sep '=' a in - Ocsigen_cookie_map.Map_inner.add n v beg - with Not_found -> beg) + try + let n, v = Ocsigen_lib.String.sep '=' a in + Ocsigen_cookie_map.Map_inner.add n v beg + with Not_found -> beg) Ocsigen_cookie_map.Map_inner.empty splitted with _ -> Ocsigen_cookie_map.Map_inner.empty diff --git a/src/server/ocsigen_request.mli b/src/server/ocsigen_request.mli index 2a2c73ee6..308bd6d24 100644 --- a/src/server/ocsigen_request.mli +++ b/src/server/ocsigen_request.mli @@ -9,8 +9,8 @@ type file_info = Ocsigen_multipart.file_info = type post_data = (string * string) list * (string * file_info) list -val make - : ?forward_ip:string list +val make : + ?forward_ip:string list -> ?sub_path:string -> ?original_full_path:string -> ?request_cache:Polytables.t @@ -25,8 +25,8 @@ val make -> Cohttp.Request.t -> t -val update - : ?ssl:bool +val update : + ?ssl:bool -> ?forward_ip:string list -> ?remote_ip:string -> ?sub_path:string @@ -62,14 +62,14 @@ val header_multi : t -> Ocsigen_header.Name.t -> string list val add_header : t -> Ocsigen_header.Name.t -> string -> t val cookies : t -> string Ocsigen_cookie_map.Map_inner.t -val files - : t +val files : + t -> string option -> Int64.t option -> (string * file_info) list Lwt.t option -val post_params - : t +val post_params : + t -> string option -> Int64.t option -> (string * string) list Lwt.t option diff --git a/src/server/ocsigen_response.ml b/src/server/ocsigen_response.ml index 65b6bd8fe..c95f6edba 100644 --- a/src/server/ocsigen_response.ml +++ b/src/server/ocsigen_response.ml @@ -30,8 +30,7 @@ let status {a_response = {Cohttp.Response.status; _}; _} = let set_status ({a_response; _} as a) status = { a with a_response = - { a_response with - Cohttp.Response.status = (status :> Cohttp.Code.status_code) } } + {a_response with Cohttp.Response.status :> Cohttp.Code.status_code} } let cookies {a_cookies; _} = a_cookies @@ -80,7 +79,9 @@ let replace_headers ({a_response; _} as a) l = let headers = List.fold_left (fun headers (id, content) -> - Cohttp.Header.replace headers (Ocsigen_header.Name.to_string id) content) + Cohttp.Header.replace headers + (Ocsigen_header.Name.to_string id) + content) (Cohttp.Response.headers a_response) l in diff --git a/src/server/ocsigen_response.mli b/src/server/ocsigen_response.mli index 46b2701d4..1fd00bff1 100644 --- a/src/server/ocsigen_response.mli +++ b/src/server/ocsigen_response.mli @@ -1,20 +1,20 @@ type t -val make - : ?body:Cohttp_lwt.Body.t +val make : + ?body:Cohttp_lwt.Body.t -> ?cookies:Ocsigen_cookie_map.t -> Cohttp.Response.t -> t -val update - : ?response:Cohttp.Response.t +val update : + ?response:Cohttp.Response.t -> ?body:Cohttp_lwt.Body.t -> ?cookies:Ocsigen_cookie_map.t -> t -> t -val of_cohttp - : ?cookies:Ocsigen_cookie_map.t +val of_cohttp : + ?cookies:Ocsigen_cookie_map.t -> Cohttp.Response.t * Cohttp_lwt.Body.t -> t diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml index bf35eb965..59f5c3391 100644 --- a/src/server/ocsigen_server.ml +++ b/src/server/ocsigen_server.ml @@ -33,18 +33,18 @@ let section = Lwt_log.Section.make "ocsigen:main" (* Initialize exception handler for Lwt timeouts: *) let _ = Lwt_timeout.set_exn_handler (fun e -> - Lwt_log.ign_error ~section ~exn:e "Uncaught Exception after lwt timeout") + Lwt_log.ign_error ~section ~exn:e "Uncaught Exception after lwt timeout") let _warn sockaddr s = Lwt_log.ign_warning_f ~section "While talking to %a:%s" (fun () sockaddr -> - Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) + Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) sockaddr s let _dbg sockaddr s = Lwt_log.ign_info_f ~section "While talking to %a:%s" (fun () sockaddr -> - Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) + Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr)) sockaddr s (* fatal errors messages *) @@ -256,11 +256,11 @@ module Site = struct Ocsigen_extensions.set_hosts (List.fold_left f [] !l) module Config = Make_config_nested (struct - type nonrec t = t + type nonrec t = t - let get {s_config_map; _} = s_config_map - let do_ ({s_config_map; _} as vh) f = vh.s_config_map <- f s_config_map - end) + let get {s_config_map; _} = s_config_map + let do_ ({s_config_map; _} as vh) f = vh.s_config_map <- f s_config_map + end) end let start ?config () = @@ -360,8 +360,8 @@ let start ?config () = (* I change the user for the process *) (try (if current_uid = 0 - then - match user with None -> () | Some user -> Unix.initgroups user gid); + then + match user with None -> () | Some user -> Unix.initgroups user gid); Unix.setgid gid; Unix.setuid uid with (Unix.Unix_error _ | Failure _) as e -> Lwt_log.ign_error ~section "Error: Wrong user or group"; @@ -375,7 +375,7 @@ let start ?config () = "maxthreads should be greater than minthreads"); ignore (Lwt_preemptive.init minthreads maxthreads (fun s -> - Lwt_log.ign_error ~section s)); + Lwt_log.ign_error ~section s)); (Lwt.async_exception_hook := fun e -> (* replace the default "exit 2" behaviour *) @@ -417,24 +417,24 @@ let start ?config () = Ocsigen_messages.warning ("Command received: " ^ s); Lwt.catch (fun () -> - let prefix, c = - match Ocsigen_lib.String.split ~multisep:true ' ' s with - | [] -> raise Ocsigen_command.Unknown_command - | a :: l -> ( - try - let aa, ab = Ocsigen_lib.String.sep ':' a in - Some aa, ab :: l - with Not_found -> None, a :: l) - in - Ocsigen_command.get_command_function () ?prefix s c) + let prefix, c = + match Ocsigen_lib.String.split ~multisep:true ' ' s with + | [] -> raise Ocsigen_command.Unknown_command + | a :: l -> ( + try + let aa, ab = Ocsigen_lib.String.sep ':' a in + Some aa, ab :: l + with Not_found -> None, a :: l) + in + Ocsigen_command.get_command_function () ?prefix s c) (function - | Ocsigen_command.Unknown_command -> - Lwt_log.ign_warning ~section "Unknown command"; - Lwt.return () - | e -> - Lwt_log.ign_error ~section ~exn:e - "Uncaught Exception after command"; - Lwt.fail e) + | Ocsigen_command.Unknown_command -> + Lwt_log.ign_warning ~section "Unknown command"; + Lwt.return () + | e -> + Lwt_log.ign_error ~section ~exn:e + "Uncaught Exception after command"; + Lwt.fail e) >>= f in ignore (f ()); @@ -442,22 +442,22 @@ let start ?config () = @@ Lwt.join (List.map (fun (address, port) -> - Ocsigen_cohttp.service ~address ~port - ~connector:extensions_connector ()) + Ocsigen_cohttp.service ~address ~port + ~connector:extensions_connector ()) connection @ (List.map (fun (address, port, (crt, key)) -> - Ocsigen_cohttp.service - ~ssl:(crt, key, Some (ask_for_passwd [address, port])) - ~address ~port ~connector:extensions_connector ())) + Ocsigen_cohttp.service + ~ssl:(crt, key, Some (ask_for_passwd [address, port])) + ~address ~port ~connector:extensions_connector ())) ssl_connection) (* Ocsigen_messages.warning "Ocsigen has been launched (initialisations ok)"; fst (Lwt.wait ()) - *) + *) in (* - let set_passwd_if_needed (ssl, ports, sslports) = + let set_passwd_if_needed (ssl, ports, sslports) = if sslports <> [] then match ssl with @@ -471,7 +471,7 @@ let start ?config () = Ssl.set_password_callback !Server.ssl_context (ask_for_passwd sslports); Ssl.use_certificate !Server.ssl_context c k in - *) + *) let write_pid pid = match Ocsigen_config.get_pidfile () with | None -> () @@ -494,7 +494,7 @@ let start ?config () = then run h else ( Ocsigen_messages.console (fun () -> - "Process " ^ string_of_int pid ^ " detached"); + "Process " ^ string_of_int pid ^ " detached"); write_pid pid) else ( write_pid (Unix.getpid ()); diff --git a/src/server/ocsigen_server.mli b/src/server/ocsigen_server.mli index 1fb367934..0df134a6f 100644 --- a/src/server/ocsigen_server.mli +++ b/src/server/ocsigen_server.mli @@ -44,8 +44,8 @@ end module Site : sig type t - val create - : ?config_info:Ocsigen_extensions.config_info + val create : + ?config_info:Ocsigen_extensions.config_info -> ?id:[`Attach of t * Ocsigen_lib.Url.path | `Host of string * int option] -> ?charset:Ocsigen_charset_mime.charset -> ?auto_load_extensions:bool @@ -56,20 +56,20 @@ module Site : sig type extension - val create_extension - : (Config.accessor -> Ocsigen_extensions.extension) + val create_extension : + (Config.accessor -> Ocsigen_extensions.extension) -> extension val register : t -> extension -> unit (**/**) - val create_extension_intrusive - : (Ocsigen_extensions.virtual_hosts - -> Ocsigen_extensions.config_info - -> Ocsigen_lib.Url.path - -> Config.accessor - -> Ocsigen_extensions.extension) + val create_extension_intrusive : + (Ocsigen_extensions.virtual_hosts + -> Ocsigen_extensions.config_info + -> Ocsigen_lib.Url.path + -> Config.accessor + -> Ocsigen_extensions.extension) -> extension (** Lower-level interface for creating extensions that gives the extension more info. To be avoided. Currently used by Eliom. *)