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 <st...@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 _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits