Skip to content

Commit ae1ea02

Browse files
authored
Merge pull request #153 from ocsigen/lwt4
Compatibility with Lwt 4.x and Tyxml dev
2 parents e316444 + cf30c01 commit ae1ea02

34 files changed

+262
-280
lines changed

.merlin

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,8 @@ PKG cryptokit
88
PKG netstring
99
PKG netstring-pcre
1010
PKG ipaddr
11-
PKG tyxml tyxml.parser
11+
PKG tyxml
12+
PKG xml-light
1213
PKG camlzip
1314
PKG dynlink
1415

Makefile.options

Lines changed: 5 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
BYTEDBG :=
22
OPTDBG :=
3-
THREAD :=
3+
THREAD := -thread
44

55
ifeq "$(DEBUG)" "YES"
66
BYTEDBG += -g
@@ -17,29 +17,22 @@ BYTEDBG := -p ${BYTEDBG}
1717
OPTDBG += -p
1818
endif
1919

20-
ifeq "$(PREEMPTIVE)" "YES"
21-
THREAD += -thread
22-
endif
23-
2420
## ${SERVER_PACKAGE} is not only used to build the 'ocsigenserver' executable
2521
## but also to generate src/baselib/ocsigen_config.ml and src/files/META
2622

27-
ifeq "$(PREEMPTIVE)" "YES"
28-
LWT_PREEMPTIVE_PACKAGE:=lwt.preemptive
29-
endif
30-
3123
BASE_PACKAGE := lwt ipaddr bytes
3224

3325
SERVER_PACKAGE := lwt_ssl \
34-
bytes \
35-
${LWT_PREEMPTIVE_PACKAGE} \
26+
bytes \
27+
lwt.unix \
28+
lwt_log \
3629
ipaddr \
3730
netstring \
3831
netstring-pcre \
3932
findlib \
4033
cryptokit \
4134
tyxml \
42-
tyxml.parser \
35+
xml-light \
4336
dynlink \
4437

4538
INITPACKAGE := \"$(shell ${OCAMLFIND} query -p-format -recursive \

configure

