diff --git a/.merlin b/.merlin index a82a2a620..b12033486 100644 --- a/.merlin +++ b/.merlin @@ -8,7 +8,8 @@ PKG cryptokit PKG netstring PKG netstring-pcre PKG ipaddr -PKG tyxml tyxml.parser +PKG tyxml +PKG xml-light PKG camlzip PKG dynlink diff --git a/Makefile.options b/Makefile.options index 8c7e5b6dc..316947056 100644 --- a/Makefile.options +++ b/Makefile.options @@ -1,6 +1,6 @@ BYTEDBG := OPTDBG := -THREAD := +THREAD := -thread ifeq "$(DEBUG)" "YES" BYTEDBG += -g @@ -17,29 +17,22 @@ BYTEDBG := -p ${BYTEDBG} OPTDBG += -p endif -ifeq "$(PREEMPTIVE)" "YES" - THREAD += -thread -endif - ## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable ## but also to generate src/baselib/ocsigen_config.ml and src/files/META -ifeq "$(PREEMPTIVE)" "YES" -LWT_PREEMPTIVE_PACKAGE:=lwt.preemptive -endif - BASE_PACKAGE := lwt ipaddr bytes SERVER_PACKAGE := lwt_ssl \ - bytes \ - ${LWT_PREEMPTIVE_PACKAGE} \ + bytes \ + lwt.unix \ + lwt_log \ ipaddr \ netstring \ netstring-pcre \ findlib \ cryptokit \ tyxml \ - tyxml.parser \ + xml-light \ dynlink \ INITPACKAGE := \"$(shell ${OCAMLFIND} query -p-format -recursive \ diff --git a/configure b/configure index 8e0ff3d4e..1d86ba436 100755 --- a/configure +++ b/configure @@ -81,7 +81,6 @@ set_defaults () { with_pgsql=1 with_camlzip=1 with_dbm=1 - with_preempt=1 prefix="/usr/local" bindir="" logdir="" @@ -108,7 +107,7 @@ full_pwd=`pwd` ## Which options exist? eoptions for enable/disable, woptions for with/without: eoptions="debug annot natdynlink" -woptions="pgsql sqlite dbm camlzip preempt" +woptions="pgsql sqlite dbm camlzip" print_options () { for opt in $eoptions; do @@ -412,7 +411,7 @@ check_library lwt "See: http://ocsigen.org/lwt" check_library lwt.unix "Missing support for 'unix' in lwt." check_library lwt_react "See: http://ocsigen.org/lwt" check_library lwt_ssl "See: http://ocsigen.org/lwt" -check_library lwt.preemptive "Missing support for 'preemptive' in lwt." +check_library lwt_log "See: http://ocsigen.org/lwt" check_library netstring \ "See ocamlnet: http://projects.camlcity.org/projects/ocamlnet.html" @@ -425,6 +424,7 @@ check_library pcre "See: http://ocaml.info/home/ocaml_sources.html" check_library cryptokit "See: http://pauillac.inria.fr/~xleroy/software.html#cryptokit" check_library tyxml "See: http://ocsigen.org/tyxml/" +check_library xml-light "See: https://github.com/ncannasse/xml-light" # Check PostgreSQL case "$with_pgsql" in @@ -462,22 +462,6 @@ if [ "$with_camlzip" -gt 0 ]; then fi fi -# Check Lwt.preemptive -if [ "$with_preempt" -gt 0 ]; then - if test_library lwt.preemptive; then - echo -n - elif [ "$with_preempt" -gt 1 ]; then - fail_library lwt.preemptive "Missing support for 'preemptive' in lwt." - else - with_preempt=0 - fi -fi - -if [ "$with_sqlite" -eq 1 ] && [ "$with_preempt" -eq -1 ]; then - echo "preemptive threads are needed by sqlite, enable it with -with-preempt" - exit 1 -fi - # Check rlwrap or ledit if test_binary rlwrap; then rlwrap=rlwrap @@ -532,11 +516,6 @@ if [ $with_camlzip -gt 0 ] ; then else with_camlzip="NO" fi -if [ $with_preempt -gt 0 ] ; then - with_preempt="YES" -else - with_preempt="NO" -fi ocamlinclude=`ocamlfind printconf stdlib` @@ -588,9 +567,6 @@ OCSIPERSISTPGSQL:=$with_pgsql # Do you want ocsipersist with dbm? YES/NO OCSIPERSISTDBM:=$with_dbm -# Do you want preemptive threads ? YES/NO -PREEMPTIVE:=$with_preempt - # Do you want debugging information (-g) ? YES/NO DEBUG:=$enable_debug diff --git a/doc/manual-wiki/extend.wiki b/doc/manual-wiki/extend.wiki index 0a7fcab14..16fca2c32 100644 --- a/doc/manual-wiki/extend.wiki +++ b/doc/manual-wiki/extend.wiki @@ -4,79 +4,79 @@ This page describes how to extend Ocsigen's server. This can be used to create new ways to generate pages (like Apache modules), to filter and change the requests (for example, rewriting of URLS), to extend the syntax of the configuration file. -Remember to program your extensions in cooperative way using Lwt! +Remember to program your extensions in cooperative way using Lwt! -These features have been introduced in Ocsigen 0.6.0. The extension mechanism will be improved in the future to fit better the needs of developers. As very extensions have been written for now, all this is somewhat experimental, and we look forward to feedback from developers about missing features or problems. +These features have been introduced in Ocsigen 0.6.0. The extension mechanism will be improved in the future to fit better the needs of developers. As very extensions have been written for now, all this is somewhat experimental, and we look forward to feedback from developers about missing features or problems. //Ocsigen is a collaborative project. Contributions are welcome. For example a proxy, a fastCGI module~ ...// -===Filtering the requests or writing a module to generate pages +===Filtering the requests or writing a module to generate pages -You can take as example the files {{{extensiontemplate.ml}}} or {{{staticmod.ml}}} from Ocsigen's distribution. +You can take as example the files {{{extensiontemplate.ml}}} or {{{staticmod.ml}}} from Ocsigen's distribution. -The type of request is {{{Extensions.request_info}}} (have a look at it in the interface of the module {{{Extensions}}}). +The type of request is {{{Extensions.request_info}}} (have a look at it in the interface of the module {{{Extensions}}}). -Each extensions loaded in the configuration file tries to handle the request and returns something of type {{{Extensions.answer}}}. If the page is not found by the extension ({{{Ext_not_found}}}), the following one will try to handle the request. If the page is found, the answer is {{{Ext_found r}}} where {{{r}}} has type {{{Extensions.result}}}. An extension can also modify the request before giving it to the next one (answer {{{Ext_continue_with of Extensions.request_info}}}). +Each extensions loaded in the configuration file tries to handle the request and returns something of type {{{Extensions.answer}}}. If the page is not found by the extension ({{{Ext_not_found}}}), the following one will try to handle the request. If the page is found, the answer is {{{Ext_found r}}} where {{{r}}} has type {{{Extensions.result}}}. An extension can also modify the request before giving it to the next one (answer {{{Ext_continue_with of Extensions.request_info}}}). -To write such an extension, just write a cmo or cma, and use the function Extensions.register_extension to register you extension. This function takes four functions as parameters: -* a function that will be called for each virtual server, generating two functions: -**one that will be called to generate the pages (it has type {{{string option -> request_info -> answer Lwt.t}}}), where the {{{string option}}} is the encoding for characters possibly specified in the configuration file, -**one to parse the configuration file (see next section). -*a function that will be called at the beginning of the initialisation phase (if you need to initialize your extension, otherwise, put the identity). -*a function that will be called at the end of the initialisation phase of the server (if you need to do something here, otherwise the identity function). -*a function that will create an error message from the exceptions that may be raised during the initialisation phase, and raise again all other exceptions. That function has type {{{exn -> string}}}. Use the raise function if you don't need any. +To write such an extension, just write a cmo or cma, and use the function Extensions.register_extension to register you extension. This function takes four functions as parameters: +* a function that will be called for each virtual server, generating two functions: +**one that will be called to generate the pages (it has type {{{string option -> request_info -> answer Lwt.t}}}), where the {{{string option}}} is the encoding for characters possibly specified in the configuration file, +**one to parse the configuration file (see next section). +*a function that will be called at the beginning of the initialisation phase (if you need to initialize your extension, otherwise, put the identity). +*a function that will be called at the end of the initialisation phase of the server (if you need to do something here, otherwise the identity function). +*a function that will create an error message from the exceptions that may be raised during the initialisation phase, and raise again all other exceptions. That function has type {{{exn -> string}}}. Use the raise function if you don't need any. -Example (from {{{staticmod.ml}}}): +Example (from {{{staticmod.ml}}}): {{{ let _ = register_extension - ((fun _ -> - let page_tree = - try + ((fun _ -> + let page_tree = + try find hostpattern with Not_found -> let n = new_pages_tree () in add hostpattern n; n in - (gen page_tree, + (gen page_tree, parse_config page_tree)), start_init, end_init, raise) }}} -While writing extensions, be very careful about site reloading. The initialisation phase will start again at each reloading, and the function you register will be called for each virtual at each reloading. +While writing extensions, be very careful about site reloading. The initialisation phase will start again at each reloading, and the function you register will be called for each virtual at each reloading. -===Filtering the outputs +===Filtering the outputs It is also possible to create extensions that will filter the output of the server (for example to compress it). It is very similar to the previous one. Basically, use {{{Extensions.register_output_filter}}} instead of {{{Extensions.register_extension}}}. Have a look at the file {{{deflatemod.ml}}} for an example. -===Extending the configuration file +===Extending the configuration file -====Extending the configuration file for an extension +====Extending the configuration file for an extension - The parsing of Ocsigen's configuration file is using a very basic xml parser (module {{{Simplexmlparser}}}). The function to be registered by the {{{Extensions.register_extension}}} function takes two parameters: the path of the web site and the xml subtree. + The parsing of Ocsigen's configuration file is using a very basic xml parser (package {{{xml-light}}}). The function to be registered by the {{{Extensions.register_extension}}} function takes two parameters: the path of the web site and the xml subtree. {{{ let parse_config path = function - Simplexmlparser.Element ("tag", attr, content) -> ... + Xml.Element ("tag", attr, content) -> ... (* Do what you want here *) - | Simplexmlparser.Element _ -> + | Xml.Element _ -> raise (Extensions.Bad_config_tag_for_extension t) | _ -> raise (Extensions.Error_in_config_file "(my extension)") }}} -The module {{{Parseconfig}}} defines functions to parse strings or sizes (in bytes, GB etc). +The module {{{Parseconfig}}} defines functions to parse strings or sizes (in bytes, GB etc). -====Giving parameters to an extension +====Giving parameters to an extension //Warning: This is experimental. Please report your experience if you use it.// -Extensions may take parameters in the configuration file. During the loading of the extension, the function {{{Extensions.get_config ()}}} returns the xml tree between {{{}}} and {{{}}} (or {{{}}} and {{{}}}). Write a parser for that tree. +Extensions may take parameters in the configuration file. During the loading of the extension, the function {{{Extensions.get_config ()}}} returns the xml tree between {{{}}} and {{{}}} (or {{{}}} and {{{}}}). Write a parser for that tree. -===Catching the request before it is fully read +===Catching the request before it is fully read -For some extensions of the Web server, it is necessary to catch the request before it has been fully read (especially before the body of the request has been read). For example it is the case if you want to write a (reverse) proxy. +For some extensions of the Web server, it is necessary to catch the request before it has been fully read (especially before the body of the request has been read). For example it is the case if you want to write a (reverse) proxy. //Warning: This is experimental. Please report your experience if you use it.// @@ -94,10 +94,9 @@ It takes as parameter a function of type If you want to add your own commands for the server command pipe, do something like: {{{ -let () = +let () = Ocsigen_extensions.register_command_function ~prefix:"yourextensionname" (fun s c -> match c with | ["mycommand"] -> ... | _ -> raise Ocsigen_extensions.Unknown_command) }}} - diff --git a/opam b/opam index 7e845243f..63387939f 100644 --- a/opam +++ b/opam @@ -48,16 +48,17 @@ depends: [ "base-threads" "react" "ssl" - "lwt" {>= "3.0.0" & < "4.0.0"} + "lwt" {>= "3.0.0"} "lwt_ssl" "lwt_react" + "lwt_log" "ocamlnet" {>= "4.0.2"} "pcre" "cryptokit" "tyxml" {>= "4.0.0"} ("dbm" | "sqlite3" | "pgocaml") "ipaddr" {>= "2.1"} - "camlp4" # to force building tyxml.parser + "xml-light" ] depopts: "camlzip" conflicts: [ diff --git a/src/baselib/Makefile b/src/baselib/Makefile index 798dab7ce..266209076 100644 --- a/src/baselib/Makefile +++ b/src/baselib/Makefile @@ -3,6 +3,7 @@ include ../../Makefile.config PACKAGE := \ bytes \ lwt.unix \ + lwt_log \ netstring \ netstring-pcre \ cryptokit \ @@ -57,12 +58,6 @@ else NATIVECODE_RUNTIME_DETECT=false endif -ifeq "$(PREEMPTIVE)" "YES" - PREEMTIMPLEM=Lwt_preemptive -else - PREEMTIMPLEM=Fake_preempt -endif - VERSION := $(shell head -n 1 ../../VERSION) ocsigen_config.ml: ocsigen_config.ml.in ../../Makefile.config ../../Makefile.options ../../VERSION @@ -80,7 +75,6 @@ ocsigen_config.ml: ocsigen_config.ml.in ../../Makefile.config ../../Makefile.opt | sed s%_PROJECTNAME_%$(PROJECTNAME)%g \ | sed s%_COMMANDPIPE_%$(COMMANDPIPE)%g \ | sed s%_CONFIGDIR_%$(CONFIGDIR)% \ - | sed s%_PREEMTIMPLEM_%$(PREEMTIMPLEM)% \ | sed s%_ISNATIVE_%$(NATIVECODE_RUNTIME_DETECT)%g \ | sed "s%_DEPS_%$(INITPACKAGE)%g" \ > ocsigen_config.ml diff --git a/src/baselib/ocsigen_config.ml.in b/src/baselib/ocsigen_config.ml.in index 328fa8906..14e7658d2 100644 --- a/src/baselib/ocsigen_config.ml.in +++ b/src/baselib/ocsigen_config.ml.in @@ -38,13 +38,6 @@ let native_ext = if is_native then ".opt" else "" let builtin_packages = List.fold_left (fun a s -> String.Set.add s a) String.Set.empty [_DEPS_] -module Fake_preempt = -struct - let set_max_number_of_threads_queued : int -> unit = fun _ -> () - let get_max_number_of_threads_queued : unit -> int = fun () -> 0 - let init : int -> int -> (string -> unit) -> unit = fun _ _ _ -> () -end - (* Server config: *) let (uploaddir : string option ref) = ref None let logdir = ref (Some ("_LOGDIR_")) @@ -97,7 +90,7 @@ let set_veryverbose () = let set_minthreads i = minthreads := i let set_maxthreads i = maxthreads := i let set_max_number_of_threads_queued = - _PREEMTIMPLEM_.set_max_number_of_threads_queued + Lwt_preemptive.set_max_number_of_threads_queued let set_max_number_of_connections i = max_number_of_connections := i let set_client_timeout i = silent_client_timeout := i let set_server_timeout i = silent_server_timeout := i @@ -143,7 +136,7 @@ let get_default_group () = !default_group let get_minthreads () = !minthreads let get_maxthreads () = !maxthreads let get_max_number_of_threads_queued = - _PREEMTIMPLEM_.get_max_number_of_threads_queued + Lwt_preemptive.get_max_number_of_threads_queued let get_max_number_of_connections () = !max_number_of_connections let get_client_timeout () = !silent_client_timeout let get_server_timeout () = !silent_server_timeout @@ -175,5 +168,4 @@ let display_version () = print_newline (); exit 0 -let init_preempt = - _PREEMTIMPLEM_.init +let init_preempt = Lwt_preemptive.init diff --git a/src/baselib/ocsigen_stream.ml b/src/baselib/ocsigen_stream.ml index 5b17f1fc1..3e314f0ab 100644 --- a/src/baselib/ocsigen_stream.ml +++ b/src/baselib/ocsigen_stream.ml @@ -229,10 +229,10 @@ let of_file filename = let fd = Lwt_unix.of_unix_file_descr (Unix.openfile filename [Unix.O_RDONLY;Unix.O_NONBLOCK] 0o666) in - let ch = Lwt_chan.in_channel_of_descr fd in + let ch = Lwt_io.of_fd ~mode:Lwt_io.input fd in let buf = Bytes.create 1024 in let rec aux () = - Lwt_chan.input ch buf 0 1024 >>= fun n -> + Lwt_io.read_into ch buf 0 1024 >>= fun n -> if n = 0 then empty None else (* Streams should be immutable, thus we always make a copy of the buffer *) diff --git a/src/extensions/Makefile b/src/extensions/Makefile index 0d155091b..d854c4445 100644 --- a/src/extensions/Makefile +++ b/src/extensions/Makefile @@ -3,12 +3,13 @@ include ../../Makefile.config PACKAGE := \ bytes \ lwt.unix \ + lwt_log \ ipaddr \ lwt_ssl \ lwt_react \ netstring \ netstring-pcre \ - tyxml.parser + xml-light LIBS := -I ../baselib -I ../http -I ../server ${addprefix -package ,${PACKAGE}} OCAMLC := $(OCAMLFIND) ocamlc ${BYTEDBG} ${THREAD} diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml index 4f48f4cfd..0a586a9c3 100644 --- a/src/extensions/accesscontrol.ml +++ b/src/extensions/accesscontrol.ml @@ -32,7 +32,6 @@ open Ocsigen_lib open Printf open Lwt open Ocsigen_extensions -open Simplexmlparser open Ocsigen_http_frame @@ -43,7 +42,7 @@ let section = Lwt_log.Section.make "ocsigen:ext:access-control" let rec parse_condition = function - | Element ("ip", ["value", s], []) -> + | Xml.Element ("ip", ["value", s], []) -> let prefix = try Ipaddr.Prefix.of_string_exn s @@ -67,9 +66,9 @@ let rec parse_condition = function "IP: %a does not match %s" (fun () -> Ocsigen_request_info.remote_ip) ri s; r) - | Element ("ip" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("ip" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("port", ["value", s], []) -> + | Xml.Element ("port", ["value", s], []) -> let port = try int_of_string s @@ -87,9 +86,9 @@ let rec parse_condition = function (fun () ri -> string_of_int (Ocsigen_request_info.server_port ri)) ri port; r) - | Element ("port" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("port" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("ssl", [], []) -> + | Xml.Element ("ssl", [], []) -> (fun ri -> let r = Ocsigen_request_info.ssl ri in if r then @@ -97,9 +96,9 @@ let rec parse_condition = function else Lwt_log.ign_info ~section "SSL: not accepted"; r) - | Element ("ssl" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("ssl" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("header", ["name", name; "regexp", reg], []) -> + | Xml.Element ("header", ["name", name; "regexp", reg], []) -> let regexp = try Netstring_pcre.regexp ("^"^reg^"$") @@ -126,9 +125,9 @@ let rec parse_condition = function if not r then Lwt_log.ign_info_f "HEADER: header %s does not match %S" name reg; r) - | Element ("header" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("header" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("method", ["value", s], []) -> + | Xml.Element ("method", ["value", s], []) -> let meth = try Framepp.method_of_string s @@ -146,9 +145,9 @@ let rec parse_condition = function "METHOD: %a does not match %s" (fun () ri -> Framepp.string_of_method (Ocsigen_request_info.meth ri)) ri s; r) - | Element ("method" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("method" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("protocol", ["value", s], []) -> + | Xml.Element ("protocol", ["value", s], []) -> let pr = try Framepp.proto_of_string s @@ -166,9 +165,9 @@ let rec parse_condition = function "PROTOCOL: %a does not match %s" (fun () ri -> Framepp.string_of_proto (Ocsigen_request_info.protocol ri)) ri s; r) - | Element ("protocol" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("protocol" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("path", ["regexp", s], []) -> + | Xml.Element ("path", ["regexp", s], []) -> let regexp = try Netstring_pcre.regexp ("^"^s^"$") @@ -189,22 +188,22 @@ let rec parse_condition = function "PATH: \"%a\" does not match %S" (fun () ri -> Ocsigen_request_info.sub_path_string ri) ri s; r) - | Element ("path" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("path" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("and", [], sub) -> + | Xml.Element ("and", [], sub) -> let sub = List.map parse_condition sub in (fun ri -> List.for_all (fun cond -> cond ri) sub) - | Element ("and" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("and" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("or", [], sub) -> + | Xml.Element ("or", [], sub) -> let sub = List.map parse_condition sub in (fun ri -> List.exists (fun cond -> cond ri) sub) - | Element ("or" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("or" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("not", [], [sub]) -> + | Xml.Element ("not", [], [sub]) -> let sub = parse_condition sub in (fun ri -> not (sub ri)) - | Element ("not" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("not" as s, _, _) -> badconfig "Bad syntax for tag %s" s | _ -> badconfig "Bad syntax for condition" @@ -217,17 +216,17 @@ let comma_space_regexp = Netstring_pcre.regexp "\ *,\ *" let parse_config parse_fun = function - | Element ("if", [], sub) -> + | Xml.Element ("if", [], sub) -> let (condition, sub) = match sub with | cond::q -> (parse_condition cond, q) | _ -> badconfig "Bad condition in " in let (ithen, sub) = match sub with - | Element("then", [], ithen)::q -> (parse_fun ithen, q) + | Xml.Element("then", [], ithen)::q -> (parse_fun ithen, q) | _ -> badconfig "Bad branch in " in let (ielse, sub) = match sub with - | Element ("else", [], ielse)::([] as q) -> (parse_fun ielse, q) + | Xml.Element ("else", [], ielse)::([] as q) -> (parse_fun ielse, q) | [] -> (parse_fun [], []) | _ -> badconfig "Bad branch in " in @@ -243,17 +242,17 @@ let parse_config parse_fun = function Lwt_log.ign_info ~section "COND: going into branch, if any"; Ocsigen_extensions.Ext_sub_result ielse end)) - | Element ("if" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("if" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("notfound", [], []) -> + | Xml.Element ("notfound", [], []) -> (fun rs -> Lwt_log.ign_info ~section "NOT_FOUND: taking in charge 404"; Lwt.return (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookies.Cookies.empty, 404))) - | Element ("notfound" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("notfound" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("nextsite", [], []) -> + | Xml.Element ("nextsite", [], []) -> (function | Ocsigen_extensions.Req_found (_, r) -> Lwt.return (Ocsigen_extensions.Ext_found_stop @@ -262,7 +261,7 @@ let parse_config parse_fun = function Lwt.return (Ocsigen_extensions.Ext_stop_site (Ocsigen_cookies.Cookies.empty, 404))) - | Element ("nexthost", [], []) -> + | Xml.Element ("nexthost", [], []) -> (function | Ocsigen_extensions.Req_found (_, r) -> Lwt.return (Ocsigen_extensions.Ext_found_stop @@ -270,9 +269,9 @@ let parse_config parse_fun = function | Ocsigen_extensions.Req_not_found (err, ri) -> Lwt.return (Ocsigen_extensions.Ext_stop_host (Ocsigen_cookies.Cookies.empty, 404))) - | Element ("nextsite" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("nextsite" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("stop", [], []) -> + | Xml.Element ("stop", [], []) -> (function | Ocsigen_extensions.Req_found (_, r) -> Lwt.return (Ocsigen_extensions.Ext_found_stop @@ -280,25 +279,25 @@ let parse_config parse_fun = function | Ocsigen_extensions.Req_not_found (err, ri) -> Lwt.return (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookies.Cookies.empty, 404))) - | Element ("stop" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("stop" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("forbidden", [], []) -> + | Xml.Element ("forbidden", [], []) -> (fun rs -> Lwt_log.ign_info ~section "FORBIDDEN: taking in charge 403"; Lwt.return (Ocsigen_extensions.Ext_stop_all (Ocsigen_cookies.Cookies.empty, 403))) - | Element ("forbidden" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("forbidden" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("iffound", [], sub) -> + | Xml.Element ("iffound", [], sub) -> let ext = parse_fun sub in (function | Ocsigen_extensions.Req_found (_, _) -> Lwt.return (Ext_sub_result ext) | Ocsigen_extensions.Req_not_found (err, ri) -> Lwt.return (Ocsigen_extensions.Ext_next err)) - | Element ("iffound" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("iffound" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("ifnotfound", [], sub) -> + | Xml.Element ("ifnotfound", [], sub) -> let ext = parse_fun sub in (function | Ocsigen_extensions.Req_found (_, r) -> @@ -306,7 +305,7 @@ let parse_config parse_fun = function (fun () -> Lwt.return r)) | Ocsigen_extensions.Req_not_found (err, ri) -> Lwt.return (Ext_sub_result ext)) - | Element ("ifnotfound", [("code", s)], sub) -> + | Xml.Element ("ifnotfound", [("code", s)], sub) -> let ext = parse_fun sub in let r = Netstring_pcre.regexp ("^"^s^"$") in (function @@ -318,9 +317,9 @@ let parse_config parse_fun = function Lwt.return (Ext_sub_result ext) else Lwt.return (Ocsigen_extensions.Ext_next err)) - | Element ("ifnotfound" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("ifnotfound" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("allow-forward-for", param, _) -> + | Xml.Element ("allow-forward-for", param, _) -> let apply request code = Lwt_log.ign_info ~section "Allowed proxy"; let request = @@ -372,7 +371,7 @@ let parse_config parse_fun = function apply request (Ocsigen_http_frame.Result.code resp) | Ocsigen_extensions.Req_not_found (code, request) -> apply request code) - | Element ("allow-forward-proto", _, _) -> + | Xml.Element ("allow-forward-proto", _, _) -> let apply request code = Lwt_log.ign_info ~section "Allowed proxy for ssl"; let request = @@ -406,7 +405,7 @@ let parse_config parse_fun = function | Ocsigen_extensions.Req_found (request, resp) -> apply request (Ocsigen_http_frame.Result.code resp) | Ocsigen_extensions.Req_not_found (code, request) -> apply request code) - | Element (t, _, _) -> raise (Bad_config_tag_for_extension t) + | Xml.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) | _ -> badconfig "(accesscontrol extension) Bad data" diff --git a/src/extensions/accesscontrol.mli b/src/extensions/accesscontrol.mli index 06a98bdae..24165bb19 100644 --- a/src/extensions/accesscontrol.mli +++ b/src/extensions/accesscontrol.mli @@ -20,4 +20,4 @@ val parse_condition : - Simplexmlparser.xml -> Ocsigen_extensions.request_info -> bool + Xml.xml -> Ocsigen_extensions.request_info -> bool diff --git a/src/extensions/authbasic.ml b/src/extensions/authbasic.ml index 779bce82e..75bdaf20c 100644 --- a/src/extensions/authbasic.ml +++ b/src/extensions/authbasic.ml @@ -55,7 +55,7 @@ let register_basic_authentication_method, get_basic_authentication_method = (* Basic authentication with a predefined login/password (example) *) let _ = - let open Simplexmlparser in + let open Xml in register_basic_authentication_method (function | Element ("plain", ["login", login; "password", password], _) -> @@ -133,7 +133,7 @@ let parse_config element = ] ~other_elements:(fun name attrs content -> rest_ref := - Simplexmlparser.Element (name, attrs, content) :: !rest_ref) + Xml.Element (name, attrs, content) :: !rest_ref) ()] element ); diff --git a/src/extensions/authbasic.mli b/src/extensions/authbasic.mli index 60b14ba7a..a00c9e32a 100644 --- a/src/extensions/authbasic.mli +++ b/src/extensions/authbasic.mli @@ -34,7 +34,7 @@ val register_basic_authentication_method : - (Simplexmlparser.xml -> string -> string -> bool Lwt.t) -> unit + (Xml.xml -> string -> string -> bool Lwt.t) -> unit (** This function registers an authentication plugin: it adds a new parser to the list of available authentication schemes. @@ -55,7 +55,7 @@ val register_basic_authentication_method : val get_basic_authentication_method : - Simplexmlparser.xml -> string -> string -> bool Lwt.t + Xml.xml -> string -> string -> bool Lwt.t (** This function combines all the parsers registered with [register_basic_authentication_method]. It might be useful for other extensions. Not for the casual user. *) diff --git a/src/extensions/cgimod.ml b/src/extensions/cgimod.ml index 44cf546cd..6dbaf2ef4 100644 --- a/src/extensions/cgimod.ml +++ b/src/extensions/cgimod.ml @@ -28,7 +28,6 @@ open Ocsigen_lib open Lwt open Ocsigen_extensions -open Simplexmlparser open Ocsigen_http_frame open Ocsigen_http_com open Ocsigen_senders @@ -307,7 +306,25 @@ let create_process_cgi filename ri post_out cgi_in err_in re doc_root hostname = cgi_in err_in - +(* Copied from deprecated [Lwt_chan]. *) +let lwt_chan_input_line ic = + let rec loop buf = + Lwt_io.read_char_opt ic >>= function + | None | Some '\n' -> + Lwt.return (Buffer.contents buf) + | Some char -> + Buffer.add_char buf char; + loop buf + in + Lwt_io.read_char_opt ic >>= function + | Some '\n' -> + Lwt.return "" + | Some char -> + let buf = Buffer.create 128 in + Buffer.add_char buf char; + loop buf + | None -> + Lwt.fail End_of_file (** This function makes it possible to launch a cgi script *) @@ -368,7 +385,7 @@ let recupere_cgi head re doc_root filename ri hostname = Lwt_timeout.start timeout; (* A thread giving POST data to the CGI script: *) - let post_in_ch = Lwt_chan.out_channel_of_descr post_in in + let post_in_ch = Lwt_io.of_fd ~mode:Lwt_io.output post_in in ignore (catch (fun () -> @@ -376,7 +393,7 @@ let recupere_cgi head re doc_root filename ri hostname = | None -> Lwt_unix.close post_in | Some content_post -> Ocsigen_http_com.write_stream post_in_ch content_post >>= fun () -> - Lwt_chan.flush post_in_ch >>= fun () -> + Lwt_io.flush post_in_ch >>= fun () -> Lwt_unix.close post_in )) (*XXX Check possible errors! *) @@ -391,9 +408,9 @@ let recupere_cgi head re doc_root filename ri hostname = (* A thread listening the error output of the CGI script and writing them in warnings.log *) - let err_channel = Lwt_chan.in_channel_of_descr err_out in + let err_channel = Lwt_io.of_fd ~mode:Lwt_io.input err_out in let rec get_errors () = - Lwt_chan.input_line err_channel >>= fun err -> + lwt_chan_input_line err_channel >>= fun err -> Lwt_log.ign_warning ~section err; get_errors () in ignore @@ -456,7 +473,7 @@ let get_content str = (*****************************************************************************) let rec parse_global_config = function | [] -> () - | (Element ("cgitimeout", [("value", s)], []))::[] -> + | (Xml.Element ("cgitimeout", [("value", s)], []))::[] -> cgitimeout := int_of_string s | _ -> raise (Error_in_config_file ("Unexpected content inside cgimod config")) @@ -573,7 +590,7 @@ let gen reg = function let rec set_env = function | [] -> [] - | (Element("setenv", [("var",vr);("val",vl)], []))::l -> + | (Xml.Element("setenv", [("var",vr);("val",vl)], []))::l -> if List.mem vr environment then (Lwt_log.ign_info_f ~section "Variable no set %s" vr; set_env l) @@ -581,7 +598,7 @@ let rec set_env = function | _ :: l -> raise (Error_in_config_file "Bad config tag for ") let parse_config _ path _ _ = function - | Element ("cgi", atts, l) -> + | Xml.Element ("cgi", atts, l) -> let good_root r = Regexp.quote (string_conform2 r) in diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml index 0f5100077..64860233f 100644 --- a/src/extensions/deflatemod.ml +++ b/src/extensions/deflatemod.ml @@ -26,7 +26,6 @@ open Ocsigen_lib open Lwt open Ocsigen_extensions -open Simplexmlparser open Ocsigen_headers let section = Lwt_log.Section.make "ocsigen:ext:deflate" @@ -303,13 +302,13 @@ let filter choice_list = function let rec parse_global_config = function | [] -> () - | (Element ("compress", [("level", l)], []))::ll -> + | (Xml.Element ("compress", [("level", l)], []))::ll -> let l = try int_of_string l with Failure _ -> raise (Error_in_config_file "Compress level should be an integer between 0 and 9") in compress_level := if (l <= 9 && l >= 0) then l else 6 ; parse_global_config ll - | (Element ("buffer", [("size", s)], []))::ll -> + | (Xml.Element ("buffer", [("size", s)], []))::ll -> let s = (try int_of_string s with Failure _ -> raise (Error_in_config_file "Buffer size should be a positive integer")) in @@ -317,7 +316,7 @@ let rec parse_global_config = function parse_global_config ll (* TODO: Pas de filtre global pour l'instant * le nom de balise contenttype est mauvais, au passage - | (Element ("contenttype", [("compress", b)], choices))::ll -> + | (Xml.Element ("contenttype", [("compress", b)], choices))::ll -> let l = (try parse_filter choices with Not_found -> raise (Error_in_config_file "Can't parse mime-type content")) in diff --git a/src/extensions/extendconfiguration.ml b/src/extensions/extendconfiguration.ml index 8de0e7dd7..aa6ed7a31 100644 --- a/src/extensions/extendconfiguration.ml +++ b/src/extensions/extendconfiguration.ml @@ -19,7 +19,6 @@ *) open Lwt open Ocsigen_extensions -open Simplexmlparser open Ocsigen_charset_mime @@ -50,11 +49,11 @@ let gather_do_not_serve_files tag = do_not_serve_extensions = extensions } - | Element ("regexp", ["regexp", f], []) :: q -> + | Xml.Element ("regexp", ["regexp", f], []) :: q -> aux (f :: regexps, files, extensions) q - | Element ("file", ["file", f], []) :: q -> + | Xml.Element ("file", ["file", f], []) :: q -> aux (regexps, f :: files, extensions) q - | Element ("extension", ["ext", f], []) :: q -> + | Xml.Element ("extension", ["ext", f], []) :: q -> aux (regexps, files, f :: extensions) q | _ :: q -> bad_config ("invalid options in tag " ^ tag) @@ -78,14 +77,14 @@ let check_regexp_list = let update_config usermode = function - | Element ("listdirs", ["value", "true"], []) -> + | Xml.Element ("listdirs", ["value", "true"], []) -> gen (fun config -> { config with list_directory_content = true }) - | Element ("listdirs", ["value", "false"], []) -> + | Xml.Element ("listdirs", ["value", "false"], []) -> gen (fun config -> { config with list_directory_content = false }) - | Element ("listdirs" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("listdirs" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("followsymlinks", ["value", s], []) -> + | Xml.Element ("followsymlinks", ["value", s], []) -> let v = match s with | "never" -> DoNotFollowSymlinks | "always" -> @@ -100,17 +99,17 @@ let update_config usermode = function bad_config ("Wrong value \""^s^"\" for option \"followsymlinks\"") in gen (fun config -> { config with follow_symlinks = v }) - | Element ("followsymlinks" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("followsymlinks" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("charset", attrs, exts) -> + | Xml.Element ("charset", attrs, exts) -> let rec aux charset_assoc = function | [] -> charset_assoc - | Element ("extension", ["ext", extension; "value", charset], []) :: q -> + | Xml.Element ("extension", ["ext", extension; "value", charset], []) :: q -> aux (update_charset_ext charset_assoc extension charset) q - | Element ("file", ["file", file; "value", charset], []) :: q -> + | Xml.Element ("file", ["file", file; "value", charset], []) :: q -> aux (update_charset_file charset_assoc file charset) q - | Element ("regexp", ["regexp", regexp; "value", charset], []) :: q -> + | Xml.Element ("regexp", ["regexp", regexp; "value", charset], []) :: q -> (try let r = Netstring_pcre.regexp regexp in aux (update_charset_regexp charset_assoc r charset) q @@ -129,14 +128,14 @@ let update_config usermode = function { config with charset_assoc = aux config.charset_assoc exts }) - | Element ("contenttype", attrs, exts) -> + | Xml.Element ("contenttype", attrs, exts) -> let rec aux mime_assoc = function | [] -> mime_assoc - | Element ("extension", ["ext", extension; "value", mime], []) :: q -> + | Xml.Element ("extension", ["ext", extension; "value", mime], []) :: q -> aux (update_mime_ext mime_assoc extension mime) q - | Element ("file", ["file", file; "value", mime], []) :: q -> + | Xml.Element ("file", ["file", file; "value", mime], []) :: q -> aux (update_mime_file mime_assoc file mime) q - | Element ("regexp", ["regexp", regexp; "value", mime], []) :: q -> + | Xml.Element ("regexp", ["regexp", regexp; "value", mime], []) :: q -> (try let r = Netstring_pcre.regexp regexp in aux (update_mime_regexp mime_assoc r mime) q @@ -155,10 +154,10 @@ let update_config usermode = function { config with mime_assoc = aux config.mime_assoc exts }) - | Element ("defaultindex", [], l) -> + | Xml.Element ("defaultindex", [], l) -> let rec aux indexes = function | [] -> List.rev indexes - | Element ("index", [], [PCData f]) :: q -> + | Xml.Element ("index", [], [PCData f]) :: q -> aux (f :: indexes) q | _ :: q -> bad_config "subtags must be of the form \ ... \ @@ -166,9 +165,9 @@ let update_config usermode = function in gen (fun config -> { config with default_directory_index = aux [] l }) - | Element ("defaultindex" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("defaultindex" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("hidefile", [], l) -> + | Xml.Element ("hidefile", [], l) -> let do_not_serve = gather_do_not_serve_files "hidefile" l in (try check_regexp_list do_not_serve.do_not_serve_regexps; @@ -177,9 +176,9 @@ let update_config usermode = function join_do_not_serve do_not_serve config.do_not_serve_404 }) with Bad_regexp r -> badconfig "Invalid regexp %s in %s" r "hidefile") - | Element ("hidefile" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("hidefile" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("forbidfile", [], l) -> + | Xml.Element ("forbidfile", [], l) -> let do_not_serve = gather_do_not_serve_files "forbidfile" l in (try check_regexp_list do_not_serve.do_not_serve_regexps; @@ -188,28 +187,28 @@ let update_config usermode = function join_do_not_serve do_not_serve config.do_not_serve_403 }) with Bad_regexp r -> badconfig "Invalid regexp %s in %s" r "forbidfile") - | Element ("forbidfile" as s, _, _) -> badconfig "Bad syntax for tag %s" s + | Xml.Element ("forbidfile" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("uploaddir", [], [PCData s]) -> + | Xml.Element ("uploaddir", [], [PCData s]) -> if s = "" then gen (fun config -> { config with uploaddir = None }) else gen (fun config -> { config with uploaddir = Some s }) - | Element ("uploaddir" as s, _, _) -> + | Xml.Element ("uploaddir" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element ("maxuploadfilesize" as tag, [], [PCData s]) -> + | Xml.Element ("maxuploadfilesize" as tag, [], [PCData s]) -> let s = try Ocsigen_parseconfig.parse_size_tag "uploaddir" s with Ocsigen_config.Config_file_error _ -> badconfig "Bad syntax for tag %s" tag in gen (fun config -> { config with maxuploadfilesize = s }) - | Element ("maxuploadfilesize" as s, _, _) -> + | Xml.Element ("maxuploadfilesize" as s, _, _) -> badconfig "Bad syntax for tag %s" s - | Element (t, _, _) -> raise (Bad_config_tag_for_extension t) + | Xml.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) | _ -> raise (Error_in_config_file "Unexpected data in config file") diff --git a/src/extensions/extensiontemplate.ml b/src/extensions/extensiontemplate.ml index 80edff9f8..ee3deccfc 100644 --- a/src/extensions/extensiontemplate.ml +++ b/src/extensions/extensiontemplate.ml @@ -41,9 +41,6 @@ open Lwt open Ocsigen_extensions -open Simplexmlparser - - (*****************************************************************************) (** Extensions may take some options from the config file. @@ -58,7 +55,7 @@ open Simplexmlparser let rec parse_global_config = function | [] -> () - | (Element ("myoption", [("myattr", s)], []))::ll -> () + | (Xml.Element ("myoption", [("myattr", s)], []))::ll -> () | _ -> raise (Error_in_config_file ("Unexpected content inside extensiontemplate config")) @@ -126,8 +123,8 @@ let gen = function *) let parse_config path _ parse_site = function - | Element ("extensiontemplate", atts, []) -> gen - | Element (t, _, _) -> raise (Bad_config_tag_for_extension t) + | Xml.Element ("extensiontemplate", atts, []) -> gen + | Xml.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) | _ -> raise (Error_in_config_file "Unexpected data in config file") @@ -173,7 +170,7 @@ let exn_handler = raise {- raise [Bad_config_tag_for_extension] if it does not recognize that tag} {- return something of type [extension] (filter or page generator)}} *) -let site_creator +let site_creator (hostpattern : Ocsigen_extensions.virtual_hosts) (config_info : Ocsigen_extensions.config_info) = parse_config @@ -207,4 +204,3 @@ let () = register_extension ~begin_init ~end_init ~exn_handler () - diff --git a/src/extensions/ocsipersist-dbm/Makefile b/src/extensions/ocsipersist-dbm/Makefile index 2bdc44ed9..45064a32e 100644 --- a/src/extensions/ocsipersist-dbm/Makefile +++ b/src/extensions/ocsipersist-dbm/Makefile @@ -1,9 +1,6 @@ include ../../../Makefile.config -PACKAGE := ${LWT_PREEMPTIVE_PACKAGE} \ - lwt.unix \ - tyxml.parser \ - dbm \ +PACKAGE := lwt.unix lwt_log xml-light dbm LIBS := -I ../../baselib -I ../../http -I ../../server \ ${addprefix -package ,${PACKAGE}} diff --git a/src/extensions/ocsipersist-dbm/ocsidbm.ml b/src/extensions/ocsipersist-dbm/ocsidbm.ml index b5686ecf7..d3366d769 100644 --- a/src/extensions/ocsipersist-dbm/ocsidbm.ml +++ b/src/extensions/ocsipersist-dbm/ocsidbm.ml @@ -198,8 +198,8 @@ let _ = Unix.setsid () (** Communication functions: *) let send outch v = - Lwt_chan.output_value outch v >>= - (fun () -> Lwt_chan.flush outch) + Lwt_io.write_value outch v >>= fun () -> + Lwt_io.flush outch let execute outch = let handle_errors f = try f () with e -> send outch (Error e) in @@ -241,9 +241,9 @@ let execute outch = let nb_clients = ref 0 let rec listen_client inch outch = - Lwt_chan.input_value inch >>= - (fun v -> execute outch v) >>= - (fun () -> listen_client inch outch) + Lwt_io.read_value inch >>= fun v -> + execute outch v >>= fun () -> + listen_client inch outch let finish _ = nb_clients := !nb_clients - 1; @@ -260,8 +260,8 @@ let rec loop socket = ignore ( b := true; nb_clients := !nb_clients + 1; - let inch = Lwt_chan.in_channel_of_descr indescr in - let outch = Lwt_chan.out_channel_of_descr indescr in + let inch = Lwt_io.of_fd ~mode:Lwt_io.input indescr in + let outch = Lwt_io.of_fd ~mode:Lwt_io.output indescr in catch (fun () -> listen_client inch outch >>= finish) finish); @@ -344,4 +344,3 @@ let _ = Lwt_main.run in ignore (f ()) *) - diff --git a/src/extensions/ocsipersist-dbm/ocsipersist.ml b/src/extensions/ocsipersist-dbm/ocsipersist.ml index b6e52ffae..f7a256c5f 100644 --- a/src/extensions/ocsipersist-dbm/ocsipersist.ml +++ b/src/extensions/ocsipersist-dbm/ocsipersist.ml @@ -38,26 +38,25 @@ let socketname = "socket" (*****************************************************************************) (** Internal functions: storage directory *) -open Simplexmlparser (** getting the directory from config file *) let rec parse_global_config (store, ocsidbm, delayloading as d) = function | [] -> d - | Element ("delayloading", [("val", ("true" | "1"))], []) :: ll -> + | Xml.Element ("delayloading", [("val", ("true" | "1"))], []) :: ll -> parse_global_config (store, ocsidbm, true) ll - | Element ("store", [("dir", s)], []) :: ll -> + | Xml.Element ("store", [("dir", s)], []) :: ll -> if store = None then parse_global_config ((Some s), ocsidbm, delayloading) ll else Ocsigen_extensions.badconfig "Ocsipersist: Duplicate tag" - | Element ("ocsidbm", [("name", s)], []) :: ll -> + | Xml.Element ("ocsidbm", [("name", s)], []) :: ll -> if ocsidbm = None then parse_global_config (store, (Some s), delayloading) ll else Ocsigen_extensions.badconfig "Ocsipersist: Duplicate tag" - | (Element (s,_,_))::ll -> Ocsigen_extensions.badconfig "Bad tag %s" s + | (Xml.Element (s,_,_))::ll -> Ocsigen_extensions.badconfig "Bad tag %s" s | _ -> Ocsigen_extensions.badconfig "Unexpected content inside Ocsipersist config" @@ -151,12 +150,12 @@ let init_fun config = Lwt_log.ign_warning ~section "Initializing ..."); let indescr = get_indescr 2 in if delay_loading then ( - inch := (indescr >>= fun r -> return (Lwt_chan.in_channel_of_descr r)); - outch := (indescr >>= fun r -> return (Lwt_chan.out_channel_of_descr r)); + inch := Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.input) indescr; + outch := Lwt.map (Lwt_io.of_fd ~mode:Lwt_io.output) indescr; ) else ( let r = Lwt_main.run indescr in - inch := return (Lwt_chan.in_channel_of_descr r); - outch := return (Lwt_chan.out_channel_of_descr r); + inch := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.input r); + outch := Lwt.return (Lwt_io.of_fd ~mode:Lwt_io.output r); Lwt_log.ign_warning ~section "...Initialization complete"; ) @@ -171,9 +170,9 @@ let send = !inch >>= fun inch -> !outch >>= fun outch -> previous := - (Lwt_chan.output_value outch v >>= fun () -> - Lwt_chan.flush outch >>= fun () -> - Lwt_chan.input_value inch); + (Lwt_io.write_value outch v >>= fun () -> + Lwt_io.flush outch >>= fun () -> + Lwt_io.read_value inch); !previous) let db_get (store, name) = diff --git a/src/extensions/ocsipersist-pgsql/Makefile b/src/extensions/ocsipersist-pgsql/Makefile index 6ff18e692..d0a1fc143 100644 --- a/src/extensions/ocsipersist-pgsql/Makefile +++ b/src/extensions/ocsipersist-pgsql/Makefile @@ -1,6 +1,6 @@ include ../../../Makefile.config -PACKAGE := tyxml.parser pgocaml lwt +PACKAGE := xml-light pgocaml lwt lwt_log LIBS := -I ../../baselib -I ../../http -I ../../server \ ${addprefix -package ,${PACKAGE}} diff --git a/src/extensions/ocsipersist-pgsql/ocsipersist.ml b/src/extensions/ocsipersist-pgsql/ocsipersist.ml index 61d5dcab1..4e39913f4 100644 --- a/src/extensions/ocsipersist-pgsql/ocsipersist.ml +++ b/src/extensions/ocsipersist-pgsql/ocsipersist.ml @@ -282,11 +282,9 @@ let fold_table = fold_step let iter_block a b = failwith "Ocsipersist.iter_block: not implemented" - -open Simplexmlparser let parse_global_config = function | [] -> () - | [Element ("database", attrs, [])] -> let parse_attr = function + | [Xml.Element ("database", attrs, [])] -> let parse_attr = function | ("host", h) -> host := Some h | ("port", p) -> begin try port := Some (int_of_string p) diff --git a/src/extensions/ocsipersist-sqlite/Makefile b/src/extensions/ocsipersist-sqlite/Makefile index fea403b48..6b0f6fea3 100644 --- a/src/extensions/ocsipersist-sqlite/Makefile +++ b/src/extensions/ocsipersist-sqlite/Makefile @@ -1,8 +1,6 @@ include ../../../Makefile.config -PACKAGE := lwt.preemptive \ - tyxml.parser \ - sqlite3 \ +PACKAGE := lwt lwt_log xml-light sqlite3 LIBS := -I ../../baselib -I ../../http -I ../../server \ ${addprefix -package ,${PACKAGE}} diff --git a/src/extensions/ocsipersist-sqlite/ocsipersist.ml b/src/extensions/ocsipersist-sqlite/ocsipersist.ml index 371e7a832..42485f067 100644 --- a/src/extensions/ocsipersist-sqlite/ocsipersist.ml +++ b/src/extensions/ocsipersist-sqlite/ocsipersist.ml @@ -36,11 +36,10 @@ exception Ocsipersist_error (*****************************************************************************) -open Simplexmlparser (** getting the directory from config file *) let rec parse_global_config = function | [] -> None - | (Element ("database", [("file", s)], []))::[] -> Some s + | (Xml.Element ("database", [("file", s)], []))::[] -> Some s | _ -> raise (Ocsigen_extensions.Error_in_config_file ("Unexpected content inside Ocsipersist config")) diff --git a/src/extensions/revproxy.ml b/src/extensions/revproxy.ml index a9acc8f8a..3e4ed3c06 100644 --- a/src/extensions/revproxy.ml +++ b/src/extensions/revproxy.ml @@ -42,7 +42,6 @@ open Ocsigen_lib open Lwt open Ocsigen_extensions -open Simplexmlparser let section = Lwt_log.Section.make "ocsigen:ext:revproxy" diff --git a/src/extensions/rewritemod.ml b/src/extensions/rewritemod.ml index 912125b90..7dc1f6814 100644 --- a/src/extensions/rewritemod.ml +++ b/src/extensions/rewritemod.ml @@ -44,7 +44,6 @@ open Lwt open Ocsigen_extensions -open Simplexmlparser let section = Lwt_log.Section.make "ocsigen:ext:rewritemod" diff --git a/src/extensions/userconf.ml b/src/extensions/userconf.ml index 16a87d0a4..4a6e8c363 100644 --- a/src/extensions/userconf.ml +++ b/src/extensions/userconf.ml @@ -98,12 +98,15 @@ let subresult new_req user_parse_site conf previous_err req req_state = let conf_to_xml conf = - try Simplexmlparser.xmlparser_file conf + try [Xml.parse_file conf] with | Sys_error _ -> raise NoConfFile - | Simplexmlparser.Xml_parser_error s -> - raise (Ocsigen_extensions.Error_in_config_file s) - + | Xml.Error (s, loc) -> + let begin_char, end_char = Xml.range loc and line = Xml.line loc in + raise (Ocsigen_extensions.Error_in_config_file + (Printf.sprintf "%s, line %d, characters %d-%d" + (Xml.error_msg s) + line begin_char end_char)) let gen hostpattern sitepath (regexp, conf, url, prefix, localpath) = function | Req_found _ -> diff --git a/src/http/Makefile b/src/http/Makefile index fd8077ab1..f6520318c 100644 --- a/src/http/Makefile +++ b/src/http/Makefile @@ -4,6 +4,7 @@ PACKAGE := \ netstring \ netstring-pcre \ lwt_ssl \ + lwt_log \ tyxml LIBS := -I ../baselib ${addprefix -package ,${PACKAGE}} diff --git a/src/http/ocsigen_http_com.mli b/src/http/ocsigen_http_com.mli index 4d29f2f1f..a4e9b13d3 100644 --- a/src/http/ocsigen_http_com.mli +++ b/src/http/ocsigen_http_com.mli @@ -69,7 +69,10 @@ val wait_all_senders : connection -> unit Lwt.t interrupted stream exception. *) val write_stream : - ?chunked:bool -> Lwt_chan.out_channel -> string Ocsigen_stream.t -> unit Lwt.t + ?chunked:bool -> + Lwt_io.output_channel -> + string Ocsigen_stream.t -> + unit Lwt.t (****) @@ -104,13 +107,13 @@ val send : val abort : connection -> unit -(** Use this function to make an action just before sending the result +(** Use this function to make an action just before sending the result (for example observe the headers that will be sent). The parameter is a function taking the set of headers twice, - first as [Ocsigen_http_frame.Http_headers.http_header], + first as [Ocsigen_http_frame.Http_headers.http_header], second as a [string]. *) -val set_result_observer : +val set_result_observer : (Ocsigen_http_frame.Http_header.http_header -> string -> unit Lwt.t) -> unit diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml index 6ecc9d61d..1fdb5c516 100644 --- a/src/server/ocsigen_extensions.ml +++ b/src/server/ocsigen_extensions.ml @@ -291,13 +291,13 @@ and extension2 = type extension = request_state -> answer Lwt.t -type parse_fun = Simplexmlparser.xml list -> extension2 +type parse_fun = Xml.xml list -> extension2 type parse_host = Parse_host of (Url.path -> - parse_host -> parse_fun -> Simplexmlparser.xml -> extension) + parse_host -> parse_fun -> Xml.xml -> extension) let (hosts : (virtual_hosts * config_info * extension2) list ref) = ref [] @@ -357,7 +357,7 @@ let new_url_of_directory_request request ri = (*****************************************************************************) (* To give parameters to extensions: *) -let dynlinkconfig = ref ([] : Simplexmlparser.xml list) +let dynlinkconfig = ref ([] : Xml.xml list) let set_config s = dynlinkconfig := s let get_config () = !dynlinkconfig @@ -458,7 +458,7 @@ let rec default_parse_config prevpath (Parse_host parse_host) (parse_fun : parse_fun) = function - | Simplexmlparser.Element ("site", atts, l) -> + | Xml.Element ("site", atts, l) -> let rec parse_site_attrs (enc,dir) = function | [] -> (match dir with | None -> @@ -550,7 +550,7 @@ let rec default_parse_config Lwt.return (Ext_found_continue_with' (r, ri)) | Req_not_found (err, ri) -> Lwt.return (Ext_sub_result ext)) - | Simplexmlparser.Element (tag,_,_) -> + | Xml.Element (tag,_,_) -> raise (Bad_config_tag_for_extension tag) | _ -> raise (Ocsigen_config.Config_file_error ("Unexpected content inside ")) @@ -613,7 +613,7 @@ type parse_config = virtual_hosts -> config_info -> parse_config_aux and parse_config_user = userconf_info -> parse_config and parse_config_aux = Url.path -> parse_host -> - (parse_fun -> Simplexmlparser.xml -> + (parse_fun -> Xml.xml -> extension ) @@ -621,11 +621,11 @@ and parse_config_aux = let user_extension_void_fun_site : parse_config_user = fun _ _ _ _ _ _ -> function - | Simplexmlparser.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) + | Xml.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) | _ -> raise (Error_in_config_file "Unexpected data in config file") let extension_void_fun_site : parse_config = fun _ _ _ _ _ -> function - | Simplexmlparser.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) + | Xml.Element (t, _, _) -> raise (Bad_config_tag_for_extension t) | _ -> raise (Error_in_config_file "Unexpected data in config file") @@ -748,7 +748,7 @@ module Configuration = struct elements : element list; attributes : attribute list; pcdata : (string -> unit) option; - other_elements : (string -> (string * string) list -> Simplexmlparser.xml list -> unit) option; + other_elements : (string -> (string * string) list -> Xml.xml list -> unit) option; other_attributes : (string -> string -> unit) option; } and element = string * element' @@ -792,7 +792,7 @@ module Configuration = struct let check_element_occurrence ~in_tag elements = function | name, { obligatory = true } -> let corresponding_element = function - | Simplexmlparser.Element (name', _, _) -> name = name' + | Xml.Element (name', _, _) -> name = name' | _ -> false in if not (List.exists corresponding_element elements) then @@ -815,12 +815,12 @@ module Configuration = struct let rec process_element ~in_tag ~elements:spec_elements ?pcdata:spec_pcdata ?other_elements:spec_other_elements = function - | Simplexmlparser.PCData str -> + | Xml.PCData str -> let spec_pcdata = Option.get (fun () -> ignore_blank_pcdata ~in_tag) spec_pcdata in spec_pcdata str - | Simplexmlparser.Element (name, attributes, elements) -> + | Xml.Element (name, attributes, elements) -> try let spec = List.assoc name spec_elements in List.iter diff --git a/src/server/ocsigen_extensions.mli b/src/server/ocsigen_extensions.mli index 05bf0eeb6..afceaff7f 100644 --- a/src/server/ocsigen_extensions.mli +++ b/src/server/ocsigen_extensions.mli @@ -262,7 +262,7 @@ type extension = request_state -> answer Lwt.t the extension may want to modify the result (filters). *) -type parse_fun = Simplexmlparser.xml list -> extension2 +type parse_fun = Xml.xml list -> extension2 (** Type of the functions parsing the content of a tag *) type parse_host @@ -305,7 +305,7 @@ and parse_config_user = userconf_info -> parse_config and parse_config_aux = Url.path -> parse_host -> - (parse_fun -> Simplexmlparser.xml -> + (parse_fun -> Xml.xml -> extension ) @@ -355,7 +355,7 @@ val register_extension : ?user_fun_site:parse_config_user -> ?begin_init:(unit -> unit) -> ?end_init:(unit -> unit) -> - ?init_fun:(Simplexmlparser.xml list -> unit) -> + ?init_fun:(Xml.xml list -> unit) -> ?exn_handler:(exn -> string) -> ?respect_pipeline:bool -> unit -> unit @@ -388,7 +388,7 @@ module Configuration : sig ?elements:element list -> ?attributes:attribute list -> ?pcdata:(string -> unit) -> - ?other_elements:(string -> (string * string) list -> Simplexmlparser.xml list -> unit) -> + ?other_elements:(string -> (string * string) list -> Xml.xml list -> unit) -> ?other_attributes:(string -> string -> unit) -> unit -> element @@ -416,17 +416,17 @@ module Configuration : sig in_tag:string -> elements:element list -> ?pcdata:(string -> unit) -> - ?other_elements:(string -> (string * string) list -> Simplexmlparser.xml list -> unit) -> - Simplexmlparser.xml -> unit + ?other_elements:(string -> (string * string) list -> Xml.xml list -> unit) -> + Xml.xml -> unit (** Application of [process_element] on a list of XML elements. *) val process_elements : in_tag:string -> elements:element list -> ?pcdata:(string -> unit) -> - ?other_elements:(string -> (string * string) list -> Simplexmlparser.xml list -> unit) -> + ?other_elements:(string -> (string * string) list -> Xml.xml list -> unit) -> ?init:(unit -> unit) -> - Simplexmlparser.xml list -> unit + Xml.xml list -> unit (** The specification for ignoring blank PCDATA ('\n', '\r', ' ', '\t') and failing otherwise (a reasonable default). *) @@ -524,7 +524,7 @@ val get_numberofreloads : unit -> int val get_init_exn_handler : unit -> exn -> string -val set_config : Simplexmlparser.xml list -> unit +val set_config : Xml.xml list -> unit val client_of_connection : Ocsigen_http_com.connection -> client diff --git a/src/server/ocsigen_parseconfig.ml b/src/server/ocsigen_parseconfig.ml index 2fa513a31..9614345c4 100644 --- a/src/server/ocsigen_parseconfig.ml +++ b/src/server/ocsigen_parseconfig.ml @@ -24,7 +24,7 @@ open Ocsigen_lib open Ocsigen_socket -open Simplexmlparser +open Xml open Ocsigen_config let section = Lwt_log.Section.make "ocsigen:config" @@ -184,10 +184,7 @@ let parse_string_tag tag s = let rec parser_config = - let rec verify_empty = function - | [] -> () - | _ -> raise (Config_file_error "Don't know what to do with trailing data") - in let rec parse_servers n = function + let rec parse_servers n = function | [] -> (match n with | [] -> raise (Config_file_error (" tag expected")) | _ -> n) @@ -203,14 +200,13 @@ let rec parser_config = (* nouveau at the end *) | _ -> raise (Config_file_error ("syntax error inside ")) in function - | (Element ("ocsigen", [], l))::ll -> - verify_empty ll; + | (Element ("ocsigen", [], l)) -> parse_servers [] l | _ -> raise (Config_file_error " tag expected") let parse_ext file = - parser_config (Simplexmlparser.xmlparser_file file) + parser_config (Xml.parse_file file) let preloadfile config () = Ocsigen_extensions.set_config config @@ -785,6 +781,6 @@ let parse_config ?file () = | None -> Ocsigen_config.get_config_file () | Some f -> f in - parser_config (Simplexmlparser.xmlparser_file file) + parser_config (Xml.parse_file file) (******************************************************************) diff --git a/src/server/ocsigen_parseconfig.mli b/src/server/ocsigen_parseconfig.mli index 9fe9da17b..06945e8f7 100644 --- a/src/server/ocsigen_parseconfig.mli +++ b/src/server/ocsigen_parseconfig.mli @@ -36,13 +36,13 @@ val parse_size_tag : string -> string -> int64 option (** Parse a string (PCDATA) as XML content. Raises [Failure "Ocsigen_parseconfig.parse_string"] in case of error. *) -val parse_string : Simplexmlparser.xml list -> string +val parse_string : Xml.xml list -> string (** [parse_string_tag tag s] parses a string (same syntax as [parse_string]). In case of error, raises [Ocsigen_config.Config_file_error m] where [m] is an error message explaining that a string was expected in tag []. *) -val parse_string_tag : string -> Simplexmlparser.xml list -> string +val parse_string_tag : string -> Xml.xml list -> string (** Parses the [hostfilter] field of the configuration file, which @@ -52,9 +52,8 @@ val parse_host_field: string option -> Ocsigen_extensions.virtual_hosts (**/**) -val parser_config : Simplexmlparser.xml list -> - Simplexmlparser.xml list list -val parse_server : bool -> Simplexmlparser.xml list -> unit +val parser_config : Xml.xml -> Xml.xml list list +val parse_server : bool -> Xml.xml list -> unit type ssl_info = { ssl_certificate : string option; @@ -76,7 +75,7 @@ type ssl_info = { } *) val extract_info : - Simplexmlparser.xml list -> + Xml.xml list -> (string option * string option) * (ssl_info option * (Ocsigen_socket.socket_type * int) list * @@ -86,4 +85,4 @@ val extract_info : val parse_config : ?file:string -> unit -> - Simplexmlparser.xml list list + Xml.xml list list diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml index 711ecd119..f4e5de7cd 100644 --- a/src/server/ocsigen_server.ml +++ b/src/server/ocsigen_server.ml @@ -1029,9 +1029,12 @@ let errmsg = function | Ocsigen_extensions.Error_in_config_file msg -> (("Fatal - Error in configuration file: "^msg), 50) - | Simplexmlparser.Xml_parser_error s -> - (("Fatal - Error in configuration file: "^s), - 51) + | Xml.Error (s, loc) -> + let begin_char, end_char = Xml.range loc and line = Xml.line loc in + raise (Ocsigen_extensions.Error_in_config_file + (Printf.sprintf "%s, line %d, characters %d-%d" + (Xml.error_msg s) + line begin_char end_char)) | Ocsigen_loader.Dynlink_error (s, exn) -> (("Fatal - While loading "^s^": "^(Printexc.to_string exn)), 52) @@ -1130,6 +1133,26 @@ let _ = exception Stop of int * string +(* Copied from deprecated [Lwt_chan]. *) +let lwt_chan_input_line ic = + let rec loop buf = + Lwt_io.read_char_opt ic >>= function + | None | Some '\n' -> + Lwt.return (Buffer.contents buf) + | Some char -> + Buffer.add_char buf char; + loop buf + in + Lwt_io.read_char_opt ic >>= function + | Some '\n' -> + Lwt.return "" + | Some char -> + let buf = Buffer.create 128 in + Buffer.add_char buf char; + loop buf + | None -> + Lwt.fail End_of_file + let start_server () = let stop n fmt = Printf.ksprintf (fun s -> raise (Stop (n, s))) fmt in (** Thread waiting for events on a the listening port *) @@ -1317,13 +1340,15 @@ let start_server () = Ocsigen_extensions.end_initialisation (); - let pipe = Lwt_chan.in_channel_of_descr - (Lwt_unix.of_unix_file_descr - (Unix.openfile commandpipe - [Unix.O_RDWR; Unix.O_NONBLOCK; Unix.O_APPEND] 0o660)) in + let pipe = + Lwt_io.of_fd ~mode:Lwt_io.input @@ + Lwt_unix.of_unix_file_descr @@ + Unix.openfile commandpipe + [Unix.O_RDWR; Unix.O_NONBLOCK; Unix.O_APPEND] 0o660 + in let rec f () = - Lwt_chan.input_line pipe >>= fun s -> + lwt_chan_input_line pipe >>= fun s -> Lwt_log.ign_notice ~section ("Command received: "^s); (Lwt.catch (fun () ->