[Pkg-ocaml-maint-commits] [ocsigenserver] 02/08: Imported Upstream version 2.7
Stéphane Glondu
glondu at moszumanska.debian.org
Fri Aug 12 15:20:42 UTC 2016
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository ocsigenserver.
commit 241924952c508235f3a2939d2129bd9018d24575
Author: Stephane Glondu <steph at glondu.net>
Date: Fri Aug 12 17:10:15 2016 +0200
Imported Upstream version 2.7
---
.gitignore | 2 ++
CHANGES | 8 +++++
Makefile.options | 2 +-
VERSION | 2 +-
doc/manual-wiki/config.wiki | 4 +--
opam | 2 +-
src/baselib/Makefile | 2 +-
src/extensions/Makefile | 2 +-
src/extensions/deflatemod.ml | 33 +++++++++++++++++---
src/http/Makefile | 2 +-
src/http/http_headers.ml | 1 +
src/http/http_headers.mli | 1 +
src/http/ocsigen_http_com.ml | 64 ++++++++++++++++++++-------------------
src/http/ocsigen_senders.ml | 10 ++++--
src/server/Makefile | 2 +-
src/server/ocsigen_http_client.ml | 10 ++++--
src/server/ocsigen_server.ml | 5 +++
17 files changed, 104 insertions(+), 48 deletions(-)
diff --git a/.gitignore b/.gitignore
index a71880c..21613c3 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,6 +11,7 @@
*.cmti
*~
Makefile.config
+src/baselib/dynlink_wrapper.ml
src/baselib/ocsigen_config.ml
src/http/http_lexer.ml
src/http/http_parser.ml
@@ -21,6 +22,7 @@ src/extensions/ocsipersist.mli
src/extensions/ocsipersist-dbm/ocsidbm
src/extensions/ocsipersist-dbm/ocsidbm.opt
src/extensions/ocsipersist-dbm/ocsipersist.mli
+src/extensions/ocsipersist-sqlite/ocsipersist.mli
src/files/META
src/files/META.ocsigenserver
src/extensions/files/META
diff --git a/CHANGES b/CHANGES
index a5444ba..da0e6b0 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,11 @@
+==== 2.7.0 (2016-05-12) ====
+
+ * Fix content type selection for XML content
+ * Send gzip trailer in Deflatemod
+ * Log more details about SSL accept errors
+ * Support the Content-Disposition header
+ * Optimize buffering
+
==== 2.6.0 (2015-07-21) ====
* Fix cryptographic-safe string generation
diff --git a/Makefile.options b/Makefile.options
index 3c7373f..2711dd0 100644
--- a/Makefile.options
+++ b/Makefile.options
@@ -13,7 +13,7 @@ OPTDBG += -bin-annot
endif
ifeq "$(PROFILING)" "YES"
-BYTEDBG :=p ${BYTEDBG}
+BYTEDBG := -p ${BYTEDBG}
OPTDBG += -p
endif
diff --git a/VERSION b/VERSION
index 5154b3f..1effb00 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-2.6
+2.7
diff --git a/doc/manual-wiki/config.wiki b/doc/manual-wiki/config.wiki
index d1faf0a..f3be2f8 100644
--- a/doc/manual-wiki/config.wiki
+++ b/doc/manual-wiki/config.wiki
@@ -370,11 +370,11 @@ The file associating file name extensions to their MIME type. Example:
<mimefile>/etc/ocsigenserver/mime.types</mimefile>
}}}
-===={{{<debugmod/>}}} : Error messages in pages
+===={{{<debugmode/>}}} : Error messages in pages
Use this option for debugging your Web sites. Full error messages will be written in Error 500 pages. Example:
{{{
-<debugmod/>
+<debugmode/>
}}}
===={{{<usedefaulthostname/>}}} : Do not trust Host HTTP header for absolute links
diff --git a/opam b/opam
index 9469c43..9537632 100644
--- a/opam
+++ b/opam
@@ -23,7 +23,7 @@ depends: [
"base-threads"
"react"
"ssl"
- "lwt" {>= "2.4.7"}
+ "lwt" {>= "2.5.0"}
"ocamlnet" {>= "4.0.2"}
"pcre"
"cryptokit"
diff --git a/src/baselib/Makefile b/src/baselib/Makefile
index a6fe6cc..6b99d60 100644
--- a/src/baselib/Makefile
+++ b/src/baselib/Makefile
@@ -13,7 +13,7 @@ PACKAGE := \
ipaddr \
${SERVER_SYNTAX} ## See ../../Makefile.options
LIBS := ${addprefix -package ,${PACKAGE}}
-OCAMLC := $(OCAMLFIND) ocamlc${BYTEDBG} ${THREAD}
+OCAMLC := $(OCAMLFIND) ocamlc ${BYTEDBG} ${THREAD}
OCAMLOPT := $(OCAMLFIND) ocamlopt ${OPTDBG} ${THREAD}
OCAMLDOC := $(OCAMLFIND) ocamldoc
OCAMLDEP := $(OCAMLFIND) ocamldep
diff --git a/src/extensions/Makefile b/src/extensions/Makefile
index b8a165f..b7185f0 100644
--- a/src/extensions/Makefile
+++ b/src/extensions/Makefile
@@ -12,7 +12,7 @@ PACKAGE := \
${SERVER_SYNTAX} ## See ../../Makefile.options
LIBS := -I ../baselib -I ../http -I ../server ${addprefix -package ,${PACKAGE}}
-OCAMLC := $(OCAMLFIND) ocamlc${BYTEDBG}
+OCAMLC := $(OCAMLFIND) ocamlc ${BYTEDBG}
OCAMLOPT := $(OCAMLFIND) ocamlopt ${OPTDBG}
OCAMLDOC := $(OCAMLFIND) ocamldoc
OCAMLDEP := $(OCAMLFIND) ocamldep
diff --git a/src/extensions/deflatemod.ml b/src/extensions/deflatemod.ml
index cfdde38..6da3254 100644
--- a/src/extensions/deflatemod.ml
+++ b/src/extensions/deflatemod.ml
@@ -76,8 +76,20 @@ type output_buffer =
buf: string;
mutable pos: int;
mutable avail: int;
+ mutable size : int32;
+ mutable crc : int32;
+ mutable add_trailer : bool
}
+let write_int32 oz n =
+ for i = 0 to 3 do
+ Bytes.set oz.buf (oz.pos + i)
+ (Char.chr (Int32.to_int (Int32.shift_right_logical n (8 * i)) land 0xff))
+ done;
+ oz.pos <- oz.pos + 4;
+ oz.avail <- oz.avail - 4;
+ assert (oz.avail >= 0)
+
(* puts in oz the content of buf, from pos to pos + len ;
* f is the continuation of the current stream *)
let rec output oz f buf pos len =
@@ -99,6 +111,8 @@ let rec output oz f buf pos len =
in
oz.pos <- oz.pos + used_out;
oz.avail <- oz.avail - used_out;
+ oz.size <- Int32.add oz.size (Int32.of_int used_in);
+ oz.crc <- Zlib.update_crc oz.crc buf pos used_in;
output oz f buf (pos + used_in) (len - used_in)
end
@@ -138,9 +152,19 @@ and next_cont oz stream =
if not finished then
finish ()
else
- (Lwt_log.ign_info ~section "Zlib.deflate finished, last flush" ;
- flush oz (fun () -> Ocsigen_stream.empty None))) in
-
+ write_trailer ())
+ and write_trailer () =
+ if oz.add_trailer && oz.avail < 8 then
+ flush oz write_trailer
+ else begin
+ if oz.add_trailer then begin
+ write_int32 oz oz.crc;
+ write_int32 oz oz.size
+ end;
+ Lwt_log.ign_info ~section "Zlib.deflate finished, last flush";
+ flush oz (fun () -> Ocsigen_stream.empty None)
+ end
+ in
finish ()
| Ocsigen_stream.Finished (Some s) -> next_cont oz s
| Ocsigen_stream.Cont(s,f) ->
@@ -161,7 +185,8 @@ let compress deflate stream =
{ stream = zstream ;
buf = Bytes.create !buffer_size;
pos = 0;
- avail = !buffer_size
+ avail = !buffer_size;
+ size = 0l; crc = 0l; add_trailer = not deflate
} in
let new_stream () = next_cont oz (Ocsigen_stream.get stream) in
Lwt_log.ign_info ~section "Zlib stream initialized" ;
diff --git a/src/http/Makefile b/src/http/Makefile
index 5efdb12..acb8ec9 100644
--- a/src/http/Makefile
+++ b/src/http/Makefile
@@ -8,7 +8,7 @@ PACKAGE := \
${SERVER_SYNTAX} ## See ../../Makefile.options
LIBS := -I ../baselib ${addprefix -package ,${PACKAGE}}
-OCAMLC := $(OCAMLFIND) ocamlc${BYTEDBG}
+OCAMLC := $(OCAMLFIND) ocamlc ${BYTEDBG}
OCAMLOPT := $(OCAMLFIND) ocamlopt ${OPTDBG}
OCAMLDOC := $(OCAMLFIND) ocamldoc
OCAMLDEP := $(OCAMLFIND) ocamldep
diff --git a/src/http/http_headers.ml b/src/http/http_headers.ml
index 3daedcb..71238d2 100644
--- a/src/http/http_headers.ml
+++ b/src/http/http_headers.ml
@@ -29,6 +29,7 @@ let accept_language = name "Accept-Language"
let accept_ranges = name "Accept-Ranges"
let cache_control = name "Cache-Control"
let connection = name "Connection"
+let content_disposition = name "Content-Disposition"
let content_encoding = name "Content-Encoding"
let content_range = name "Content-Range"
let content_length = name "Content-Length"
diff --git a/src/http/http_headers.mli b/src/http/http_headers.mli
index 0cd50a7..42e82aa 100644
--- a/src/http/http_headers.mli
+++ b/src/http/http_headers.mli
@@ -36,6 +36,7 @@ val accept_language : name
val accept_ranges : name
val cache_control : name
val connection : name
+val content_disposition : name
val content_encoding : name
val content_length : name
val content_type : name
diff --git a/src/http/ocsigen_http_com.ml b/src/http/ocsigen_http_com.ml
index a60ca37..d64e760 100644
--- a/src/http/ocsigen_http_com.ml
+++ b/src/http/ocsigen_http_com.ml
@@ -98,7 +98,7 @@ let create_waiter block =
type connection =
{ id : int;
fd : Lwt_ssl.socket;
- chan : Lwt_chan.out_channel;
+ chan : Lwt_io.output_channel;
timeout : Lwt_timeout.t;
r_mode : mode;
closed : unit Lwt.t * unit Lwt.u;
@@ -127,11 +127,13 @@ let create_receiver timeout mode fd =
{ id = new_id ();
fd = fd;
chan =
- Lwt_chan.make_out_channel
+ Lwt_io.make
+ ~mode:Lwt_io.output
+ ~buffer:(Lwt_bytes.create buffer_size)
(fun buf pos len ->
Lwt_timeout.start timeout;
Lwt.try_bind
- (fun () -> Lwt_ssl.write fd buf pos len)
+ (fun () -> Lwt_ssl.write_bytes fd buf pos len)
(fun l -> Lwt_timeout.stop timeout; Lwt.return l)
(fun e -> Lwt_timeout.stop timeout;
Lwt.fail (convert_io_error e)));
@@ -505,7 +507,7 @@ let get_http_frame ?(head = false) receiver =
type slot =
{ sl_waiter : waiter;
- sl_chan : Lwt_chan.out_channel;
+ sl_chan : Lwt_io.output_channel;
sl_ssl : bool (* for secure cookies only *)}
let create_slot conn =
@@ -534,7 +536,7 @@ let start_processing conn f =
(*XXX It would be clearer to put this code at the end of the sender function,
but we don't have access to [next_slot] there *)
if not next_waiter.w_did_wait then
- Lwt_chan.flush conn.chan
+ Lwt_io.flush conn.chan
else
Lwt.return ()))
(fun () ->
@@ -565,7 +567,7 @@ let wait_all_senders conn =
(*XXX Do we need a flush here? Are we properly flushing in case of an error? *)
(fun () ->
conn.senders.w_wait >>= fun () ->
- Lwt_chan.flush conn.chan)
+ Lwt_io.flush conn.chan)
(fun e -> match e with Aborted -> Lwt.return () | _ -> Lwt.fail e))
(fun () ->
Lwt_timeout.stop conn.timeout;
@@ -623,16 +625,16 @@ let default_sender = create_sender ~server_name:Ocsigen_config.server_name ()
Ocsigen_stream.next stream >>= fun e ->
match e with
Ocsigen_stream.Finished _ ->
- Lwt_chan.output_string out_ch "0\r\n\r\n"
+ Lwt_io.write out_ch "0\r\n\r\n"
| Ocsigen_stream.Cont (s, next) ->
let l = String.length s in
begin if l = 0 then
(* It is incorrect to send an empty chunk *)
Lwt.return ()
else begin
- Lwt_chan.output_string out_ch (Format.sprintf "%x\r\n" l) >>= fun () ->
- Lwt_chan.output_string out_ch s >>= fun () ->
- Lwt_chan.output_string out_ch "\r\n"
+ Lwt_io.write out_ch (Format.sprintf "%x\r\n" l) >>= fun () ->
+ Lwt_io.write out_ch s >>= fun () ->
+ Lwt_io.write out_ch "\r\n"
end end >>= fun () ->
write_stream_chunked out_ch next
*)
@@ -643,7 +645,7 @@ let default_sender = create_sender ~server_name:Ocsigen_config.server_name ()
We bufferise them before creating a thunk.
Benchmarks cannot prove that it is better, but at least the network stream
is readable ...
- It is then buffered again by Lwt_chan.
+ It is then buffered again by Lwt_io.
Is there a way to have only one buffer?
*)
let write_stream_chunked out_ch stream =
@@ -656,13 +658,13 @@ let write_stream_chunked out_ch stream =
| Ocsigen_stream.Finished _ ->
(if len > 0 then begin
(* It is incorrect to send an empty chunk *)
- Lwt_chan.output_string
+ Lwt_io.write
out_ch (Format.sprintf "%x\r\n" len) >>= fun () ->
- Lwt_chan.output out_ch buffer 0 len >>= fun () ->
- Lwt_chan.output_string out_ch "\r\n"
+ Lwt_io.write_from_exactly out_ch buffer 0 len >>= fun () ->
+ Lwt_io.write out_ch "\r\n"
end else
Lwt.return ()) >>= fun () ->
- Lwt_chan.output_string out_ch "0\r\n\r\n"
+ Lwt_io.write out_ch "0\r\n\r\n"
| Ocsigen_stream.Cont (s, next) ->
let l = String.length s in
if l = 0 then
@@ -670,24 +672,24 @@ let write_stream_chunked out_ch stream =
else
if l >= size_for_not_buffering then begin
(if len > 0 then begin
- Lwt_chan.output_string
+ Lwt_io.write
out_ch (Format.sprintf "%x\r\n" len) >>= fun () ->
- Lwt_chan.output out_ch buffer 0 len >>= fun () ->
- Lwt_chan.output_string out_ch "\r\n"
+ Lwt_io.write_from_exactly out_ch buffer 0 len >>= fun () ->
+ Lwt_io.write out_ch "\r\n"
end else Lwt.return ()) >>= fun () ->
- Lwt_chan.output_string
+ Lwt_io.write
out_ch (Format.sprintf "%x\r\n" l) >>= fun () ->
- Lwt_chan.output out_ch s 0 l >>= fun () ->
- Lwt_chan.output_string out_ch "\r\n" >>= fun () ->
+ Lwt_io.write_from_exactly out_ch s 0 l >>= fun () ->
+ Lwt_io.write out_ch "\r\n" >>= fun () ->
aux next 0
end else (* Will not work if l is very large: *)
let available = buf_size - len in
if l > available then begin
- Lwt_chan.output_string
+ Lwt_io.write
out_ch (Format.sprintf "%x\r\n" buf_size) >>= fun () ->
- Lwt_chan.output out_ch buffer 0 len >>= fun () ->
- Lwt_chan.output out_ch s 0 available >>= fun () ->
- Lwt_chan.output_string out_ch "\r\n" >>= fun () ->
+ Lwt_io.write_from_exactly out_ch buffer 0 len >>= fun () ->
+ Lwt_io.write_from_exactly out_ch s 0 available >>= fun () ->
+ Lwt_io.write out_ch "\r\n" >>= fun () ->
let newlen = l - available in
String.blit s available buffer 0 newlen;
aux next newlen
@@ -705,7 +707,7 @@ let rec write_stream_raw out_ch stream =
| Ocsigen_stream.Finished _ ->
Lwt.return ()
| Ocsigen_stream.Cont (s, next) ->
- Lwt_chan.output_string out_ch s >>= fun () ->
+ Lwt_io.write out_ch s >>= fun () ->
write_stream_raw out_ch next
(*XXX We should check the length of the stream:
@@ -742,7 +744,7 @@ let send_100_continue slot =
} in
Lwt_log.ign_info ~section "writing 100-continue";
Lwt_log.ign_info ~section hh;
- Lwt_chan.output_string out_ch hh
+ Lwt_io.write out_ch hh
(** Sends the HTTP frame.
* The headers are merged with those of the sender, the priority
@@ -842,13 +844,13 @@ let send
let hh = Framepp.string_of_header hd in
Lwt_log.ign_info_f ~section "writing header\n%s" hh;
observe_result hd hh >>= fun () ->
- Lwt_chan.output_string out_ch hh >>= fun () ->
+ Lwt_io.write out_ch hh >>= fun () ->
(if reopen <> None then
(* If we want to give a possibility to reopen if
it fails, we must detect the failure before
beginning to read the stream
*)
- Lwt_chan.flush out_ch
+ Lwt_io.flush out_ch
else Lwt.return ())
)
(fun e -> (* *** If we are doing a request,
@@ -879,8 +881,8 @@ let send
Lwt_log.ign_info ~section "writing body";
write_stream ~chunked out_ch (fst (Result.stream res))
end) >>= fun () ->
- Lwt_chan.flush out_ch (* Vincent: I add this otherwise HEAD answers
- are not flushed by the reverse proxy *)
+ Lwt_io.flush out_ch (* Vincent: I add this otherwise HEAD answers
+ are not flushed by the reverse proxy *)
>>= fun () ->
Ocsigen_stream.finalize (fst (Result.stream res)) `Success
)
diff --git a/src/http/ocsigen_senders.ml b/src/http/ocsigen_senders.ml
index 9fbe98f..708b6a8 100644
--- a/src/http/ocsigen_senders.ml
+++ b/src/http/ocsigen_senders.ml
@@ -56,7 +56,7 @@ module Make_XML_Content(Xml : Xml_sigs.Iterable)
| ((Some a, Some b),_,_) -> a^"/"^b = content_type
| _ -> false)
(Lazy.force accepted))
- alt
+ (default :: alt)
with Not_found -> default
let result_of_content ?options c =
@@ -264,7 +264,13 @@ struct
try
let st = Unix.LargeFile.fstat fdu in
let etag = get_etag_aux st in
- let stream = read_file fd in
+ let buffer_size =
+ if st.Unix.LargeFile.st_size <=
+ Int64.of_int (Ocsigen_config.get_filebuffersize ()) then
+ Some (Int64.to_int st.Unix.LargeFile.st_size)
+ else
+ None in
+ let stream = read_file ?buffer_size fd in
let default_result = Result.default () in
Lwt.return
(Result.update default_result
diff --git a/src/server/Makefile b/src/server/Makefile
index 8bfccf9..b68d131 100644
--- a/src/server/Makefile
+++ b/src/server/Makefile
@@ -4,7 +4,7 @@ all: byte opt
PACKAGE := ${SERVER_PACKAGE} ${SERVER_SYNTAX} ## See ../../Makefile.options
LIBS := -I ../baselib -I ../http ${addprefix -package ,${PACKAGE}} -I .
-OCAMLC := $(OCAMLFIND) ocamlc${BYTEDBG} ${THREAD}
+OCAMLC := $(OCAMLFIND) ocamlc ${BYTEDBG} ${THREAD}
OCAMLOPT := $(OCAMLFIND) ocamlopt ${OPTDBG} ${THREAD}
OCAMLDOC := $(OCAMLFIND) ocamldoc
OCAMLDEP := $(OCAMLFIND) ocamldep
diff --git a/src/server/ocsigen_http_client.ml b/src/server/ocsigen_http_client.ml
index 49aefe4..20f8a21 100644
--- a/src/server/ocsigen_http_client.ml
+++ b/src/server/ocsigen_http_client.ml
@@ -370,7 +370,10 @@ let raw_request
fd sockaddr >>= fun () ->
(if https then
- Lwt_ssl.ssl_connect fd !sslcontext
+ let s = Lwt_ssl.embed_uninitialized_socket fd !sslcontext in
+ Ssl.set_client_SNI_hostname
+ (Lwt_ssl.ssl_socket_of_uninitialized_socket s) host;
+ Lwt_ssl.ssl_perform_handshake s
else
Lwt.return (Lwt_ssl.plain fd))
>>= fun socket ->
@@ -757,7 +760,10 @@ let basic_raw_request
(fun () ->
Lwt_unix.connect fd sockaddr >>= fun () ->
(if https then
- Lwt_ssl.ssl_connect fd !sslcontext
+ let s = Lwt_ssl.embed_uninitialized_socket fd !sslcontext in
+ Ssl.set_client_SNI_hostname
+ (Lwt_ssl.ssl_socket_of_uninitialized_socket s) host;
+ Lwt_ssl.ssl_perform_handshake s
else
Lwt.return (Lwt_ssl.plain fd)))
(handle_connection_error fd)
diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml
index f178761..67facc6 100644
--- a/src/server/ocsigen_server.ml
+++ b/src/server/ocsigen_server.ml
@@ -992,6 +992,11 @@ let rec wait_connection use_ssl port socket =
(fun e ->
Ocsigen_messages.unexpected_exception e
"Server.wait_connection (handle connection)";
+ (match e with
+ | Ssl.Accept_error(Ssl.Error_ssl|Ssl.Error_syscall) ->
+ Ocsigen_messages.warning
+ ("Last SSL error: " ^ Ssl.get_error_string ())
+ | _ -> ());
return ())
>>= fun () ->
Lwt_log.ign_info ~section "** CLOSE";
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocsigenserver.git
More information about the Pkg-ocaml-maint-commits
mailing list