Lines changed: 3 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -81,7 +81,6 @@ set_defaults () {
8181
with_pgsql=1
8282
with_camlzip=1
8383
with_dbm=1
84-
with_preempt=1
8584
prefix="/usr/local"
8685
bindir=""
8786
logdir=""
@@ -108,7 +107,7 @@ full_pwd=`pwd`
108107

109108
## Which options exist? eoptions for enable/disable, woptions for with/without:
110109
eoptions="debug annot natdynlink"
111-
woptions="pgsql sqlite dbm camlzip preempt"
110+
woptions="pgsql sqlite dbm camlzip"
112111

113112
print_options () {
114113
for opt in $eoptions; do
@@ -412,7 +411,7 @@ check_library lwt "See: http://ocsigen.org/lwt"
412411
check_library lwt.unix "Missing support for 'unix' in lwt."
413412
check_library lwt_react "See: http://ocsigen.org/lwt"
414413
check_library lwt_ssl "See: http://ocsigen.org/lwt"
415-
check_library lwt.preemptive "Missing support for 'preemptive' in lwt."
414+
check_library lwt_log "See: http://ocsigen.org/lwt"
416415

417416
check_library netstring \
418417
"See ocamlnet: http://projects.camlcity.org/projects/ocamlnet.html"
@@ -425,6 +424,7 @@ check_library pcre "See: http://ocaml.info/home/ocaml_sources.html"
425424
check_library cryptokit "See: http://pauillac.inria.fr/~xleroy/software.html#cryptokit"
426425

427426
check_library tyxml "See: http://ocsigen.org/tyxml/"
427+
check_library xml-light "See: https://github.com/ncannasse/xml-light"
428428

429429
# Check PostgreSQL
430430
case "$with_pgsql" in
@@ -462,22 +462,6 @@ if [ "$with_camlzip" -gt 0 ]; then
462462
fi
463463
fi
464464

465-
# Check Lwt.preemptive
466-
if [ "$with_preempt" -gt 0 ]; then
467-
if test_library lwt.preemptive; then
468-
echo -n
469-
elif [ "$with_preempt" -gt 1 ]; then
470-
fail_library lwt.preemptive "Missing support for 'preemptive' in lwt."
471-
else
472-
with_preempt=0
473-
fi
474-
fi
475-
476-
if [ "$with_sqlite" -eq 1 ] && [ "$with_preempt" -eq -1 ]; then
477-
echo "preemptive threads are needed by sqlite, enable it with -with-preempt"
478-
exit 1
479-
fi
480-
481465
# Check rlwrap or ledit
482466
if test_binary rlwrap; then
483467
rlwrap=rlwrap
@@ -532,11 +516,6 @@ if [ $with_camlzip -gt 0 ] ; then
532516
else
533517
with_camlzip="NO"
534518
fi
535-
if [ $with_preempt -gt 0 ] ; then
536-
with_preempt="YES"
537-
else
538-
with_preempt="NO"
539-
fi
540519

541520
ocamlinclude=`ocamlfind printconf stdlib`
542521

@@ -588,9 +567,6 @@ OCSIPERSISTPGSQL:=$with_pgsql
588567
# Do you want ocsipersist with dbm? YES/NO
589568
OCSIPERSISTDBM:=$with_dbm
590569
591-
# Do you want preemptive threads ? YES/NO
592-
PREEMPTIVE:=$with_preempt
593-
594570
# Do you want debugging information (-g) ? YES/NO
595571
DEBUG:=$enable_debug
596572

doc/manual-wiki/extend.wiki

Lines changed: 31 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -4,79 +4,79 @@
44

55
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.
66

7-
Remember to program your extensions in cooperative way using Lwt!
7+
Remember to program your extensions in cooperative way using Lwt!
88

9-
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.
9+
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.
1010

1111
//Ocsigen is a collaborative project. Contributions are welcome. For example a proxy, a fastCGI module~ ...//
1212

13-
===Filtering the requests or writing a module to generate pages
13+
===Filtering the requests or writing a module to generate pages
1414

15-
You can take as example the files {{{extensiontemplate.ml}}} or {{{staticmod.ml}}} from Ocsigen's distribution.
15+
You can take as example the files {{{extensiontemplate.ml}}} or {{{staticmod.ml}}} from Ocsigen's distribution.
1616

17-
The type of request is {{{Extensions.request_info}}} (have a look at it in the interface of the module {{{Extensions}}}).
17+
The type of request is {{{Extensions.request_info}}} (have a look at it in the interface of the module {{{Extensions}}}).
1818

19-
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}}}).
19+
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}}}).
2020

21-
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:
22-
* a function that will be called for each virtual server, generating two functions:
23-
**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,
24-
**one to parse the configuration file (see next section).
25-
*a function that will be called at the beginning of the initialisation phase (if you need to initialize your extension, otherwise, put the identity).
26-
*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).
27-
*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.
21+
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:
22+
* a function that will be called for each virtual server, generating two functions:
23+
**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,
24+
**one to parse the configuration file (see next section).
25+
*a function that will be called at the beginning of the initialisation phase (if you need to initialize your extension, otherwise, put the identity).
26+
*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).
27+
*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.
2828
29-
Example (from {{{staticmod.ml}}}):
29+
Example (from {{{staticmod.ml}}}):
3030

