diff --git a/.ocamlformat b/.ocamlformat index a8e766218..f7747f88a 100644 --- a/.ocamlformat +++ b/.ocamlformat @@ -1,4 +1,4 @@ -version=0.26.1 +version=0.26.2 break-cases = fit break-collection-expressions = fit-or-vertical break-fun-decl = wrap diff --git a/Makefile b/Makefile index 7905407e8..02b5bec4c 100644 --- a/Makefile +++ b/Makefile @@ -1,9 +1,9 @@ -include Makefile.options include Makefile.config +include Makefile.options ### Building -.PHONY: default all +.PHONY: default all doc default all: build .PHONY: build @@ -74,13 +74,6 @@ install.files: @echo @echo "## Run \"make doc\" and \"make install.doc\" to build and install the ocamldoc." @echo INSTALL_CAN_PUT_PERMISSIONS: ${INSTALL_CAN_PUT_PERMISSIONS} - ## Command pipe - $(INSTALL) -m ${INSTALL_MOD_755} -d $(dir $(TEMPROOT)$(COMMANDPIPE)) - [ -p $(TEMPROOT)$(COMMANDPIPE) ] || \ - { mkfifo -m ${INSTALL_MOD_660} $(TEMPROOT)$(COMMANDPIPE); \ - if [ "${INSTALL_CAN_PUT_PERMISSIONS}" = yes ]; \ - then $(CHOWN) -R $(OCSIGENUSER):"$(OCSIGENGROUP)" $(TEMPROOT)$(COMMANDPIPE); \ - fi; } ## Configuration files $(INSTALL) -m ${INSTALL_MOD_755} -d $(TEMPROOT)$(CONFIGDIR)/conf.d ${INSTALL} -m ${INSTALL_MOD_644} ocsigenserver.conf.sample $(TEMPROOT)$(CONFIGDIR)/ diff --git a/Makefile.options b/Makefile.options index c980ba2b3..a89718d54 100644 --- a/Makefile.options +++ b/Makefile.options @@ -23,7 +23,7 @@ INCS= -I ${BLD}/server/.ocsigenserver.objs/byte \ ## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable ## but also to generate src/baselib/ocsigen_config_static.ml -SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,lwt_log,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix,hmap +SERVER_PACKAGE := lwt_ssl,bytes,lwt.unix,lwt_log,ipaddr,findlib,cryptokit,re,str,xml-light,dynlink,cohttp-lwt-unix LIBS := -package ${SERVER_PACKAGE} ${INCS} diff --git a/VERSION b/VERSION index 61fcc8735..09b254e90 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -5.1.2 +6.0.0 diff --git a/doc/Makefile b/doc/Makefile index 1747a63a5..e1582d798 100644 --- a/doc/Makefile +++ b/doc/Makefile @@ -17,6 +17,7 @@ DOC := baselib/ocsigen_cache.mli \ http/ocsigen_header.mli \ \ server/ocsigen_config.mli \ + server/ocsigen_command.mli \ server/ocsigen_request.mli \ server/ocsigen_response.mli \ server/ocsigen_messages.mli \ @@ -26,10 +27,17 @@ DOC := baselib/ocsigen_cache.mli \ server/ocsigen_local_files.mli \ server/ocsigen_server.mli -PLUGINS_DOC := extensions/accesscontrol.mli extensions/authbasic.mli \ - extensions/outputfilter.mli \ - extensions/redirectmod.mli extensions/staticmod.mli \ - extensions/deflatemod/deflatemod.mli +PLUGINS_DOC := extensions/accesscontrol.mli \ + extensions/authbasic.mli \ + extensions/outputfilter.mli \ + extensions/extendconfiguration.mli \ + extensions/redirectmod.mli \ + extensions/rewritemod.mli \ + extensions/userconf.mli \ + extensions/revproxy.mli \ + extensions/staticmod.mli \ + extensions/deflatemod.mli \ + extensions/cors.mli all: doc wikidoc diff --git a/doc/indexdoc b/doc/indexdoc index 6576304c0..013bd4bc5 100644 --- a/doc/indexdoc +++ b/doc/indexdoc @@ -1,4 +1,21 @@ {1 Ocsigen server - API reference} +{!modules: +Ocsigen_server +} +{2 Extensions} +{!modules: +Staticmod +Extendconfiguration +Accesscontrol +Authbasic +Deflatemod +Redirectmod +Revproxy +Rewritemod +Outputfilter +Userconf +Cors +} {2 Persistent data, writing in the logs, configuration file extension, polymorphic tables} {!modules: @@ -14,10 +31,8 @@ Ocsigen_config {!modules: Ocsigen_extensions Ocsigen_local_files -Ocsigen_headers +Ocsigen_header Ocsigen_stream -Ocsigen_comet -Authbasic } {2 Indexes} diff --git a/ocsigenserver.opam b/ocsigenserver.opam index 31ef5067a..26aca5d71 100644 --- a/ocsigenserver.opam +++ b/ocsigenserver.opam @@ -1,6 +1,6 @@ opam-version: "2.0" name: "ocsigenserver" -version: "5.1.2" +version: "6.0.0" maintainer: "dev@ocsigen.org" synopsis: "A full-featured and extensible Web server" description: "Ocsigen Server implements most features of the HTTP protocol, and has a very powerful extension mechanism that makes it very easy to plug your own OCaml modules for generating pages. Many extensions are already implemented, like a reverse proxy, content compression, access control, authentication, etc." @@ -59,7 +59,6 @@ depends: [ "ipaddr" {>= "2.1"} "cohttp-lwt-unix" {>= "5.0.0" & < "6.0.0~"} "conduit-lwt-unix" {>= "2.0.0"} - "hmap" "xml-light" "camlzip" ] diff --git a/src/Makefile b/src/Makefile index ed2cd35f4..f28b91bd9 100644 --- a/src/Makefile +++ b/src/Makefile @@ -12,8 +12,6 @@ confs: ../ocsigenserver.conf.sample ../local/etc/ocsigenserver.conf cat $< \ | sed s%_LOGDIR_%$(LOGDIR)%g \ | sed s%_DATADIR_%$(DATADIR)%g \ - | sed s%_OCSIGENUSER_%$(OCSIGENUSER)%g \ - | sed s%_OCSIGENGROUP_%"$(OCSIGENGROUP)"%g \ | sed s%_COMMANDPIPE_%$(COMMANDPIPE)%g \ | sed s%_MIMEFILE_%$(CONFIGDIR)/mime.types%g \ | sed s%_METADIR_%$(LIBDIR)%g \ @@ -30,8 +28,6 @@ confs: ../ocsigenserver.conf.sample ../local/etc/ocsigenserver.conf | sed s%80\%8080\%g \ | sed s%_LOGDIR_%$(SRC)/local/var/log%g \ | sed s%_DATADIR_%$(SRC)/local/var/lib%g \ - | sed s%\_OCSIGENUSER_\%%g \ - | sed s%\_OCSIGENGROUP_\%%g \ | sed s%_COMMANDPIPE_%$(SRC)/local/var/run/ocsigenserver_command%g \ | sed s%_MIMEFILE_%$(SRC)/src/files/mime.types%g \ | sed s%_METADIR_%${LIBDIR}\"/\>\\ Some [f] + | Some old -> Some (f :: old) + in + init_functions := M.update name update !init_functions; if get_init_on_load () then f () let init_module pre post force name = let f = - try M.find name !init_functions - with Not_found as e -> raise (Dynlink_error ("named module " ^ name, e)) + try + let l = List.rev @@ M.find name !init_functions in + fun () -> List.iter (fun f -> f ()) l + with Not_found -> + Lwt_log.ign_info_f ~section "No init function for named module %s." name; + fun () -> () in - try - if force - then ( - pre (); - Lwt_log.ign_info_f ~section - "Initializing %s (will be initialized every time)" name; - try f (); post () with e -> post (); raise e) - else if not (isloaded name) - then ( - pre (); - Lwt_log.ign_info_f ~section "Initializing module %s " name; - (try f (); post () with e -> post (); raise e); - addloaded name) - else Lwt_log.ign_info_f ~section "Module %s already initialized." name - with e -> raise (Dynlink_error (name, e)) + if force + then ( + pre (); + Lwt_log.ign_info_f ~section + "Initializing %s (will be initialized every time)" name; + try f (); post () with e -> post (); raise e) + else if not (isloaded name) + then ( + pre (); + Lwt_log.ign_info_f ~section "Initializing module %s " name; + (try f (); post () with e -> post (); raise e); + addloaded name) + else Lwt_log.ign_info_f ~section "Module %s already initialized." name (************************************************************************) (* Manipulating Findlib's search path *) diff --git a/src/baselib/ocsigen_loader.mli b/src/baselib/ocsigen_loader.mli index 976c6c843..1d4a7bf0a 100644 --- a/src/baselib/ocsigen_loader.mli +++ b/src/baselib/ocsigen_loader.mli @@ -58,9 +58,15 @@ val loadfiles : (unit -> unit) -> (unit -> unit) -> bool -> string list -> unit but the last one, and [loadfile pre post force] for the last one (if any). *) +val add_module_init_function : string -> (unit -> unit) -> unit +(** [add_module_init_function name f] adds function [f] + to the initialisation functions to be run + when [init_module name] is called. *) + val set_module_init_function : string -> (unit -> unit) -> unit (** [set_module_init_function name f] registers the function [f], which will - be used to initialize the module when [init_module name] is called. *) + be used to initialize the module when [init_module name] is called. + Will replace the prvious value. *) val init_module : (unit -> unit) -> (unit -> unit) -> bool -> string -> unit (** [init_module pre post force name] runs the init function for the module diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml index b6797eae8..a6641f82a 100644 --- a/src/extensions/accesscontrol.ml +++ b/src/extensions/accesscontrol.ml @@ -25,105 +25,135 @@ open Xml let section = Lwt_log.Section.make "ocsigen:ext:access-control" +type condition = Ocsigen_request.t -> bool + +let ip s = + let prefix = + try Ipaddr.Prefix.of_string_exn s + with Ipaddr.Parse_error _ -> ( + try + let ip = Ipaddr.of_string_exn s in + Ipaddr.Prefix.of_addr ip + with _ -> + Ocsigen_extensions.badconfig "Bad ip/netmask [%s] in condition" s) + in + fun ri -> + let r = Ipaddr.Prefix.mem (Ocsigen_request.remote_ip_parsed ri) prefix in + if r + then + Lwt_log.ign_info_f ~section "IP: %a matches %s" + (fun () -> Ocsigen_request.remote_ip) + ri s + else + Lwt_log.ign_info_f ~section "IP: %a does not match %s" + (fun () -> Ocsigen_request.remote_ip) + ri s; + r + +let port port ri = + let r = Ocsigen_request.port ri = port in + if r + then Lwt_log.ign_info_f ~section "PORT = %d: true" port + else + Lwt_log.ign_info_f ~section "PORT = %d: false (it is %a)" port + (fun () ri -> string_of_int (Ocsigen_request.port ri)) + ri; + r + +let ssl ri = + let r = Ocsigen_request.ssl ri in + if r + then Lwt_log.ign_info ~section "SSL: true" + else Lwt_log.ign_info ~section "SSL: false"; + r + +let header ~name ~regexp:re = + let regexp = + try Netstring_pcre.regexp ("^" ^ re ^ "$") + with Failure _ -> + Ocsigen_extensions.badconfig + "Bad regular expression [%s] in
condition" re + in + fun ri -> + 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 re; + r) + (Ocsigen_request.header_multi ri (Ocsigen_header.Name.of_string name)) + in + if not r + then Lwt_log.ign_info_f "HEADER: header %s does not match %S" name re; + r + +let method_ m ri = + let m' = Ocsigen_request.meth ri in + let s = Cohttp.Code.string_of_method m in + let s' = Cohttp.Code.string_of_method m' in + let r = m = m' in + if r + then Lwt_log.ign_info_f ~section "METHOD: %s matches %s" s' s + else Lwt_log.ign_info_f ~section "METHOD: %s does not match %s" s' s; + r + +let protocol v ri = + let v' = Ocsigen_request.version ri in + let s = Cohttp.Code.string_of_version v in + let s' = Cohttp.Code.string_of_version v' in + let r = v = v' in + if r + then Lwt_log.ign_info_f ~section "PROTOCOL: %s matches %s" s' s + else Lwt_log.ign_info_f ~section "PROTOCOL: %s does not match %s" s' s; + r + +let path ~regexp:s = + let regexp = + try Netstring_pcre.regexp ("^" ^ s ^ "$") + with Failure _ -> + Ocsigen_extensions.badconfig + "Bad regular expression [%s] in condition" s + in + fun ri -> + let sps = Ocsigen_request.sub_path_string ri in + let r = Netstring_pcre.string_match regexp sps 0 <> None in + if r + then Lwt_log.ign_info_f ~section "PATH: \"%s\" matches %S" sps s + else Lwt_log.ign_info_f ~section "PATH: \"%s\" does not match %S" sps s; + r + +let and_ sub ri = List.for_all (fun cond -> cond ri) sub +let or_ sub ri = List.exists (fun cond -> cond ri) sub +let not_ sub ri = not (sub ri) + let rec parse_condition = function - | Element ("ip", [("value", s)], []) -> - let prefix = - try Ipaddr.Prefix.of_string_exn s - with Ipaddr.Parse_error _ -> ( - try - let ip = Ipaddr.of_string_exn s in - Ipaddr.Prefix.of_addr ip - with _ -> - Ocsigen_extensions.badconfig "Bad ip/netmask [%s] in condition" - s) - in - fun ri -> - let r = - Ipaddr.Prefix.mem (Ocsigen_request.remote_ip_parsed ri) prefix - in - if r - then - Lwt_log.ign_info_f ~section "IP: %a matches %s" - (fun () -> Ocsigen_request.remote_ip) - ri s - else - Lwt_log.ign_info_f ~section "IP: %a does not match %s" - (fun () -> Ocsigen_request.remote_ip) - ri s; - r + | Element ("ip", [("value", s)], []) -> ip s | Element (("ip" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Element ("port", [("value", s)], []) -> - let port = + let p = try int_of_string s with Failure _ -> Ocsigen_extensions.badconfig "Bad port [%s] in condition" s in - fun ri -> - let r = Ocsigen_request.port ri = port in - if r - then Lwt_log.ign_info_f ~section "PORT: %d accepted" port - else - Lwt_log.ign_info_f ~section "PORT: %a not accepted (%d expected)" - (fun () ri -> string_of_int (Ocsigen_request.port ri)) - ri port; - r + port p | Element (("port" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s - | Element ("ssl", [], []) -> - fun ri -> - let r = Ocsigen_request.ssl ri in - if r - then Lwt_log.ign_info ~section "SSL: accepted" - else Lwt_log.ign_info ~section "SSL: not accepted"; - r + | Element ("ssl", [], []) -> ssl | Element (("ssl" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s - | Element ("header", [("name", name); ("regexp", reg)], []) -> - let regexp = - try Netstring_pcre.regexp ("^" ^ reg ^ "$") - with Failure _ -> - Ocsigen_extensions.badconfig - "Bad regular expression [%s] in
condition" reg - in - fun ri -> - 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) - (Ocsigen_request.header_multi ri - (Ocsigen_header.Name.of_string name)) - in - if not r - then Lwt_log.ign_info_f "HEADER: header %s does not match %S" name reg; - r + | Element ("header", [("name", name); ("regexp", regexp)], []) -> + header ~name ~regexp | Element (("header" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Element ("method", [("value", s)], []) -> - fun ri -> - let m = Cohttp.Code.method_of_string s - and m' = Ocsigen_request.meth ri in - let s' = Cohttp.Code.string_of_method m' in - let r = m = m' in - if r - then Lwt_log.ign_info_f ~section "METHOD: %s matches %s" s' s - else Lwt_log.ign_info_f ~section "METHOD: %s does not match %s" s' s; - r + let m = Cohttp.Code.method_of_string s in + method_ m | Element (("method" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Element ("protocol", [("value", s)], []) -> - fun ri -> - let v = Cohttp.Code.version_of_string s - and v' = Ocsigen_request.version ri in - let s' = Cohttp.Code.string_of_version v' in - let r = v = v' in - if r - then Lwt_log.ign_info_f ~section "PROTOCOL: %s matches %s" s' s - else Lwt_log.ign_info_f ~section "PROTOCOL: %s does not match %s" s' s; - r + let v = Cohttp.Code.version_of_string s in + protocol v | Element (("protocol" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Element ("path", [("regexp", s)], []) -> @@ -164,6 +194,80 @@ let rec parse_condition = function let comma_space_regexp = Netstring_pcre.regexp "\ *,\ *" +let allow_forward_for_handler ?(check_equal_ip = false) () = + let apply ({Ocsigen_extensions.request_info; _} as request) code = + Lwt_log.ign_info ~section "Allowed proxy"; + let request = + let header = + Ocsigen_request.header request_info Ocsigen_header.Name.x_forwarded_for + in + match header with + | Some header -> ( + match Ocsigen_lib.Netstring_pcre.split comma_space_regexp header with + | original_ip :: proxies -> + let last_proxy = List.last proxies in + let proxy_ip = Ipaddr.of_string_exn last_proxy in + let equal_ip = + proxy_ip = Ocsigen_request.remote_ip_parsed request_info + in + if equal_ip || not check_equal_ip + then + { request with + Ocsigen_extensions.request_info = + Ocsigen_request.update ~forward_ip:proxies + ~remote_ip:original_ip request_info } + else ( + (* the announced ip of the proxy is not its real ip *) + Lwt_log.ign_warning_f ~section + "X-Forwarded-For: host ip (%s) does not match the header (%s)" + (Ocsigen_request.remote_ip request_info) + header; + request) + | _ -> + Lwt_log.ign_info_f ~section "Malformed X-Forwarded-For field: %s" + header; + request) + | None -> request + in + Lwt.return + (Ocsigen_extensions.Ext_continue_with + (request, Ocsigen_cookie_map.empty, code)) + in + function + | Ocsigen_extensions.Req_found (request, resp) -> + apply request (Ocsigen_response.status resp) + | Ocsigen_extensions.Req_not_found (code, request) -> apply request code + +let allow_forward_proto_handler = + let apply ({Ocsigen_extensions.request_info; _} as request) code = + Lwt_log.ign_info ~section "Allowed proxy for ssl"; + let request_info = + let header = + Ocsigen_request.header request_info + Ocsigen_header.Name.x_forwarded_proto + in + match header with + | Some header -> ( + match String.lowercase_ascii header with + | "http" -> Ocsigen_request.update ~ssl:false request_info + | "https" -> Ocsigen_request.update ~ssl:true request_info + | _ -> + Lwt_log.ign_info_f ~section "Malformed X-Forwarded-Proto field: %s" + header; + request_info) + | None -> request_info + in + Lwt.return + (Ocsigen_extensions.Ext_continue_with + ( {request with Ocsigen_extensions.request_info} + , Ocsigen_cookie_map.empty + , code )) + in + function + | Ocsigen_extensions.Req_found (request, resp) -> + apply request (Ocsigen_response.status resp) + | Ocsigen_extensions.Req_not_found (code, request) -> apply request code + let parse_config parse_fun = function | Element ("if", [], sub) -> ( let condition, sub = @@ -259,7 +363,7 @@ let parse_config parse_fun = function Lwt.return (Ocsigen_extensions.Ext_sub_result ext)) | Element ("ifnotfound", [("code", s)], sub) -> ( let ext = parse_fun sub in - let r = Netstring_pcre.regexp ("^" ^ s ^ "$") in + let re = Netstring_pcre.regexp ("^" ^ s ^ "$") in function | Ocsigen_extensions.Req_found (_, r) -> Lwt.return (Ocsigen_extensions.Ext_found (fun () -> Lwt.return r)) @@ -267,104 +371,109 @@ let parse_config parse_fun = function if let err = string_of_int Cohttp.Code.(code_of_status (err :> status_code)) in - Netstring_pcre.string_match r err 0 <> None + Netstring_pcre.string_match re err 0 <> None then Lwt.return (Ocsigen_extensions.Ext_sub_result ext) else Lwt.return (Ocsigen_extensions.Ext_next err)) | Element (("ifnotfound" as s), _, _) -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" s - | Element ("allow-forward-for", param, _) -> ( - let apply ({Ocsigen_extensions.request_info; _} as request) code = - Lwt_log.ign_info ~section "Allowed proxy"; - let request = - let header = - Ocsigen_request.header request_info - Ocsigen_header.Name.x_forwarded_for - in - match header with - | Some header -> ( - match - Ocsigen_lib.Netstring_pcre.split comma_space_regexp header - with - | original_ip :: proxies -> - let last_proxy = List.last proxies in - let proxy_ip = Ipaddr.of_string_exn last_proxy in - let equal_ip = - proxy_ip = Ocsigen_request.remote_ip_parsed request_info - in - let need_equal_ip = - match param with - | [] -> false - | [("check-equal-ip", b)] -> ( - try bool_of_string b - with Invalid_argument _ -> - Ocsigen_extensions.badconfig - "Bad syntax for argument of tag allow-forward-for") - | _ -> - Ocsigen_extensions.badconfig - "Bad syntax for argument of tag allow-forward-for" - in - if equal_ip || not need_equal_ip - then - { request with - Ocsigen_extensions.request_info = - Ocsigen_request.update ~forward_ip:proxies - ~remote_ip:original_ip request_info } - else ( - (* the announced ip of the proxy is not its real ip *) - Lwt_log.ign_warning_f ~section - "X-Forwarded-For: host ip (%s) does not match the header (%s)" - (Ocsigen_request.remote_ip request_info) - header; - request) - | _ -> - Lwt_log.ign_info_f ~section - "Malformed X-Forwarded-For field: %s" header; - request) - | None -> request - in - Lwt.return - (Ocsigen_extensions.Ext_continue_with - (request, Ocsigen_cookie_map.empty, code)) + | Element ("allow-forward-for", param, _) -> + let check_equal_ip = + match param with + | [] -> false + | [("check-equal-ip", b)] -> ( + try bool_of_string b + with Invalid_argument _ -> + Ocsigen_extensions.badconfig + "Bad syntax for argument of tag allow-forward-for") + | _ -> + Ocsigen_extensions.badconfig + "Bad syntax for argument of tag allow-forward-for" in - function - | Ocsigen_extensions.Req_found (request, resp) -> - apply request (Ocsigen_response.status resp) - | Ocsigen_extensions.Req_not_found (code, request) -> apply request code) - | Element ("allow-forward-proto", _, _) -> ( - let apply ({Ocsigen_extensions.request_info; _} as request) code = - Lwt_log.ign_info ~section "Allowed proxy for ssl"; - let request_info = - let header = - Ocsigen_request.header request_info - Ocsigen_header.Name.x_forwarded_proto - in - match header with - | Some header -> ( - match String.lowercase_ascii header with - | "http" -> Ocsigen_request.update ~ssl:false request_info - | "https" -> Ocsigen_request.update ~ssl:true request_info - | _ -> - Lwt_log.ign_info_f ~section - "Malformed X-Forwarded-Proto field: %s" header; - request_info) - | None -> request_info - in - Lwt.return - (Ocsigen_extensions.Ext_continue_with - ( {request with Ocsigen_extensions.request_info} - , Ocsigen_cookie_map.empty - , code )) - in - function - | Ocsigen_extensions.Req_found (request, resp) -> - apply request (Ocsigen_response.status resp) - | Ocsigen_extensions.Req_not_found (code, request) -> apply request code) + allow_forward_for_handler ~check_equal_ip () + | Element ("allow-forward-proto", _, _) -> allow_forward_proto_handler | Element (t, _, _) -> raise (Ocsigen_extensions.Bad_config_tag_for_extension t) | _ -> Ocsigen_extensions.badconfig "(accesscontrol extension) Bad data" -(* Registration of the extension *) +(* Registration of the extension for the config file: *) let () = Ocsigen_extensions.register ~name:"accesscontrol" ~fun_site:(fun _ _ _ _ _ -> parse_config) () + +let if_ condition ithen ielse vh ci p = function + | Ocsigen_extensions.Req_found (ri, _) + | Ocsigen_extensions.Req_not_found (_, ri) -> + Lwt.return + (if condition ri.Ocsigen_extensions.request_info + then + Ocsigen_extensions.Ext_sub_result + (Ocsigen_extensions.compose (List.map (fun i -> i vh ci p) ithen)) + else + Ocsigen_extensions.Ext_sub_result + (Ocsigen_extensions.compose (List.map (fun i -> i vh ci p) ielse))) + +let iffound instrs vh ci p = function + | Ocsigen_extensions.Req_found (_, _) -> + Lwt.return + (Ocsigen_extensions.Ext_sub_result + (Ocsigen_extensions.compose (List.map (fun i -> i vh ci p) instrs))) + | Ocsigen_extensions.Req_not_found (err, _ri) -> + Lwt.return (Ocsigen_extensions.Ext_next err) + +let ifnotfound ?code instrs vh ci p = + let re = Option.map (fun s -> Netstring_pcre.regexp ("^" ^ s ^ "$")) code in + function + | Ocsigen_extensions.Req_found (_, r) -> + Lwt.return (Ocsigen_extensions.Ext_found (fun () -> Lwt.return r)) + | Ocsigen_extensions.Req_not_found (err, _) -> ( + match re with + | None -> + Lwt.return + (Ocsigen_extensions.Ext_sub_result + (Ocsigen_extensions.compose (List.map (fun i -> i vh ci p) instrs))) + | Some re -> + if let err = + string_of_int Cohttp.Code.(code_of_status (err :> status_code)) + in + Netstring_pcre.string_match re err 0 <> None + then + Lwt.return + (Ocsigen_extensions.Ext_sub_result + (Ocsigen_extensions.compose + (List.map (fun i -> i vh ci p) instrs))) + else Lwt.return (Ocsigen_extensions.Ext_next err)) + +let notfound _ _ _ _ = + Lwt.return + (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookie_map.empty, `Not_found)) + +let nextsite _ _ _ = function + | Ocsigen_extensions.Req_found (_, r) -> + Lwt.return (Ocsigen_extensions.Ext_found_stop (fun () -> Lwt.return r)) + | Ocsigen_extensions.Req_not_found _ -> + Lwt.return + (Ocsigen_extensions.Ext_stop_site (Ocsigen_cookie_map.empty, `Not_found)) + +let nexthost _ _ _ = function + | Ocsigen_extensions.Req_found (_, r) -> + Lwt.return (Ocsigen_extensions.Ext_found_stop (fun () -> Lwt.return r)) + | Ocsigen_extensions.Req_not_found _ -> + Lwt.return + (Ocsigen_extensions.Ext_stop_host (Ocsigen_cookie_map.empty, `Not_found)) + +let stop _ _ _ = function + | Ocsigen_extensions.Req_found (_, r) -> + Lwt.return (Ocsigen_extensions.Ext_found_stop (fun () -> Lwt.return r)) + | Ocsigen_extensions.Req_not_found _ -> + Lwt.return + (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookie_map.empty, `Not_found)) + +let forbidden _ _ _ _ = + Lwt.return + (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookie_map.empty, `Forbidden)) + +let allow_forward_for ?check_equal_ip () _ _ _ = + allow_forward_for_handler ?check_equal_ip () + +let allow_forward_proto () _ _ _ = allow_forward_proto_handler diff --git a/src/extensions/accesscontrol.mli b/src/extensions/accesscontrol.mli index 5886925be..4b4723359 100644 --- a/src/extensions/accesscontrol.mli +++ b/src/extensions/accesscontrol.mli @@ -18,10 +18,75 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -(* - val parse_condition : - Xml.xml -> Ocsigen_extensions.request_info -> bool +(** Accesscontrol: Conditional access to some sites *) + +(** If you want to use this extension with Ocsigen Server's configuration file, ++ have a look at the {% <>%}. ++ If you are using Ocsigen Server as a library, use the interface described ++ here. Each of these functions behaves exactly as its configuration file + counterpart. ++*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.accesscontrol]. *) +(** Example of use (with {% <>%}): +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Accesscontrol.( + if_ (not_ ssl) + [ Redirectmod.run + ~redirection: + (Redirectmod.create_redirection ~full_url:false + ~regexp:"(.* )" "https://yourdomain.org/\\1") + () ] + [ ... ]) ] + ] +]} + *) + +type condition + +val ip : string -> condition +val port : int -> condition +val ssl : condition +val header : name:string -> regexp:string -> condition +val method_ : Cohttp.Code.meth -> condition +val protocol : Cohttp.Code.version -> condition +val path : regexp:string -> condition +val and_ : condition list -> condition +val or_ : condition list -> condition +val not_ : condition -> condition + +val if_ : + condition + -> Ocsigen_server.instruction list + -> Ocsigen_server.instruction list + -> Ocsigen_server.instruction + +val iffound : Ocsigen_server.instruction list -> Ocsigen_server.instruction + +val ifnotfound : + ?code:string + -> Ocsigen_server.instruction list + -> Ocsigen_server.instruction + +val notfound : Ocsigen_server.instruction +val nextsite : Ocsigen_server.instruction +val nexthost : Ocsigen_server.instruction +val stop : Ocsigen_server.instruction +val forbidden : Ocsigen_server.instruction + +val allow_forward_for : + ?check_equal_ip:bool + -> unit + -> Ocsigen_server.instruction + +val allow_forward_proto : unit -> Ocsigen_server.instruction + val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +(** Use Lwt_log.Section.set_level in order to change the log level *) diff --git a/src/extensions/authbasic.ml b/src/extensions/authbasic.ml index 7fabcd384..ea2670dbd 100644 --- a/src/extensions/authbasic.ml +++ b/src/extensions/authbasic.ml @@ -104,18 +104,11 @@ let parse_config element = in gen ~realm ~auth -(** Registration of the extension *) +(** Registration of the extension for the config file: *) let () = Ocsigen_extensions.register ~name:"authbasic" ~fun_site:(fun _ _ _ _ _ _ -> parse_config) () -let realm = Ocsigen_server.Site.Config.key () -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") +(** Instruction for static linking without config file: *) +let run ~realm ~auth () _ _ _ = gen ~realm ~auth diff --git a/src/extensions/authbasic.mli b/src/extensions/authbasic.mli index c29083732..c732beaeb 100644 --- a/src/extensions/authbasic.mli +++ b/src/extensions/authbasic.mli @@ -18,12 +18,31 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +(** Authbasic: Basic HTTP authentication *) -(** Module [Authbasic]: Basic HTTP Authentication. *) +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. +*) -type auth = string -> string -> bool Lwt.t +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.authbasic]. +*) + +(** Example of use: +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Authbasic.run ~realm:"test" + ~auth:(fun u p -> Lwt.return (u = "theuser" && p = "thepassword")) + () + ; Staticmod.run ~dir:"static" () ]] +]} + *) (** This module implements Basic HTTP Authentication as described in {{:http://www.ietf.org/rfc/rfc2617.txt}RFC 2617}. It can be used @@ -37,6 +56,11 @@ type auth = string -> string -> bool Lwt.t very naive one (authentication with a single user/password, given in the configuration file) is provided. *) +val section : Lwt_log_core.section +(** use [Lwt_log.Section.set_level] in order to set the log level *) + +type auth = string -> string -> bool Lwt.t + val register_basic_authentication_method : (Xml.xml -> auth) -> unit (** This function registers an authentication plugin: it adds a new parser to the list of available authentication schemes. @@ -59,9 +83,9 @@ val register_basic_authentication_method : (Xml.xml -> auth) -> unit from the point of view of plugin developers and is totally transparent to the plugin. *) -val realm : string Ocsigen_server.Site.Config.key -val auth : auth Ocsigen_server.Site.Config.key -val extension : Ocsigen_server.Site.extension +val run : realm:string -> auth:auth -> unit -> Ocsigen_server.instruction +(** [run ~realm ~auth ()] makes it possible to use this extension without + configuration file. *) (**/**) diff --git a/src/extensions/cors.ml b/src/extensions/cors.ml index dd541beb4..273f2a059 100644 --- a/src/extensions/cors.ml +++ b/src/extensions/cors.ml @@ -156,18 +156,7 @@ let () = ~fun_site:(fun _ _ _ -> parse_config) () -let credentials = Ocsigen_server.Site.Config.key () -let max_age = Ocsigen_server.Site.Config.key () -let exposed_headers = Ocsigen_server.Site.Config.key () -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 run ?credentials ?max_age ?exposed_headers ?methods () _ _ _ = + let credentials = Ocsigen_lib.Option.get' false credentials in + let exposed_headers = Ocsigen_lib.Option.get' [] exposed_headers in + main {credentials; methods; max_age; exposed_headers} diff --git a/src/extensions/cors.mli b/src/extensions/cors.mli index eee69a409..63dbea127 100644 --- a/src/extensions/cors.mli +++ b/src/extensions/cors.mli @@ -1,5 +1,43 @@ -val credentials : bool Ocsigen_server.Site.Config.key -val max_age : int Ocsigen_server.Site.Config.key -val exposed_headers : string list Ocsigen_server.Site.Config.key -val methods : Cohttp.Code.meth list Ocsigen_server.Site.Config.key -val extension : Ocsigen_server.Site.extension +(** Cross-Origin Resource Sharing *) + +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. +*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.cors]. +*) + +(** Example of use: +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Staticmod.run ~dir:"static" () + ; Eliom.run () + ; Cors.run + ~max_age:86400 + ~credentials:true + ~methods:[ `POST; `GET; `HEAD ] + ~exposed_headers:[ "x-eliom-application" + ; "x-eliom-location" + ; "x-eliom-set-process-cookies" + ; "x-eliom-set-cookie-substitutes" ] + () + ]] +]} + *) + +val run : + ?credentials:bool + -> ?max_age:int + -> ?exposed_headers:string list + -> ?methods:Cohttp.Code.meth list + -> unit + -> Ocsigen_server.instruction +(** [run] makes it possible to use this extension without + configuration file. *) diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml index 7ae5f6ee8..76fe927ba 100644 --- a/src/extensions/deflatemod.ml +++ b/src/extensions/deflatemod.ml @@ -39,13 +39,10 @@ let should_compress (t, t') url choice_list = | `Only l -> List.exists check l | `All_but l -> List.for_all (fun c -> not (check c)) l -let compress_level = - let preprocess i = if i >= 0 && i <= 9 then i else 6 in - Ocsigen_config.Custom.key ~preprocess () - -let buffer_size = - let preprocess s = if s > 0 then s else 8192 in - Ocsigen_config.Custom.key ~preprocess () +let compress_level = ref 6 +let set_compress_level i = compress_level := if i >= 0 && i <= 9 then i else 6 +let buffer_size = ref 8192 +let set_buffer_size s = buffer_size := if s > 0 then s else 8192 (* Minimal header, by X. Leroy *) let gzip_header_length = 10 @@ -157,11 +154,7 @@ and next_cont oz stream = (* deflate param : true = deflate ; false = gzip (no header in this case) *) let compress deflate stream : string Ocsigen_stream.t = - let zstream = - Zlib.deflate_init - (Ocsigen_lib.Option.get' 6 (Ocsigen_config.Custom.find compress_level)) - deflate - in + let zstream = Zlib.deflate_init !compress_level deflate in let finalize status = Ocsigen_stream.finalize stream status >>= fun _e -> (try Zlib.deflate_end zstream @@ -172,9 +165,7 @@ let compress deflate stream : string Ocsigen_stream.t = Lwt.return (Lwt_log.ign_info ~section "Zlib stream closed") in let oz = - let buffer_size = - Ocsigen_lib.Option.get' 8192 (Ocsigen_config.Custom.find buffer_size) - in + let buffer_size = !buffer_size in { stream = zstream ; buf = Bytes.create buffer_size ; pos = 0 @@ -322,8 +313,7 @@ let rec parse_global_config = function (Ocsigen_extensions.Error_in_config_file "Compress level should be an integer between 0 and 9") in - Ocsigen_config.Custom.set compress_level i; - parse_global_config ll + set_compress_level i; parse_global_config ll | Xml.Element ("buffer", [("size", s)], []) :: ll -> let s = try int_of_string s @@ -332,8 +322,7 @@ let rec parse_global_config = function (Ocsigen_extensions.Error_in_config_file "Buffer size should be a positive integer") in - Ocsigen_config.Custom.set buffer_size s; - parse_global_config ll + set_buffer_size s; parse_global_config ll | _ -> raise (Ocsigen_extensions.Error_in_config_file @@ -377,11 +366,4 @@ let () = ~fun_site:(fun _ _ _ _ _ _ -> parse_config) ~init_fun:parse_global_config () -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") +let run ~mode () _ _ _ = filter mode diff --git a/src/extensions/deflatemod.mli b/src/extensions/deflatemod.mli index 7a56f0c26..db94787b6 100644 --- a/src/extensions/deflatemod.mli +++ b/src/extensions/deflatemod.mli @@ -1,13 +1,49 @@ -val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +(** Deflatemod: compress output data *) + +(** If you want to use this extension with Ocsigen Server's configuration file, ++ have a look at the {% <>%}. ++ If you are using Ocsigen Server as a library, use the interface described ++ here. Each of these functions behaves exactly as its configuration file + counterpart. ++*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.deflatemod]. +*) -val compress_level : int Ocsigen_config.Custom.key -val buffer_size : int Ocsigen_config.Custom.key +(** Example of use: +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Staticmod.run ~dir:"static" () + ; Deflatemod.run + ~mode:(`Only [ `Type (Some "text", Some "html") + ; `Type (Some "text", Some "javascript") + ; `Type (Some "text", Some "css") + ; `Type (Some "application", Some "javascript") + ; `Type (Some "application", Some "x-javascript") + ; `Type (Some "application", Some "xhtml+xml") + ; `Type (Some "image", Some "svg+xml") + ; `Type (Some "application", Some "x-eliom")]) () + ]] +]} + *) + +val set_compress_level : int -> unit +val set_buffer_size : int -> unit type filter = [`Type of string option * string option | `Extension of string] +(** Describes the content to deflate, either using its content type, + or file extension *) -val mode : - [`All_but of filter list | `Only of filter list] - Ocsigen_server.Site.Config.key +val run : + mode:[`All_but of filter list | `Only of filter list] + -> unit + -> Ocsigen_server.instruction +(** [run ~mode ()] makes it possible to use this extension without + configuration file. *) -val extension : Ocsigen_server.Site.extension +val section : Lwt_log_core.section +(** Use Lwt_log.Section.set_level in order to change the log level *) diff --git a/src/extensions/extendconfiguration.ml b/src/extensions/extendconfiguration.ml index 8e965a61d..bfd28cf0b 100644 --- a/src/extensions/extendconfiguration.ml +++ b/src/extensions/extendconfiguration.ml @@ -216,7 +216,7 @@ let fun_site usermode _ _ _ _ _ = function Ocsigen_extensions.badconfig "Bad syntax for tag %s" s | Xml.Element (("maxuploadfilesize" as tag), [], [Xml.PCData s]) -> let s = - try Ocsigen_parseconfig.parse_size_tag "uploaddir" s + try Ocsigen_parseconfig.parse_size_tag "maxuploadfilesize" s with Ocsigen_config.Config_file_error _ -> Ocsigen_extensions.badconfig "Bad syntax for tag %s" tag in @@ -231,3 +231,107 @@ let fun_site usermode _ _ _ _ _ = function "Unexpected data in config file") let () = Ocsigen_extensions.register ~name ~fun_site () + +let maxuploadfilesize s _ _ _ = + gen @@ fun config -> {config with Ocsigen_extensions.maxuploadfilesize = s} + +let uploaddir d _ _ _ = + gen @@ fun config -> {config with Ocsigen_extensions.uploaddir = d} + +let followsymlinks v _ _ _ = + gen @@ fun config -> {config with Ocsigen_extensions.follow_symlinks = v} + +let listdirs v _ _ _ = + gen @@ fun config -> + {config with Ocsigen_extensions.list_directory_content = v} + +let forbidfile ?(files = []) ?(extensions = []) ?(regexps = []) () _ _ _ = + let do_not_serve = + { Ocsigen_extensions.do_not_serve_regexps = regexps + ; do_not_serve_files = files + ; do_not_serve_extensions = extensions } + in + 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 } + +let hidefile ?(files = []) ?(extensions = []) ?(regexps = []) () _ _ _ = + let do_not_serve = + { Ocsigen_extensions.do_not_serve_regexps = regexps + ; do_not_serve_files = files + ; do_not_serve_extensions = extensions } + in + 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 } + +let defaultindex v _ _ _ = + gen @@ fun config -> + {config with Ocsigen_extensions.default_directory_index = v} + +let contenttype ?default ?(files = []) ?(extensions = []) ?(regexps = []) () _ _ + _ + = + gen @@ fun config -> + let mime_assoc = config.Ocsigen_extensions.mime_assoc in + let mime_assoc = + match default with + | None -> mime_assoc + | Some s -> Ocsigen_charset_mime.set_default_mime mime_assoc s + in + let mime_assoc = + List.fold_left + (fun ma (file, mime) -> + Ocsigen_charset_mime.update_mime_file ma file mime) + mime_assoc files + in + let mime_assoc = + List.fold_left + (fun ma (ext, mime) -> Ocsigen_charset_mime.update_mime_ext ma ext mime) + mime_assoc extensions + in + let mime_assoc = + List.fold_left + (fun ma (regexp, mime) -> + Ocsigen_charset_mime.update_mime_regexp ma + (Ocsigen_lib.Netstring_pcre.regexp regexp) + mime) + mime_assoc regexps + in + {config with Ocsigen_extensions.mime_assoc} + +let charset ?default ?(files = []) ?(extensions = []) ?(regexps = []) () _ _ _ = + gen @@ fun config -> + let charset_assoc = config.Ocsigen_extensions.charset_assoc in + let charset_assoc = + match default with + | None -> charset_assoc + | Some s -> Ocsigen_charset_mime.set_default_charset charset_assoc s + in + let charset_assoc = + List.fold_left + (fun ma (file, charset) -> + Ocsigen_charset_mime.update_charset_file ma file charset) + charset_assoc files + in + let charset_assoc = + List.fold_left + (fun ma (ext, charset) -> + Ocsigen_charset_mime.update_charset_ext ma ext charset) + charset_assoc extensions + in + let charset_assoc = + List.fold_left + (fun ma (regexp, charset) -> + Ocsigen_charset_mime.update_charset_regexp ma + (Ocsigen_lib.Netstring_pcre.regexp regexp) + charset) + charset_assoc regexps + in + {config with Ocsigen_extensions.charset_assoc} diff --git a/src/extensions/extendconfiguration.mli b/src/extensions/extendconfiguration.mli new file mode 100644 index 000000000..d2605c72a --- /dev/null +++ b/src/extensions/extendconfiguration.mli @@ -0,0 +1,65 @@ +(** Extendconfiguration: More configuration options for Ocsigen Server *) + +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. ++*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.extendconfiguration]. +*) + +(** Example of use: +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Extendconfiguration.forbidfile ~extensions:["php"] () + ; Staticmod.run ~dir:"static" () + ] + ] +]} + *) + +val followsymlinks : + [`Always | `No | `Owner_match] + -> Ocsigen_server.instruction + +val maxuploadfilesize : int64 option -> Ocsigen_server.instruction +val uploaddir : string option -> Ocsigen_server.instruction +val listdirs : bool -> Ocsigen_server.instruction + +val forbidfile : + ?files:string list + -> ?extensions:string list + -> ?regexps:string list + -> unit + -> Ocsigen_server.instruction + +val hidefile : + ?files:string list + -> ?extensions:string list + -> ?regexps:string list + -> unit + -> Ocsigen_server.instruction + +val defaultindex : string list -> Ocsigen_server.instruction + +val contenttype : + ?default:string + -> ?files:(string * string) list + -> ?extensions:(string * string) list + -> ?regexps:(string * string) list + -> unit + -> Ocsigen_server.instruction + +val charset : + ?default:string + -> ?files:(string * string) list + -> ?extensions:(string * string) list + -> ?regexps:(string * string) list + -> unit + -> Ocsigen_server.instruction diff --git a/src/extensions/outputfilter.ml b/src/extensions/outputfilter.ml index c0f28bd53..3d52fa7d7 100644 --- a/src/extensions/outputfilter.ml +++ b/src/extensions/outputfilter.ml @@ -20,10 +20,6 @@ (* This module enables rewritting the server output *) -type header_filter = - [ `Rewrite of Ocsigen_header.Name.t * Re.Pcre.regexp * string - | `Add of Ocsigen_header.Name.t * string * bool option ] - let gen filter = function | Ocsigen_extensions.Req_not_found (code, _) -> Lwt.return (Ocsigen_extensions.Ext_next code) @@ -116,12 +112,9 @@ let () = ~fun_site:(fun _ _ _ _ _ _ -> parse_config) () -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") +let run ~mode () _ _ _ = + match mode with + | `Code c -> gen_code c + | `Rewrite (header, regexp, dest) -> + gen (`Rewrite (header, Re.Pcre.regexp ("^" ^ regexp ^ "$"), dest)) + | `Add f -> gen (`Add f) diff --git a/src/extensions/outputfilter.mli b/src/extensions/outputfilter.mli index ec66a5397..7f21d0de9 100644 --- a/src/extensions/outputfilter.mli +++ b/src/extensions/outputfilter.mli @@ -1,7 +1,25 @@ -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 +(** Outputfilter: Rewrite some part of the output *) -val extension : Ocsigen_server.Site.extension +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. ++*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.outputfilter]. +*) + +(** See an example of use on the API documentation of {!Revproxy}. *) + +val run : + mode: + [ `Rewrite of Ocsigen_header.Name.t * string * string + | `Add of Ocsigen_header.Name.t * string * bool option + | `Code of Cohttp.Code.status ] + -> unit + -> Ocsigen_server.instruction +(** [run ~mode ()] makes it possible to use this extension without + configuration file. *) diff --git a/src/extensions/redirectmod.ml b/src/extensions/redirectmod.ml index ab359951c..8c5fdcc43 100644 --- a/src/extensions/redirectmod.ml +++ b/src/extensions/redirectmod.ml @@ -26,27 +26,15 @@ let section = Lwt_log.Section.make "ocsigen:ext:redirectmod" (* The table of redirections for each virtual server *) type redirection = - { r_regexp : Pcre.regexp - ; r_dest : string - ; r_full : [`Yes | `No | `Maybe] - ; r_temp : bool } + {r_regexp : Pcre.regexp; r_dest : string; r_full : bool; r_temp : bool} -let create_redirection ?(full = `Yes) ?(temporary = false) ~regexp r_dest = +let create_redirection ?(full_url = true) ?(temporary = false) ~regexp r_dest = let r_regexp = Pcre.regexp ("^" ^ regexp ^ "$") in - {r_regexp; r_dest; r_full = full; r_temp = temporary} + {r_regexp; r_dest; r_full = full_url; r_temp = temporary} let attempt_redir {r_regexp; r_dest; r_full; r_temp} _err ri () = Lwt_log.ign_info ~section "Is it a redirection?"; - let redir = - let find full = - Ocsigen_extensions.find_redirection r_regexp full r_dest ri - in - match r_full with - | `Yes -> find true - | `No -> find false - | `Maybe -> ( - try find false with Ocsigen_extensions.Not_concerned -> find true) - in + let redir = Ocsigen_extensions.find_redirection r_regexp r_full r_dest ri in Lwt_log.ign_info_f ~section "YES! %s redirection to: %s" (if r_temp then "Temporary " else "Permanent ") redir; @@ -73,7 +61,7 @@ let gen dir = function let parse_config config_elem = let regexp = ref None and dest = ref "" - and mode = ref `Yes + and mode = ref true and temporary = ref false in Ocsigen_extensions.( Configuration.process_element ~in_tag:"host" @@ -81,15 +69,12 @@ let parse_config config_elem = ~elements: [ Configuration.element ~name:"redirect" ~attributes: - [ Configuration.attribute ~name:"regexp" (fun s -> - regexp := Some ("^" ^ s ^ "$"); - mode := `Maybe) - ; Configuration.attribute ~name:"fullurl" (fun s -> + [ Configuration.attribute ~name:"fullurl" (fun s -> regexp := Some s; - mode := `Yes) + mode := true) ; Configuration.attribute ~name:"suburl" (fun s -> regexp := Some s; - mode := `No) + mode := false) ; Configuration.attribute ~name:"dest" ~obligatory:true (fun s -> dest := s) ; Configuration.attribute ~name:"temporary" (function @@ -101,18 +86,12 @@ let parse_config config_elem = | None -> Ocsigen_extensions.badconfig "Missing attribute regexp for " | Some regexp -> - gen (create_redirection ~full:!mode ~regexp ~temporary:!temporary !dest) + gen + (create_redirection ~full_url:!mode ~regexp ~temporary:!temporary !dest) let () = Ocsigen_extensions.register ~name:"redirectmod" ~fun_site:(fun _ _ _ _ _ _ -> parse_config) () -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") +let run ~redirection () _ _ _ = gen redirection diff --git a/src/extensions/redirectmod.mli b/src/extensions/redirectmod.mli index 0b16137f4..94a7c7a94 100644 --- a/src/extensions/redirectmod.mli +++ b/src/extensions/redirectmod.mli @@ -1,14 +1,46 @@ +(** Redirectmod: HTTP redirections *) + +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. +*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.redirectmod]. +*) + +(** Example of use: +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Redirectmod.run + ~redirection: + (Redirectmod.create_redirection + ~temporary:false ~full_url:false ~regexp:"^olddir/(.* )$" + "https://blahblahblah.org/newdir/\\1") + () + ; Staticmod.run ~dir:"static" () + ] + ] +]} + *) + val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) +(** use Lwt_log.Section.set_level in order to set the log level *) type redirection val create_redirection : - ?full:[`Maybe | `No | `Yes] + ?full_url:bool -> ?temporary:bool -> regexp:string -> string -> redirection -val redirection : redirection Ocsigen_server.Site.Config.key -val extension : Ocsigen_server.Site.extension +val run : redirection:redirection -> unit -> Ocsigen_server.instruction +(** [run ~redirection ()] makes it possible to use this extension without + configuration file. *) diff --git a/src/extensions/revproxy.ml b/src/extensions/revproxy.ml index 8cfcfe5a5..d49c9a541 100644 --- a/src/extensions/revproxy.ml +++ b/src/extensions/revproxy.ml @@ -27,16 +27,20 @@ module Pcre = Re.Pcre let section = Lwt_log.Section.make "ocsigen:ext:revproxy" -exception Bad_answer_from_http_server - -type redir = +type redirection = { regexp : Pcre.regexp - ; full_url : Ocsigen_lib.yesnomaybe + ; full_url : bool ; dest : string ; pipeline : bool ; keephost : bool } (** The table of redirections for each virtual server *) +let create_redirection ?(full_url = true) ?(pipeline = true) ?(keephost = false) + ~regexp dest + = + let regexp = Pcre.regexp ("^" ^ regexp ^ "$") in + {regexp; dest; full_url; pipeline; keephost} + (** Generate the pages from the request *) let gen dir = function | Ocsigen_extensions.Req_found _ -> @@ -48,15 +52,8 @@ let gen dir = function (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) + Ocsigen_extensions.find_redirection dir.regexp dir.full_url + dir.dest request_info in let https, host, port, path = try @@ -143,7 +140,7 @@ let gen dir = function let parse_config config_elem = let regexp = ref None in - let full_url = ref Ocsigen_lib.Yes in + let full_url = ref true in let dest = ref None in let pipeline = ref true in let keephost = ref false in @@ -153,15 +150,12 @@ let parse_config config_elem = ~elements: [ Configuration.element ~name:"revproxy" ~attributes: - [ Configuration.attribute ~name:"regexp" (fun s -> + [ Configuration.attribute ~name:"fullurl" (fun s -> regexp := Some s; - full_url := Ocsigen_lib.Yes) - ; Configuration.attribute ~name:"fullurl" (fun s -> - regexp := Some s; - full_url := Ocsigen_lib.Yes) + full_url := true) ; Configuration.attribute ~name:"suburl" (fun s -> regexp := Some s; - full_url := Ocsigen_lib.No) + full_url := false) ; Configuration.attribute ~name:"dest" (fun s -> dest := Some s) ; Configuration.attribute ~name:"keephost" (function | "keephost" -> keephost := true @@ -191,3 +185,5 @@ let () = (* We ask ocsigen to respect pipeline order when sending to extensions! *) () + +let run ~redirection () _ _ _ = gen redirection diff --git a/src/extensions/revproxy.mli b/src/extensions/revproxy.mli new file mode 100644 index 000000000..57a6e9b36 --- /dev/null +++ b/src/extensions/revproxy.mli @@ -0,0 +1,55 @@ +(** Revproxy: Forward a request to another Web server *) + +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. +*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.revproxy]. +*) + +(** Example of use. Forward all requests to a given directory to the +same directory of another server running locally on another port. +We are using it in combination with +{% <>%} to rewrite redirections. + +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" + [ Revproxy.run + ~redirection:(Revproxy.create_redirection + ~full_url:false + ~regexp:"(othersite/.* )" + ~keephost:true + "https://localhost:8123/\\1") + () + ; Outputfilter.run + ~mode:(`Rewrite (Ocsigen_header.Name.location, + "http://localhost:8123/(.* )", + "http://my.publicaddress.org/\\1")) + () + ]] +]} + *) + +val section : Lwt_log_core.section +(** use Lwt_log.Section.set_level in order to set the log level *) + +type redirection + +val create_redirection : + ?full_url:bool + -> ?pipeline:bool + -> ?keephost:bool + -> regexp:string + -> string + -> redirection + +val run : redirection:redirection -> unit -> Ocsigen_server.instruction +(** [run ~redirection ()] makes it possible to use this extension without + configuration file. *) diff --git a/src/extensions/rewritemod.ml b/src/extensions/rewritemod.ml index e2553cd61..a8e272f82 100644 --- a/src/extensions/rewritemod.ml +++ b/src/extensions/rewritemod.ml @@ -127,3 +127,11 @@ let () = Ocsigen_extensions.register ~name:"rewritemod" ~fun_site:(fun _ _ _ _ _ _ -> parse_config) () + +let run ?(continue = false) ?(full_rewrite = false) ~regexp dest () _ _ _ = + gen + (Regexp + ( Ocsigen_lib.Netstring_pcre.regexp ("^" ^ regexp ^ "$") + , dest + , full_rewrite )) + continue diff --git a/src/extensions/rewritemod.mli b/src/extensions/rewritemod.mli new file mode 100644 index 000000000..ad84b2829 --- /dev/null +++ b/src/extensions/rewritemod.mli @@ -0,0 +1,26 @@ +(** Rewrite: Change the request *) + +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. Each of these functions behaves exactly as its configuration file + counterpart. ++*) + +(** +This module belongs to ocamlfind package + [ocsigenserver.ext.rewritemod]. +*) + +val section : Lwt_log_core.section +(** use Lwt_log.Section.set_level in order to set the log level *) + +val run : + ?continue:bool + -> ?full_rewrite:bool + -> regexp:string + -> string + -> unit + -> Ocsigen_server.instruction +(** [run ~realm ~auth ()] makes it possible to use this extension without + configuration file. *) diff --git a/src/extensions/staticmod.ml b/src/extensions/staticmod.ml index e840a7067..a6af87930 100644 --- a/src/extensions/staticmod.ml +++ b/src/extensions/staticmod.ml @@ -278,20 +278,21 @@ let () = (* TODO: fix names and types, preprocess as we do for XML *) +(* Registration for static linking: *) let preprocess s = "^" ^ s ^ "$" -let dir = Ocsigen_server.Site.Config.key () -let regexp = Ocsigen_server.Site.Config.key ~preprocess () -let code = Ocsigen_server.Site.Config.key ~preprocess () -let dest = Ocsigen_server.Site.Config.key () -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 run ?dir ?regexp ?dest ?code ?cache ?root () = + let kind = + kind dir + (Ocsigen_lib.Option.map (fun x -> Pcre.regexp (preprocess x)) regexp) + (Ocsigen_lib.Option.map (fun x -> Pcre.regexp (preprocess x)) code) + (Ocsigen_lib.Option.map + (fun x -> + Ocsigen_extensions.parse_user_dir (rewrite_local_path None x)) + dest) + (Ocsigen_lib.Option.map + (fun x -> + Ocsigen_extensions.parse_user_dir (rewrite_local_path None x)) + root) + in + fun _ _ _ -> gen ~usermode:None ?cache kind diff --git a/src/extensions/staticmod.mli b/src/extensions/staticmod.mli index 9a231003d..ef232825b 100644 --- a/src/extensions/staticmod.mli +++ b/src/extensions/staticmod.mli @@ -1,9 +1,38 @@ +(** Staticmod: serve static files *) + +(** If you want to use this extension with Ocsigen Server's configuration file, + have a look at the {% <>%}. + If you are using Ocsigen Server as a library, use the interface described + here. +*) + +(** + This module belongs to ocamlfind package + [ocsigenserver.ext.staticmod]. +*) + +(** Example of use: +{[ +let _ = + Ocsigen_server.start + [ Ocsigen_server.host ~regexp:".*" [ Staticmod.run ~dir:"static" () ]] +]} + *) + +val run : + ?dir:string + -> ?regexp:string + -> ?dest:string + -> ?code:string + -> ?cache:int + -> ?root:string + -> unit + -> Ocsigen_server.instruction +(** Run static mod on a specific directory. + Call this if you want to run Ocsigen Server without configuration file. + The optional parameter correspond to the options of the configuration + file described {% <>%}.*) + val section : Lwt_log_core.section -(** use Lwt_log.Section.set_level in order to debug *) - -val dir : string Ocsigen_server.Site.Config.key -val regexp : string Ocsigen_server.Site.Config.key -val code : string Ocsigen_server.Site.Config.key -val dest : Ocsigen_extensions.ud_string Ocsigen_server.Site.Config.key -val root_checks : Ocsigen_extensions.ud_string Ocsigen_server.Site.Config.key -val extension : Ocsigen_server.Site.extension +(** Use {!Lwt_log.Section.set_level} in order to select the log level for + this module *) diff --git a/src/extensions/userconf.mli b/src/extensions/userconf.mli new file mode 100644 index 000000000..e69de29bb diff --git a/src/files/ocsigenserver.conf.in b/src/files/ocsigenserver.conf.in index d5a2fc014..8a5b50a61 100644 --- a/src/files/ocsigenserver.conf.in +++ b/src/files/ocsigenserver.conf.in @@ -12,8 +12,6 @@ _LOGDIR_ _DATADIR_ - _OCSIGENUSER_ - _OCSIGENGROUP_ diff --git a/src/ocsigenserver.ml b/src/ocsigenserver.ml index 3727ac321..072bb9718 100644 --- a/src/ocsigenserver.ml +++ b/src/ocsigenserver.ml @@ -31,4 +31,4 @@ let () = "usage: ocsigenserver [-c configfile]" with Arg.Help s -> print_endline s; exit 0 -let () = Ocsigen_server.start ~config:(Ocsigen_parseconfig.parse_config ()) () +let () = Ocsigen_server.exec (Ocsigen_parseconfig.parse_config ()) diff --git a/src/server/dune b/src/server/dune index 46de6a9c9..972a0bee9 100644 --- a/src/server/dune +++ b/src/server/dune @@ -1,5 +1,11 @@ (library - (name ocsigenserver) - (public_name ocsigenserver) - (wrapped false) - (libraries xml-light cohttp-lwt-unix hmap polytables ocsigen_cookie_map baselib http)) + (name ocsigenserver) + (public_name ocsigenserver) + (wrapped false) + (libraries + xml-light + cohttp-lwt-unix + polytables + ocsigen_cookie_map + baselib + http)) diff --git a/src/server/ocsigen_config.ml b/src/server/ocsigen_config.ml index db0994240..570e0b37b 100644 --- a/src/server/ocsigen_config.ml +++ b/src/server/ocsigen_config.ml @@ -66,8 +66,6 @@ let maxrequestbodysize = ref (Some (Int64.of_int 8000000)) let maxrequestbodysizeinmemory = ref 8192 let maxuploadfilesize = ref (Some (Int64.of_int 2000000)) let defaultcharset = ref (None : string option) -let user = ref (Some !default_user) -let group = ref (Some !default_group) let debugmode = ref false let disablepartialrequests = ref false let usedefaulthostname = ref false @@ -130,8 +128,6 @@ let set_default_charset o = defaultcharset := o let set_datadir o = datadir := o let set_bindir o = bindir := o let set_extdir o = extdir := o -let set_user o = user := o -let set_group o = group := o let set_command_pipe s = command_pipe := s let set_debugmode s = debugmode := s let set_disablepartialrequests s = disablepartialrequests := s @@ -158,8 +154,6 @@ let get_silent () = !silent let get_daemon () = !daemon let get_veryverbose () = !veryverbose let get_debug () = !debug -let get_default_user () = !default_user -let get_default_group () = !default_group let get_minthreads () = !minthreads let get_maxthreads () = !maxthreads @@ -177,8 +171,6 @@ let get_default_charset () = !defaultcharset let get_datadir () = !datadir let get_bindir () = !bindir let get_extdir () = !extdir -let get_user () = !user -let get_group () = !group let get_command_pipe () = !command_pipe let get_debugmode () = !debugmode let get_disablepartialrequests () = !disablepartialrequests @@ -199,18 +191,5 @@ let display_version () = print_newline (); exit 0 -module Custom = struct - let m = ref Hmap.empty - - (* TODO : two type variables? *) - type 'a key = ('a -> 'a) option * 'a Hmap.key - - let key ?preprocess () = preprocess, Hmap.Key.create () - let find (_, k) = Hmap.find k !m - - let set (f, k) v = - let v = match f with Some f -> f v | None -> v in - m := Hmap.add k v !m - - let unset (_, k) = m := Hmap.rem k !m -end +let has_config_file = ref false +let has_configuration_file () = !has_config_file diff --git a/src/server/ocsigen_config.mli b/src/server/ocsigen_config.mli index a0ca20f2a..f0322f5e0 100644 --- a/src/server/ocsigen_config.mli +++ b/src/server/ocsigen_config.mli @@ -70,8 +70,6 @@ val set_default_charset : string option -> unit val set_datadir : string -> unit val set_bindir : string -> unit val set_extdir : string -> unit -val set_user : string option -> unit -val set_group : string option -> unit val set_command_pipe : string -> unit val set_debugmode : bool -> unit val set_disablepartialrequests : bool -> unit @@ -92,8 +90,6 @@ val get_silent : unit -> bool val get_daemon : unit -> bool val get_veryverbose : unit -> bool val get_debug : unit -> bool -val get_default_user : unit -> string -val get_default_group : unit -> string val get_minthreads : unit -> int val get_maxthreads : unit -> int val get_max_number_of_threads_queued : unit -> int @@ -101,6 +97,9 @@ val get_max_number_of_connections : unit -> int val get_client_timeout : unit -> int val get_server_timeout : unit -> int +val has_configuration_file : unit -> bool +(** returns true if Ocsigen Server is running with a configuration file, *) + (*val get_keepalive_timeout : unit -> int val get_keepopen_timeout : unit -> int*) val get_filebuffersize : unit -> int @@ -110,8 +109,6 @@ val get_default_charset : unit -> string option val get_datadir : unit -> string val get_bindir : unit -> string val get_extdir : unit -> string -val get_user : unit -> string option -val get_group : unit -> string option val get_command_pipe : unit -> string val get_debugmode : unit -> bool val get_disablepartialrequests : unit -> bool @@ -138,12 +135,4 @@ val get_uploaddir : unit -> string option (* Same thing for upload size *) val set_maxuploadfilesize : int64 option -> unit val get_maxuploadfilesize : unit -> int64 option - -module Custom : sig - type 'a key - - val key : ?preprocess:('a -> 'a) -> unit -> 'a key - val find : 'a key -> 'a option - val set : 'a key -> 'a -> unit - val unset : 'a key -> unit -end +val has_config_file : bool ref diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml index 4ac19f1e3..3eb0737b9 100644 --- a/src/server/ocsigen_extensions.ml +++ b/src/server/ocsigen_extensions.ml @@ -258,9 +258,9 @@ type parse_fun = Xml.xml list -> extension_composite type parse_host = | Parse_host of (Url.path -> parse_host -> parse_fun -> Xml.xml -> extension) -let hosts : (virtual_hosts * config_info * extension_composite) list ref = - ref [] +type host_config = virtual_hosts * config_info * extension_composite +let hosts : host_config list ref = ref [] let set_hosts v = hosts := v let get_hosts () = !hosts diff --git a/src/server/ocsigen_extensions.mli b/src/server/ocsigen_extensions.mli index db1e336ba..018abf237 100644 --- a/src/server/ocsigen_extensions.mli +++ b/src/server/ocsigen_extensions.mli @@ -147,7 +147,7 @@ type answer = (** 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 + ({!Ocsigen_cookie_map.empty} for no cookies). You must add these cookies yourself in request if you want them to be seen by subsequent extensions, for example using {!Ocsigen_http_frame.compute_new_ri_cookies}. The status is @@ -157,7 +157,7 @@ type answer = (** 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 + ({!Ocsigen_cookie_map.empty} for no cookies). You must add these cookies yourself in request if you want them to be seen by subsequent extensions, for example using {!Ocsigen_http_frame.compute_new_ri_cookies}. *) @@ -256,7 +256,7 @@ val register : [] and []. This allows to give configuration options to extensions. If no function is supplied, the extension is supposed to accept no option (and loading will fail if an option is supplied) - See <> for + See {!Configuration.process_elements} for the easy construction of such a function. - a function [exn_handler] that will create an error message from the exceptions that may be raised during the initialisation phase, and raise again @@ -406,7 +406,9 @@ val site_ext : -> Ocsigen_lib.Url.path -> extension -val set_hosts : (virtual_hosts * config_info * extension_composite) list -> unit +type host_config = virtual_hosts * config_info * extension_composite + +val set_hosts : host_config list -> unit val get_hosts : unit -> (virtual_hosts * config_info * extension_composite) list val compute_result : @@ -416,9 +418,9 @@ val compute_result : (** Compute the answer to be sent to the client, by trying all extensions according the configuration file. *) -val get_number_of_connected : unit -> int -(** Profiling *) +(** {3 Profiling} *) +val get_number_of_connected : unit -> int val during_initialisation : unit -> bool val start_initialisation : unit -> unit val end_initialisation : unit -> unit diff --git a/src/server/ocsigen_messages.ml b/src/server/ocsigen_messages.ml index d1bee2fb4..a94030df3 100644 --- a/src/server/ocsigen_messages.ml +++ b/src/server/ocsigen_messages.ml @@ -30,9 +30,7 @@ let stdout = Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stdout () let loggers = ref [] let access_logger = ref Lwt_log_core.null -let open_files ?(user = Ocsigen_config.get_user ()) - ?(group = Ocsigen_config.get_group ()) () - = +let open_files () = (* CHECK: we are closing asynchronously! That should be ok, though. *) List.iter (fun l -> ignore (Lwt_log.close l : unit Lwt.t)) !loggers; match Ocsigen_config.get_syslog_facility () with @@ -75,35 +73,7 @@ let open_files ?(user = Ocsigen_config.get_user ()) match lev with | Lwt_log.Warning | Lwt_log.Error | Lwt_log.Fatal -> stderr | _ -> stdout) ]; - let gid = - match group with - | None -> Unix.getgid () - | Some group -> ( - try (Unix.getgrnam group).Unix.gr_gid - with Not_found as e -> - ignore (Lwt_log.error "Error: Wrong group"); - raise e) - in - let uid = - match user with - | None -> Unix.getuid () - | Some user -> ( - try (Unix.getpwnam user).Unix.pw_uid - with Not_found as e -> - ignore (Lwt_log.error "Error: Wrong user"); - raise e) - 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) - (fun e -> - match e with - | Unix.Unix_error (Unix.EPERM, _, _) -> - (* to allow for symlinks to /dev/null *) - Lwt.return_unit - | _ -> Lwt.fail e) + Lwt.return () (****) diff --git a/src/server/ocsigen_messages.mli b/src/server/ocsigen_messages.mli index 9a88baaf2..3aee6b748 100644 --- a/src/server/ocsigen_messages.mli +++ b/src/server/ocsigen_messages.mli @@ -46,10 +46,5 @@ val error_log_path : unit -> string (**/**) -val open_files : - ?user:string option - -> ?group:string option - -> unit - -> unit Lwt.t - +val open_files : unit -> unit Lwt.t val command_f : exn -> string -> string list -> unit Lwt.t diff --git a/src/server/ocsigen_parseconfig.ml b/src/server/ocsigen_parseconfig.ml index a6f4de5cb..ec1dbb97e 100644 --- a/src/server/ocsigen_parseconfig.ml +++ b/src/server/ocsigen_parseconfig.ml @@ -599,15 +599,15 @@ let rec parse_ssl l ~certificate ~privatekey ~ciphers ~dhfile ~curve = | _ -> raise (Config_file_error "Unexpected content inside ") let first_pass c = - let rec aux user group ssl ports sslports = function - | [] -> (user, group), (ssl, ports, sslports) + let rec aux ssl ports sslports = function + | [] -> ssl, ports, sslports | Element (("logdir" as st), [], p) :: ll -> set_logdir (parse_string_tag st p); - aux user group ssl ports sslports ll + aux ssl ports sslports ll | Element (("syslog" as st), [], p) :: ll -> let str = String.lowercase_ascii (parse_string_tag st p) in set_syslog_facility (Some (parse_facility str)); - aux user group ssl ports sslports ll + aux ssl ports sslports ll | Element (("port" as st), atts, p) :: ll -> ( match atts with | [] | [("protocol", "HTTP")] -> @@ -616,21 +616,21 @@ let first_pass c = with Failure _ -> raise (Config_file_error "Wrong value for tag") in - aux user group ssl (po :: ports) sslports ll + aux ssl (po :: ports) sslports ll | [("protocol", "HTTPS")] -> let po = try parse_port (parse_string_tag st p) with Failure _ -> raise (Config_file_error "Wrong value for tag") in - aux user group ssl ports (po :: sslports) ll + aux ssl ports (po :: sslports) ll | _ -> raise (Config_file_error "Wrong attribute for ")) | Element (("minthreads" as st), [], p) :: ll -> set_minthreads (int_of_string st (parse_string_tag st p)); - aux user group ssl ports sslports ll + aux ssl ports sslports ll | Element (("maxthreads" as st), [], p) :: ll -> set_maxthreads (int_of_string st (parse_string_tag st p)); - aux user group ssl ports sslports ll + aux ssl ports sslports ll | Element ("ssl", [], p) :: ll -> ( match ssl with | None -> @@ -642,42 +642,22 @@ let first_pass c = and curve = None in parse_ssl ~certificate ~privatekey ~ciphers ~dhfile ~curve p in - aux user group ssl ports sslports ll + aux ssl ports sslports ll | _ -> raise (Config_file_error "Only one ssl certificate for each server supported for now")) - | Element (("user" as st), [], p) :: ll -> ( - match user with - | None -> aux (Some (parse_string_tag st p)) group ssl ports sslports ll - | _ -> - raise - (Config_file_error "Only one tag for each server allowed")) - | Element (("group" as st), [], p) :: ll -> ( - match group with - | None -> aux user (Some (parse_string_tag st p)) ssl ports sslports ll - | _ -> - raise - (Config_file_error "Only one tag for each server allowed")) + | Element ("user", [], _) :: ll | Element ("group", [], _) :: ll -> + Lwt_log.ign_warning ~section + "Config file: and deprecated. Please do not launch as root."; + aux ssl ports sslports ll | Element (("commandpipe" as st), [], p) :: ll -> set_command_pipe (parse_string_tag st p); - aux user group ssl ports sslports ll - | Element _ :: ll -> aux user group ssl ports sslports ll + aux ssl ports sslports ll + | Element _ :: ll -> aux ssl ports sslports ll | _ -> raise (Config_file_error "Syntax error") in - let (user, group), (si, ports, ssl_ports) = aux None None None [] [] c in - let user = - match user with - | None -> None (* Some (get_default_user ()) *) - | Some s -> if s = "" then None else Some s - in - let group = - match group with - | None -> None (* Some (get_default_group ()) *) - | Some s -> if s = "" then None else Some s - in - Ocsigen_config.set_user user; - Ocsigen_config.set_group group; + let si, ports, ssl_ports = aux None [] [] c in Ocsigen_config.set_ssl_info si; Ocsigen_config.set_ports ports; Ocsigen_config.set_ssl_ports ssl_ports; diff --git a/src/server/ocsigen_parseconfig.mli b/src/server/ocsigen_parseconfig.mli index e07677f15..c0195f25a 100644 --- a/src/server/ocsigen_parseconfig.mli +++ b/src/server/ocsigen_parseconfig.mli @@ -51,4 +51,9 @@ val first_pass : Xml.xml list -> unit *) val later_pass : Xml.xml list -> unit + +(**/**) + val parse_config : ?file:string -> unit -> Xml.xml list list +(** Returns the config file. Use this if you want to read a config file from + your own executable. See {!Ocsigen_server.exec}.*) diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml index 59f5c3391..128743622 100644 --- a/src/server/ocsigen_server.ml +++ b/src/server/ocsigen_server.ml @@ -122,156 +122,64 @@ let _ = in Ocsigen_command.register_command_function f -type accessor = {accessor : 'a. ('a -> 'a) option * 'a Hmap.key -> 'a option} - -module type Hmap_wrapped = sig - type t - - val get : t -> Hmap.t - val do_ : t -> (Hmap.t -> Hmap.t) -> unit -end - -module type Config_nested = sig - type t - type 'a key - - val key : ?preprocess:('a -> 'a) -> unit -> 'a key - val find : t -> 'a key -> 'a option - val set : t -> 'a key -> 'a -> unit - val unset : t -> 'a key -> unit - - type accessor = {accessor : 'a. 'a key -> 'a option} -end - -module Make_config_nested (W : Hmap_wrapped) = struct - type 'a key = ('a -> 'a) option * 'a Hmap.key - type nonrec accessor = accessor = {accessor : 'a. 'a key -> 'a option} - - let key ?preprocess () = preprocess, Hmap.Key.create () - let find w (_, k) = Hmap.find k (W.get w) - - let set w (f, k) v = - let v = match f with Some f -> f v | None -> v in - W.do_ w (Hmap.add k v) - - let unset w (_, k) = W.do_ w (Hmap.rem k) -end - -module Site = struct - type extension_simple = accessor -> Ocsigen_extensions.extension - - type extension = - [ `Simple of extension_simple - | `Intrusive of - Ocsigen_extensions.virtual_hosts - -> Ocsigen_extensions.config_info - -> Ocsigen_lib.Url.path - -> extension_simple ] - - let registered_extensions = ref [] - - let create_extension f = - let v = `Simple f in - registered_extensions := v :: !registered_extensions; - v - - let create_extension_intrusive f = - let v = `Intrusive f in - registered_extensions := v :: !registered_extensions; - v - - type t = - { s_id : - [ `Host of Ocsigen_extensions.virtual_hosts - | `Attach of t * Ocsigen_lib.Url.path ] - ; s_config_info : Ocsigen_extensions.config_info - ; s_charset : Ocsigen_charset_mime.charset option - ; mutable s_config_map : Hmap.t - ; mutable s_children_l : [`Extension of extension_simple | `Child of t] list - } - - let l = ref [] - let default_re_string = ".*" - let default_re = Ocsigen_lib.Netstring_pcre.regexp default_re_string - - let rec path_and_hosts {s_id; _} = - match s_id with - | `Host hosts -> [], hosts - | `Attach (s, path') -> - let path, hosts = path_and_hosts s in - path @ path', hosts - - let register ({s_config_info; s_children_l; _} as s) = function - | `Simple f -> s.s_children_l <- `Extension f :: s_children_l - | `Intrusive f -> - let path, hosts = path_and_hosts s in - s.s_children_l <- - `Extension (f hosts s_config_info path) :: s_children_l - - let create ?(config_info = Ocsigen_extensions.default_config_info ()) - ?(id = `Host (default_re_string, None)) ?charset - ?(auto_load_extensions = false) () - = - let s_id = - match id with - | `Host (host_regexp, port) when host_regexp = default_re_string -> - `Host [default_re_string, default_re, port] - | `Host (host_regexp, port) -> - `Host - [host_regexp, Ocsigen_lib.Netstring_pcre.regexp host_regexp, port] - | `Attach (parent, path) -> - `Attach (parent, Ocsigen_extensions.preprocess_site_path path) - in - let s = - { s_id - ; s_charset = charset - ; s_config_info = config_info - ; s_config_map = Hmap.empty - ; s_children_l = [] } - in - (match s_id with - | `Host _ -> l := s :: !l - | `Attach (parent, _) -> - parent.s_children_l <- `Child s :: parent.s_children_l); - if auto_load_extensions - then List.iter (register s) (List.rev !registered_extensions); - s - - let rec dump_host path {s_config_map; s_children_l; _} = - let f = function - | `Extension f -> f {accessor = (fun (_, k) -> Hmap.find k s_config_map)} - | `Child ({s_charset; s_id = `Attach (_, path'); _} as s) -> - let path = path @ path' in - Ocsigen_extensions.site_ext (dump_host path s) s_charset path - | `Child _ -> failwith "Ocsigen_server.dump_host" - in - Ocsigen_extensions.compose (List.map f s_children_l) - - let dump () = - let f acc = function - | {s_config_info; s_id = `Host l; s_children_l = _ :: _; _} as s -> - (l, s_config_info, dump_host [] s) :: acc - | _ -> acc - in - Ocsigen_extensions.set_hosts (List.fold_left f [] !l) - - module Config = Make_config_nested (struct - type nonrec t = t +type instruction = + Ocsigen_extensions.virtual_hosts + -> Ocsigen_extensions.config_info + -> Ocsigen_lib.Url.path + -> Ocsigen_extensions.extension + +let default_re_string = ".*" + +let host ?(regexp = default_re_string) ?port ?default_hostname ?default_httpport + ?default_httpsport ?default_protocol_is_https ?mime_assoc ?charset_assoc + ?default_directory_index ?list_directory_content ?follow_symlinks + ?do_not_serve_404 ?do_not_serve_403 ?uploaddir ?maxuploadfilesize + instructions + = + let def = Ocsigen_extensions.default_config_info () in + let default default o = Option.value o ~default in + let config_info = + { Ocsigen_extensions.default_hostname = + default def.default_hostname default_hostname + ; default_httpport = default def.default_httpport default_httpport + ; default_httpsport = default def.default_httpsport default_httpsport + ; default_protocol_is_https = + default def.default_protocol_is_https default_protocol_is_https + ; mime_assoc = default def.mime_assoc mime_assoc + ; charset_assoc = default def.charset_assoc charset_assoc + ; default_directory_index = + default def.default_directory_index default_directory_index + ; list_directory_content = + default def.list_directory_content list_directory_content + ; follow_symlinks = default def.follow_symlinks follow_symlinks + ; do_not_serve_404 = default def.do_not_serve_404 do_not_serve_404 + ; do_not_serve_403 = default def.do_not_serve_403 do_not_serve_403 + ; uploaddir = default def.uploaddir uploaddir + ; maxuploadfilesize = default def.maxuploadfilesize maxuploadfilesize } + in + let vh = [regexp, Ocsigen_lib.Netstring_pcre.regexp regexp, port] in + ( vh + , config_info + , Ocsigen_extensions.compose + (List.map (fun i -> i vh config_info []) instructions) ) + +let site ?charset path instructions vh config_info parent_path = + let path = parent_path @ Ocsigen_extensions.preprocess_site_path path in + let composite = + Ocsigen_extensions.compose + (List.map (fun i -> i vh config_info path) instructions) + in + Ocsigen_extensions.site_ext composite charset path - 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 main_loop_is_running = ref false -let start ?config () = +let main config = + if !main_loop_is_running then Lwt_log.ign_fatal "Cannot run main loop twice"; + main_loop_is_running := true; try (* initialization functions for modules (Ocsigen extensions or application code) loaded from now on will be executed directly. *) Ocsigen_loader.set_init_on_load true; - (match config with - | Some (_ :: _ :: _) -> - Lwt_log.ign_warning ~section "Multiple servers not supported anymore" - | _ -> ()); let ask_for_passwd sslports _ = print_string "Please enter the password for the HTTPS server listening on port(s) "; @@ -294,10 +202,8 @@ let start ?config () = raise exn in let extensions_connector = Ocsigen_extensions.compute_result in - let run s = - let user = Ocsigen_config.get_user () - and group = Ocsigen_config.get_group () in - Lwt_main.run (Ocsigen_messages.open_files ~user ~group ()); + let run () = + Lwt_main.run (Ocsigen_messages.open_files ()); let ports = Ocsigen_config.get_ports () and ssl_ports = Ocsigen_config.get_ssl_ports () in let connection = match ports with [] -> [`All, 80] | l -> l in @@ -326,46 +232,25 @@ let start ?config () = | l, Some (crt, key) -> List.map (fun (a, p) -> a, p, (crt, key)) l | _ -> [] in - let current_uid = Unix.getuid () in - let gid = - match group with - | None -> Unix.getgid () - | Some group -> ( - try (Unix.getgrnam group).Unix.gr_gid - with Not_found as e -> - Ocsigen_messages.errlog "Error: Wrong group"; - raise e) - in - let uid = - match user with - | None -> current_uid - | Some user -> ( - try (Unix.getpwnam user).Unix.pw_uid - with Not_found as e -> - Ocsigen_messages.errlog "Error: Wrong user"; - raise e) - in (* A pipe to communicate with the server *) let commandpipe = Ocsigen_config.get_command_pipe () in - (try ignore (Unix.stat commandpipe) - with Unix.Unix_error _ -> ( - try - let umask = Unix.umask 0 in - Unix.mkfifo commandpipe 0o660; - Unix.chown commandpipe uid gid; - ignore (Unix.umask umask); - Lwt_log.ign_warning ~section "Command pipe created" - with e -> - Lwt_log.ign_error ~section ~exn:e "Cannot create the command pipe")); - (* I change the user for the process *) - (try - (if current_uid = 0 - 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"; - raise e); + let with_commandpipe = + try + ignore (Unix.stat commandpipe); + true + with Unix.Unix_error _ -> ( + try + let umask = Unix.umask 0 in + Unix.mkfifo commandpipe 0o660; + ignore (Unix.umask umask); + Lwt_log.ign_warning ~section "Command pipe created"; + true + with e -> + Lwt_log.ign_warning_f ~section ~exn:e + "Cannot create the command pipe %s. I will continue without." + commandpipe; + false) + in let minthreads = Ocsigen_config.get_minthreads () and maxthreads = Ocsigen_config.get_maxthreads () in if minthreads > maxthreads @@ -382,19 +267,8 @@ let start ?config () = match e with | Unix.Unix_error (Unix.EPIPE, _, _) -> () | _ -> Lwt_log.ign_error ~section ~exn:e "Uncaught Exception"); - (match s with - | Some s -> - (* Now I can load the modules *) - Dynlink_wrapper.allow_unsafe_modules true; - Ocsigen_extensions.start_initialisation (); - Ocsigen_parseconfig.later_pass s; - (* As libraries are reloaded each time the config file is - read, we do not allow to register extensions in - libraries. Seems it does not work :-/ *) - Dynlink_wrapper.prohibit ["Ocsigen_extensions.R"] - | None -> - Ocsigen_extensions.start_initialisation (); - Site.dump ()); + (* Now apply host configuration: *) + config (); if Ocsigen_config.get_silent () then ( (* Close stderr, stdout stdin if silent *) @@ -407,37 +281,39 @@ let start ?config () = (* detach from the terminal *) if Ocsigen_config.get_daemon () then ignore (Unix.setsid ()); Ocsigen_extensions.end_initialisation (); - let pipe = - Unix.(openfile commandpipe [O_RDWR; O_NONBLOCK; O_APPEND]) 0o660 - |> Lwt_unix.of_unix_file_descr - |> Lwt_io.(of_fd ~mode:input) - in - let rec f () = - Lwt_io.read_line pipe >>= fun s -> - 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) - (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) - >>= f - in - ignore (f ()); + (if with_commandpipe + then + let pipe = + Unix.(openfile commandpipe [O_RDWR; O_NONBLOCK; O_APPEND]) 0o660 + |> Lwt_unix.of_unix_file_descr + |> Lwt_io.(of_fd ~mode:input) + in + let rec f () = + Lwt_io.read_line pipe >>= fun s -> + 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) + (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) + >>= f + in + ignore (f ())); Lwt_main.run @@ Lwt.join (List.map @@ -484,31 +360,94 @@ let start ?config () = ignore (Unix.write_substring f spid 0 len); Unix.close f in - let launch h = - Ocsigen_lib.Option.iter Ocsigen_parseconfig.first_pass h; - (* set_passwd_if_needed sslinfo; *) - if Ocsigen_config.get_daemon () - then - let pid = Unix.fork () in - if pid = 0 - then run h - else ( - Ocsigen_messages.console (fun () -> - "Process " ^ string_of_int pid ^ " detached"); - write_pid pid) + (* set_passwd_if_needed sslinfo; *) + if Ocsigen_config.get_daemon () + then + let pid = Unix.fork () in + if pid = 0 + then run () else ( - write_pid (Unix.getpid ()); - run h) - in - let launch = function - | Some [] -> () - | Some [h] -> launch (Some h) - | None -> launch None - | Some (_ :: _ :: _) -> () - (* Multiple servers not supported any more *) - in - launch config + Ocsigen_messages.console (fun () -> + "Process " ^ string_of_int pid ^ " detached"); + write_pid pid) + else ( + write_pid (Unix.getpid ()); + run ()) with e -> let msg, errno = errmsg e in Ocsigen_messages.errlog msg; exit errno + +let exec config = + Ocsigen_config.has_config_file := true; + match config with + | [] -> () + | [h] -> + (try Ocsigen_parseconfig.first_pass h + with e -> + let msg, errno = errmsg e in + Ocsigen_messages.errlog msg; + exit errno); + main (fun () -> + (* Now I can load the modules *) + Dynlink_wrapper.allow_unsafe_modules true; + Ocsigen_extensions.start_initialisation (); + Ocsigen_parseconfig.later_pass h; + (* As libraries are reloaded each time the config file is + read, we do not allow to register extensions in + libraries. Seems it does not work :-/ *) + Dynlink_wrapper.prohibit ["Ocsigen_extensions.R"]) + | _ :: _ :: _ -> + Lwt_log.ign_warning ~section "Multiple servers not supported anymore" +(* Multiple servers not supported any more *) + +let start ?(ports = [`All, 8080]) ?ssl_ports ?ssl_info ?default_charset ?logdir + ?datadir ?uploaddir ?maxuploadfilesize ?syslog_facility ?configfile + ?usedefaulthostname ?pidfile ?mimefile ?verbose ?veryverbose ?silent ?daemon + ?debug ?debugmode ?minthreads ?maxthreads ?max_number_of_threads_queued + ?max_number_of_connections ?client_timeout ?server_timeout ?shutdown_timeout + ?filebuffersize ?maxrequestbodysize ?maxrequestbodysizeinmemory ?bindir + ?extdir ?command_pipe ?disablepartialrequests ?respect_pipeline ?maxretries + instructions + = + Ocsigen_config.set_ports ports; + Option.iter Ocsigen_config.set_ssl_ports ssl_ports; + Option.iter Ocsigen_config.set_logdir logdir; + Option.iter Ocsigen_config.set_syslog_facility syslog_facility; + Option.iter Ocsigen_config.set_uploaddir uploaddir; + Option.iter Ocsigen_config.set_maxuploadfilesize maxuploadfilesize; + Option.iter Ocsigen_config.set_datadir datadir; + Option.iter Ocsigen_config.set_configfile configfile; + Option.iter Ocsigen_config.set_pidfile pidfile; + Option.iter Ocsigen_config.set_mimefile mimefile; + Option.iter Ocsigen_config.set_verbose verbose; + Option.iter Ocsigen_config.set_silent silent; + Option.iter Ocsigen_config.set_daemon daemon; + Option.iter Ocsigen_config.set_veryverbose veryverbose; + Option.iter Ocsigen_config.set_debug debug; + Option.iter Ocsigen_config.set_minthreads minthreads; + Option.iter Ocsigen_config.set_maxthreads maxthreads; + Option.iter Ocsigen_config.set_max_number_of_threads_queued + max_number_of_threads_queued; + Option.iter Ocsigen_config.set_max_number_of_connections + max_number_of_connections; + Option.iter Ocsigen_config.set_client_timeout client_timeout; + Option.iter Ocsigen_config.set_server_timeout server_timeout; + Option.iter Ocsigen_config.set_filebuffersize filebuffersize; + Option.iter Ocsigen_config.set_maxrequestbodysize maxrequestbodysize; + Option.iter Ocsigen_config.set_maxrequestbodysizeinmemory + maxrequestbodysizeinmemory; + Option.iter Ocsigen_config.set_default_charset default_charset; + Option.iter Ocsigen_config.set_bindir bindir; + Option.iter Ocsigen_config.set_extdir extdir; + Option.iter Ocsigen_config.set_command_pipe command_pipe; + Option.iter Ocsigen_config.set_debugmode debugmode; + Option.iter Ocsigen_config.set_disablepartialrequests disablepartialrequests; + Option.iter Ocsigen_config.set_usedefaulthostname usedefaulthostname; + Option.iter Ocsigen_config.set_respect_pipeline respect_pipeline; + Option.iter Ocsigen_config.set_maxretries maxretries; + Option.iter Ocsigen_config.set_shutdown_timeout shutdown_timeout; + Option.iter Ocsigen_config.set_ssl_info ssl_info; + main (fun () -> + Ocsigen_extensions.start_initialisation (); + Ocsigen_extensions.set_hosts instructions) diff --git a/src/server/ocsigen_server.mli b/src/server/ocsigen_server.mli index 0df134a6f..91562afd0 100644 --- a/src/server/ocsigen_server.mli +++ b/src/server/ocsigen_server.mli @@ -26,51 +26,87 @@ val reload : ?file:string -> unit -> unit [?file] may be used to read the configuration from another file. *) -val start : ?config:Xml.xml list list -> unit -> unit -(** Start the server. Never returns. *) +val exec : Xml.xml list list -> unit +(** Start the server with a configuration file. Never returns. *) -module type Config_nested = sig - type t - type 'a key +val start : + ?ports:(Ocsigen_config.Socket_type.t * int) list + -> ?ssl_ports:(Ocsigen_config.Socket_type.t * int) list + -> ?ssl_info:Ocsigen_config.ssl_info option + -> ?default_charset:string option + -> ?logdir:string + -> ?datadir:string + -> ?uploaddir:string option + -> ?maxuploadfilesize:int64 option + -> ?syslog_facility:Lwt_log.syslog_facility option + -> ?configfile:string + -> ?usedefaulthostname:bool + -> ?pidfile:string + -> ?mimefile:string + -> ?verbose:unit + -> ?veryverbose:unit + -> ?silent:unit + -> ?daemon:unit + -> ?debug:unit + -> ?debugmode:bool + -> ?minthreads:int + -> ?maxthreads:int + -> ?max_number_of_threads_queued:int + -> ?max_number_of_connections:int + -> ?client_timeout:int + -> ?server_timeout:int + -> ?shutdown_timeout:float option + -> ?filebuffersize:int + -> ?maxrequestbodysize:int64 option + -> ?maxrequestbodysizeinmemory:int + -> ?bindir:string + -> ?extdir:string + -> ?command_pipe:string + -> ?disablepartialrequests:bool + -> ?respect_pipeline:unit + -> ?maxretries:int + -> Ocsigen_extensions.host_config list + -> unit +(** Start the server with some instructions. Never returns. + It takes as main parameter a list of virtual hosts (see {!host} below). - val key : ?preprocess:('a -> 'a) -> unit -> 'a key - val find : t -> 'a key -> 'a option - val set : t -> 'a key -> 'a -> unit - val unset : t -> 'a key -> unit +{% Options behave exactly like their <>%} +counterparts. +*) - type accessor = {accessor : 'a. 'a key -> 'a option} -end +type instruction = + Ocsigen_extensions.virtual_hosts + -> Ocsigen_extensions.config_info + -> Ocsigen_lib.Url.path + -> Ocsigen_extensions.extension +(** The type of instructions to be used inside an host or site. + Instructions are defined by extensions (Staticmod, Eliom, etc.) *) -module Site : sig - type t +val host : + ?regexp:string + -> ?port:int + -> ?default_hostname:string + -> ?default_httpport:int + -> ?default_httpsport:int + -> ?default_protocol_is_https:bool + -> ?mime_assoc:Ocsigen_charset_mime.mime_assoc + -> ?charset_assoc:Ocsigen_charset_mime.charset_assoc + -> ?default_directory_index:string list + -> ?list_directory_content:bool + -> ?follow_symlinks:[`Always | `No | `Owner_match] + -> ?do_not_serve_404:Ocsigen_extensions.do_not_serve + -> ?do_not_serve_403:Ocsigen_extensions.do_not_serve + -> ?uploaddir:string option + -> ?maxuploadfilesize:int64 option + -> instruction list + -> Ocsigen_extensions.host_config +(** You can define one or several virtual hosts corresponding to a given + server name or port. *) - 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 - -> unit - -> t - - module Config : Config_nested with type t := t - - type 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) - -> extension - (** Lower-level interface for creating extensions that gives the - extension more info. To be avoided. Currently used by Eliom. *) -end +val site : + ?charset:string + -> Ocsigen_lib.Url.path + -> instruction list + -> instruction +(** Each host may contain some sub-sites corresponding to + subdirectories in the URL.*)