3131
{{{
3232
let _ = register_extension
33-
((fun _ ->
34-
let page_tree =
35-
try
33+
((fun _ ->
34+
let page_tree =
35+
try
3636
find hostpattern
3737
with Not_found ->
3838
let n = new_pages_tree () in
3939
add hostpattern n;
4040
n
4141
in
42-
(gen page_tree,
42+
(gen page_tree,
4343
parse_config page_tree)),
4444
start_init,
4545
end_init,
4646
raise)
4747
}}}
4848

49-
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.
49+
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.
5050

51-
===Filtering the outputs
51+
===Filtering the outputs
5252
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.
5353

54-
===Extending the configuration file
54+
===Extending the configuration file
5555

56-
====Extending the configuration file for an extension
56+
====Extending the configuration file for an extension
5757

58-
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.
58+
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.
5959
6060
{{{
6161
let parse_config path = function
62-
Simplexmlparser.Element ("tag", attr, content) -> ...
62+
Xml.Element ("tag", attr, content) -> ...
6363
(* Do what you want here *)
64-
| Simplexmlparser.Element _ ->
64+
| Xml.Element _ ->
6565
raise (Extensions.Bad_config_tag_for_extension t)
6666
| _ -> raise (Extensions.Error_in_config_file "(my extension)")
6767
}}}
6868

69-
The module {{{Parseconfig}}} defines functions to parse strings or sizes (in bytes, GB etc).
69+
The module {{{Parseconfig}}} defines functions to parse strings or sizes (in bytes, GB etc).
7070

71-
====Giving parameters to an extension
71+
====Giving parameters to an extension
7272

7373
//Warning: This is experimental. Please report your experience if you use it.//
7474

75-
Extensions may take parameters in the configuration file. During the loading of the extension, the function {{{Extensions.get_config ()}}} returns the xml tree between {{{<extension>}}} and {{{</extension>}}} (or {{{<library>}}} and {{{</library>}}}). Write a parser for that tree.
75+
Extensions may take parameters in the configuration file. During the loading of the extension, the function {{{Extensions.get_config ()}}} returns the xml tree between {{{<extension>}}} and {{{</extension>}}} (or {{{<library>}}} and {{{</library>}}}). Write a parser for that tree.
7676

77-
===Catching the request before it is fully read
77+
===Catching the request before it is fully read
7878

79-
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.
79+
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.
8080

8181
//Warning: This is experimental. Please report your experience if you use it.//
8282

@@ -94,10 +94,9 @@ It takes as parameter a function of type
9494
If you want to add your own commands for the server command pipe, do something like:
9595

9696
{{{
97-
let () =
97+
let () =
9898
Ocsigen_extensions.register_command_function ~prefix:"yourextensionname"
9999
(fun s c -> match c with
100100
| ["mycommand"] -> ...
101101
| _ -> raise Ocsigen_extensions.Unknown_command)
102102
}}}
103-

opam

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -48,16 +48,17 @@ depends: [
4848
"base-threads"
4949
"react"
5050
"ssl"
51-
"lwt" {>= "3.0.0" & < "4.0.0"}
51+
"lwt" {>= "3.0.0"}
5252
"lwt_ssl"
5353
"lwt_react"
54+
"lwt_log"
5455
"ocamlnet" {>= "4.0.2"}
5556
"pcre"
5657
"cryptokit"
5758
"tyxml" {>= "4.0.0"}
5859
("dbm" | "sqlite3" | "pgocaml")
5960
"ipaddr" {>= "2.1"}
60-
"camlp4" # to force building tyxml.parser
61+
"xml-light"
6162
]
6263
depopts: "camlzip"
6364
conflicts: [

src/baselib/Makefile

Lines changed: 1 addition & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ include ../../Makefile.config
33
PACKAGE := \
44
bytes \
55
lwt.unix \
6+
lwt_log \
67
netstring \
78
netstring-pcre \
89
cryptokit \
@@ -57,12 +58,6 @@ else
5758
NATIVECODE_RUNTIME_DETECT=false
5859
endif
5960

60-
ifeq "$(PREEMPTIVE)" "YES"
61-
PREEMTIMPLEM=Lwt_preemptive
62-
else
63-
PREEMTIMPLEM=Fake_preempt
64-
endif
65-
6661
VERSION := $(shell head -n 1 ../../VERSION)
6762

6863
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
8075
| sed s%_PROJECTNAME_%$(PROJECTNAME)%g \
8176
| sed s%_COMMANDPIPE_%$(COMMANDPIPE)%g \
8277
| sed s%_CONFIGDIR_%$(CONFIGDIR)% \
83-
| sed s%_PREEMTIMPLEM_%$(PREEMTIMPLEM)% \
8478
| sed s%_ISNATIVE_%$(NATIVECODE_RUNTIME_DETECT)%g \
8579
| sed "s%_DEPS_%$(INITPACKAGE)%g" \
8680
> ocsigen_config.ml

src/baselib/ocsigen_config.ml.in

Lines changed: 3 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -38,13 +38,6 @@ let native_ext = if is_native then ".opt" else ""
3838
let builtin_packages =
3939
List.fold_left (fun a s -> String.Set.add s a) String.Set.empty [_DEPS_]
4040

41-
module Fake_preempt =
42-
struct
43-
let set_max_number_of_threads_queued : int -> unit = fun _ -> ()
44-
let get_max_number_of_threads_queued : unit -> int = fun () -> 0
45-
let init : int -> int -> (string -> unit) -> unit = fun _ _ _ -> ()
46-
end
47-
4841
(* Server config: *)
4942
let (uploaddir : string option ref) = ref None
5043
let logdir = ref (Some ("_LOGDIR_"))
@@ -97,7 +90,7 @@ let set_veryverbose () =
9790
let set_minthreads i = minthreads := i
9891
let set_maxthreads i = maxthreads := i
9992
let set_max_number_of_threads_queued =
100-
_PREEMTIMPLEM_.set_max_number_of_threads_queued
93+
Lwt_preemptive.set_max_number_of_threads_queued
10194
let set_max_number_of_connections i = max_number_of_connections := i
10295
let set_client_timeout i = silent_client_timeout := i
10396
let set_server_timeout i = silent_server_timeout := i
@@ -143,7 +136,7 @@ let get_default_group () = !default_group
143136
let get_minthreads () = !minthreads
144137
let get_maxthreads () = !maxthreads
145138
let get_max_number_of_threads_queued =
146-
_PREEMTIMPLEM_.get_max_number_of_threads_queued
139+
Lwt_preemptive.get_max_number_of_threads_queued
147140
let get_max_number_of_connections () = !max_number_of_connections
148141
let get_client_timeout () = !silent_client_timeout
149142
let get_server_timeout () = !silent_server_timeout
@@ -175,5 +168,4 @@ let display_version () =
175168
print_newline ();
176169
exit 0
177170

178-
let init_preempt =
179-
_PREEMTIMPLEM_.init
171+
let init_preempt = Lwt_preemptive.init

src/baselib/ocsigen_stream.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -229,10 +229,10 @@ let of_file filename =
229229
let fd = Lwt_unix.of_unix_file_descr
230230
(Unix.openfile filename [Unix.O_RDONLY;Unix.O_NONBLOCK] 0o666)
231231
in
232-
let ch = Lwt_chan.in_channel_of_descr fd in
232+
let ch = Lwt_io.of_fd ~mode:Lwt_io.input fd in
233233
let buf = Bytes.create 1024 in
234234
let rec aux () =
235-
Lwt_chan.input ch buf 0 1024 >>= fun n ->
235+
Lwt_io.read_into ch buf 0 1024 >>= fun n ->
236236
if n = 0 then empty None else
237237
(* Streams should be immutable, thus we always make a copy
238238
of the buffer *)

src/extensions/Makefile

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,12 +3,13 @@ include ../../Makefile.config
33
PACKAGE := \
44
bytes \
55
lwt.unix \
6+
lwt_log \
67
ipaddr \
78
lwt_ssl \
89
lwt_react \
910
netstring \
1011
netstring-pcre \
11-
tyxml.parser
12+
xml-light
1213

1314
LIBS := -I ../baselib -I ../http -I ../server ${addprefix -package ,${PACKAGE}}
1415
OCAMLC := $(OCAMLFIND) ocamlc ${BYTEDBG} ${THREAD}

0 commit comments

Comments
 (0)