[Pkg-ocaml-maint-commits] [ocsigenserver] 03/07: Imported Upstream version 2.4.0
Stéphane Glondu
glondu at moszumanska.debian.org
Fri Jun 27 08:18:40 UTC 2014
This is an automated email from the git hooks/post-receive script.
glondu pushed a commit to branch master
in repository ocsigenserver.
commit cf340b2a45f576ac2aff14832c48ce28cf6830eb
Author: Stephane Glondu <steph at glondu.net>
Date: Thu Jun 19 07:26:13 2014 +0200
Imported Upstream version 2.4.0
---
Makefile.dist | 41 ++++++++++
Makefile.options | 4 +-
README | 6 +-
VERSION | 2 +-
doc/Makefile | 2 +-
doc/indexdoc | 2 +-
opam/opam | 10 ++-
src/baselib/Makefile | 2 +-
src/baselib/ocsigen_config.mli | 2 +
src/baselib/ocsigen_lib.ml | 166 --------------------------------------
src/baselib/ocsigen_lib.mli | 17 ----
src/extensions/Makefile | 1 +
src/extensions/accesscontrol.ml | 24 +++---
src/files/META.in | 2 +-
src/http/http_headers.ml | 1 +
src/http/http_headers.mli | 1 +
src/http/ocsigen_headers.ml | 10 +++
src/http/ocsigen_headers.mli | 1 +
src/http/ocsigen_http_com.ml | 12 +++
src/http/ocsigen_http_com.mli | 3 +-
src/server/ocsigen_extensions.ml | 2 +-
src/server/ocsigen_extensions.mli | 2 +-
src/server/ocsigen_server.ml | 46 +++++++++--
23 files changed, 145 insertions(+), 214 deletions(-)
diff --git a/Makefile.dist b/Makefile.dist
new file mode 100644
index 0000000..615c64a
--- /dev/null
+++ b/Makefile.dist
@@ -0,0 +1,41 @@
+
+##
+## Usage:
+##
+## If the released version is tagged in the main repository, use:
+##
+## make -f Makefile.dist
+##
+## If the tag has not been pushed, use:
+##
+## make -f Makefile.dist REPO=${PWD}
+##
+## otherwise, use:
+##
+## make -f Makefile.dist REPO=${PWD} VERSION=master
+##
+
+#VERSION?=$(shell grep Version: _oasis | cut -d ' ' -f 2)
+VERSION=$(shell cat VERSION)
+REPO?=https://github.com/ocsigen/ocsigenserver
+
+all: dist sign
+
+dist:
+ @rm -rf ocsigenserver-${VERSION} \
+ ocsigenserver-${VERSION}.tar.gz \
+ ocsigenserver-${VERSION}.tar.gz.asc
+ git clone --local -b ${VERSION} ${REPO} ocsigenserver-${VERSION}
+# oasis -C ocsigenserver-${VERSION} setup
+# sed -i "s/SETUP := setup-dev.exe/SETUP := setup.exe/" \
+# ocsigenserver-${VERSION}/Makefile
+ cd ocsigenserver-${VERSION} && rm -rf .git .gitignore Makefile.dist
+ tar cvzf ocsigenserver-${VERSION}.tar.gz ocsigenserver-${VERSION}
+ @rm -rf ocsigenserver-${VERSION}
+
+sign: ocsigenserver-${VERSION}.tar.gz.asc
+
+ocsigenserver-${VERSION}.tar.gz.asc: ocsigenserver-${VERSION}.tar.gz
+ gpg --armor -b $^
+
+.PHONY: dist sign
diff --git a/Makefile.options b/Makefile.options
index 67af166..bd3a8fa 100644
--- a/Makefile.options
+++ b/Makefile.options
@@ -29,10 +29,11 @@ ifeq "$(PREEMPTIVE)" "YES"
LWT_EXTRA_PACKAGE:=lwt.extra
endif
-BASE_PACKAGE := lwt
+BASE_PACKAGE := lwt ipaddr
SERVER_PACKAGE := lwt.ssl \
${LWT_EXTRA_PACKAGE} \
+ ipaddr \
netstring \
netstring-pcre \
findlib \
@@ -51,4 +52,3 @@ INITPACKAGE := \"$(shell ${OCAMLFIND} query -p-format -recursive \
\"${PROJECTNAME}.baselib\"; \
\"${PROJECTNAME}.http\"; \
\"${PROJECTNAME}\"; \
-
diff --git a/README b/README
index 3f8963e..3c7bf02 100644
--- a/README
+++ b/README
@@ -15,15 +15,17 @@ Libraries:
* findlib
* react (tested with 0.9.3)
* ocamlssl (tested with 0.4.6)
- * lwt (need version >= 2.4.2, with react and ssl support)
+ * lwt (need version >= 2.4.2, with react and ssl support)
* ocamlnet (tested with 3.6, with netstring, netstring-pcre and netsys)
* pcre-ocaml (tested with 6.2.5)
* cryptokit (tested with 1.6)
* ocaml-text (tested with 0.6)
- * tyxml (need version 2.2)
+ * tyxml (need version 3)
+ * ipaddr (need version >= 2.1)
* ocamlsqlite3 (tested with 2.0.2) OR
* dbm (tested with 1.0)
+
Optional libraries:
* camlzip (tested with 1.04)
diff --git a/VERSION b/VERSION
index 2bf1c1c..197c4d5 100644
--- a/VERSION
+++ b/VERSION
@@ -1 +1 @@
-2.3.1
+2.4.0
diff --git a/doc/Makefile b/doc/Makefile
index af00ef1..5a2a6f1 100644
--- a/doc/Makefile
+++ b/doc/Makefile
@@ -4,7 +4,7 @@ include ../src/Makefile.filelist
OCAMLDOC := ${OCAMLFIND} ocamldoc
ODOC_WIKI := odoc_wiki.cma
-LIBS := -package lwt,tyxml,ssl,netstring-pcre \
+LIBS := -package lwt,tyxml,ssl,netstring-pcre,ipaddr \
${addprefix -I ../src/, baselib http server extensions }
doc: api-html/index.html
diff --git a/doc/indexdoc b/doc/indexdoc
index 1482890..0e56003 100644
--- a/doc/indexdoc
+++ b/doc/indexdoc
@@ -11,7 +11,7 @@ Ocsipersist
Ocsigen_config
}
-{2 Extending Ocsigen}
+{2 Extending Ocsigen Server}
{!modules:
Ocsigen_extensions
Ocsigen_local_files
diff --git a/opam/opam b/opam/opam
index 2012b75..5c6f9aa 100644
--- a/opam/opam
+++ b/opam/opam
@@ -2,8 +2,8 @@ opam-version: "1"
maintainer: "dev at ocsigen.org"
build: [
["sh" "configure" "--prefix" "%{prefix}%" "--ocsigen-user" "%{user}%" "--ocsigen-group" "%{group}%" "--commandpipe" "%{lib}%/ocsigenserver/var/run/ocsigenserver_command" "--logdir" "%{lib}%/ocsigenserver/var/log/ocsigenserver" "--mandir" "%{man}%/man1" "--docdir" "%{lib}%/ocsigenserver/share/doc/ocsigenserver" "--commandpipe" "%{lib}%/ocsigenserver/var/run/ocsigenserver_command" "--staticpagesdir" "%{lib}%/ocsigenserver/var/www" "--datadir" "%{lib}%/ocsigenserver/var/lib/ocsigenserver" [...]
- ["%{make}%"]
- ["%{make}%" "install"]
+ [make]
+ [make "install"]
]
remove: [
["rm" "-rf" "%{lib}%/ocsigenserver"]
@@ -20,7 +20,11 @@ depends: [
"cryptokit"
"tyxml" {>= "9999"}
("dbm" | "sqlite3-ocaml")
+ "ipaddr" {>= "2.1"}
]
depopts: [
- "camlzip" {>= "1.04"}
+ "camlzip"
+]
+conflicts: [
+ "camlzip" {< "1.04"}
]
diff --git a/src/baselib/Makefile b/src/baselib/Makefile
index 956410a..3d56a4c 100644
--- a/src/baselib/Makefile
+++ b/src/baselib/Makefile
@@ -1,6 +1,6 @@
include ../../Makefile.config
-LIBS := -package lwt.unix,netstring,netstring-pcre,cryptokit,findlib,tyxml,lwt.syntax,${LWT_EXTRA_PACKAGE}
+LIBS := -package lwt.unix,netstring,netstring-pcre,cryptokit,findlib,tyxml,lwt.syntax,${LWT_EXTRA_PACKAGE},ipaddr
OCAMLC := $(OCAMLFIND) ocamlc${BYTEDBG} ${THREAD}
OCAMLOPT := $(OCAMLFIND) ocamlopt ${OPTDBG} ${THREAD}
OCAMLDOC := $(OCAMLFIND) ocamldoc
diff --git a/src/baselib/ocsigen_config.mli b/src/baselib/ocsigen_config.mli
index e2aa095..3575568 100644
--- a/src/baselib/ocsigen_config.mli
+++ b/src/baselib/ocsigen_config.mli
@@ -16,6 +16,8 @@
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
+(** Configuring Ocsigen server *)
+
open Ocsigen_lib
exception Config_file_error of string
diff --git a/src/baselib/ocsigen_lib.ml b/src/baselib/ocsigen_lib.ml
index fb8d6f5..3f5e359 100644
--- a/src/baselib/ocsigen_lib.ml
+++ b/src/baselib/ocsigen_lib.ml
@@ -23,158 +23,8 @@ module String = String_base
(*****************************************************************************)
module Ip_address = struct
-
- type t =
- | IPv4 of int32
- | IPv6 of int64 * int64
-
- exception Invalid_ipaddress of string
-
- let parse s =
- let s = String.lowercase s in
- let n = String.length s in
- let is6 = String.contains s ':' in
- let failwith fmt = Printf.ksprintf (fun s -> raise (Invalid_ipaddress s)) fmt in
-
- let rec parse_hex i accu =
- match (if i < n then s.[i] else ':') with
- | '0'..'9' as c -> parse_hex (i+1) (16*accu+(int_of_char c)-48)
- | 'a'..'f' as c -> parse_hex (i+1) (16*accu+(int_of_char c)-87)
- | _ -> (i, accu)
- in
- let rec parse_dec i accu =
- match (if i < n then s.[i] else '.') with
- | '0'..'9' as c -> parse_dec (i+1) (10*accu+(int_of_char c)-48)
- | _ -> (i, accu)
- in
- let rec next_is_dec i =
- if i < n then
- match s.[i] with
- | ':' -> false
- | '.' -> true
- | _ -> next_is_dec (i+1)
- else false
- in
- let rec parse_component i accu nb =
- if i < n then
- if next_is_dec i then
- let (i1, a) = parse_dec i 0 in
- if i1 = i || (i1 < n && s.[i1] <> '.') then failwith "invalid dot notation in %s (1)" s;
- let (i2, b) = parse_dec (i1+1) 0 in
- if i2 = i1 then failwith "invalid dot notation in %s (2)" s;
- let component =
- if a < 0 || a > 255 || b < 0 || b > 255 then
- failwith "invalid dot notation in %s (3)" s
- else (a lsl 8) lor b
- in
- if i2 < n-1 && (s.[i2] = ':' || s.[i2] = '.') then
- parse_component (i2+1) (component::accu) (nb+1)
- else
- (i2, component::accu, nb+1)
- else if s.[i] = ':' then
- parse_component (i+1) ((-1)::accu) nb
- else
- let (i1, a) = parse_hex i 0 in
- if a < 0 || a > 0xffff then failwith "invalid colon notation in %s" s;
- if i1 = i then
- (i, accu, nb)
- else if i1 < n-1 && s.[i1] = ':' then
- parse_component (i1+1) (a::accu) (nb+1)
- else
- (i1, a::accu, nb+1)
- else
- (i, accu, nb)
- in
-
- let (i, addr_list, size_list) =
- if 1 < n && s.[0] = ':' && s.[1] = ':' then
- parse_component 2 [-1] 0
- else
- parse_component 0 [] 0
- in
-
- if size_list > 8 then failwith "too many components in %s" s;
-
- let maybe_mask =
- if i < n && s.[i] = '/' then
- let (i1, m) = parse_dec (i+1) 0 in
- if i1 = i+1 || i1 < n || m < 0 || m > (if is6 then 128 else 32) then
- failwith "invalid /n suffix in %s" s
- else
- Some m
- else if i < n then
- failwith "invalid suffix in %s (from index %i)" s i
- else
- None
- in
-
- if is6 then
- let (++) a b = Int64.logor (Int64.shift_left a 16) (Int64.of_int b) in
- let normalized =
- let rec aux_add n accu =
- if n = 0 then accu else aux_add (n-1) (0::accu)
- in
- let rec aux_rev accu = function
- | [] -> accu
- | (-1)::q -> aux_rev (aux_add (8-size_list) accu) q
- | a::q -> aux_rev (a::accu) q
- in
- aux_rev [] addr_list
- in
- let maybe_mask = match maybe_mask with
- | Some n when n > 64 ->
- Some (IPv6 (Int64.minus_one, Int64.shift_left Int64.minus_one (128-n)))
- | Some n ->
- Some (IPv6 (Int64.shift_left Int64.minus_one (64-n), Int64.zero))
- | None -> None
- in
- match normalized with
- | [a; b; c; d; e; f; g; h] ->
- IPv6 (Int64.zero ++ a ++ b ++ c ++ d,
- Int64.zero ++ e ++ f ++ g ++ h), maybe_mask
- | _ -> failwith "invalid IPv6 address: %s (%d components)" s (List.length normalized)
- else
- let (++) a b = Int32.logor (Int32.shift_left a 16) (Int32.of_int b) in
- let maybe_mask = match maybe_mask with
- | Some n ->
- Some (IPv4 (Int32.shift_left Int32.minus_one (32-n)))
- | None -> None
- in
- match addr_list with
- | [b; a] ->
- IPv4 (Int32.zero ++ a ++ b), maybe_mask
- | _ -> failwith "invalid IPv4 address: %s" s
-
-
- let match_ip (base, mask) ip =
- match ip, base, mask with
- | IPv4 a, IPv4 b, Some (IPv4 m) -> Int32.logand a m = Int32.logand b m
- | IPv4 a, IPv4 b, None -> a = b
- | IPv6 (a1,a2), IPv6 (b1,b2), Some (IPv6 (m1,m2)) ->
- Int64.logand a1 m1 = Int64.logand b1 m1 &&
- Int64.logand a2 m2 = Int64.logand b2 m2
- | IPv6 (a1,a2), IPv6 (b1,b2), None -> a1 = b1 && a2 = b2
- | IPv6 (a1,a2), IPv4 b, c
- when a1 = 0L && Int64.logand a2 0xffffffff00000000L = 0xffff00000000L ->
- (* might be insecure, cf
- http://tools.ietf.org/internet-drafts/draft-itojun-v6ops-v4mapped-harmful-02.txt *)
- let a = Int64.to_int32 a2 in
- begin match c with
- | Some (IPv4 m) -> Int32.logand a m = Int32.logand b m
- | Some (IPv6 _) -> invalid_arg "match_ip"
- | None -> a = b
- end
- | _ -> false
-
- let network_of_ip ip mask4 (mask61, mask62) = match ip with
- | IPv4 a -> IPv4 (Int32.logand a mask4)
- | IPv6 (a, b) -> IPv6 (Int64.logand a mask61, Int64.logand b mask62)
-
exception No_such_host
- let inet6_addr_loopback =
- fst (parse (Unix.string_of_inet_addr Unix.inet6_addr_loopback))
-
let get_inet_addr ?(v6=false) host =
let rec aux = function
| [] -> Lwt.fail No_such_host
@@ -186,22 +36,6 @@ module Ip_address = struct
(Lwt_unix.getaddrinfo host "" options)
aux
-(*
- let getnameinfo ia p =
- try
- Lwt_unix.getnameinfo (Unix.ADDR_INET (ia, p)) [Unix.NI_NAMEREQD] >>= fun r ->
- Lwt.return r.Unix.ni_hostname
- with
- | Not_found ->
- let hs = Unix.string_of_inet_addr ia in
- Lwt.return
- (if String.length hs > 7 && String.sub hs 0 7 = "::ffff:"
- then String.sub hs 7 (String.length hs - 7)
- else if String.contains hs ':'
- then "["^hs^"]"
- else hs)
-
- *)
end
(*****************************************************************************)
diff --git a/src/baselib/ocsigen_lib.mli b/src/baselib/ocsigen_lib.mli
index 55cbe43..70b9844 100644
--- a/src/baselib/ocsigen_lib.mli
+++ b/src/baselib/ocsigen_lib.mli
@@ -36,25 +36,8 @@ val make_cryptographic_safe_string : unit -> string
module String : module type of String_base
module Ip_address : sig
-
- type t =
- | IPv4 of int32
- | IPv6 of int64 * int64
-
- (* exception Invalid_ipaddress of string *)
-
- val parse : string -> t * (t option)
- val match_ip : t * (t option) -> t -> bool
- val network_of_ip : t -> int32 -> int64 * int64 -> t
-
exception No_such_host
-
- val inet6_addr_loopback : t
-
val get_inet_addr : ?v6:bool -> string -> Unix.inet_addr Lwt.t
-
- (* val getnameinfo : Unix.inet_addr -> int -> string Lwt.t *)
-
end
module Filename : sig
diff --git a/src/extensions/Makefile b/src/extensions/Makefile
index 6caeb92..782be40 100644
--- a/src/extensions/Makefile
+++ b/src/extensions/Makefile
@@ -1,6 +1,7 @@
include ../../Makefile.config
PACKAGE := lwt.unix \
+ ipaddr \
lwt.ssl \
lwt.react \
netstring \
diff --git a/src/extensions/accesscontrol.ml b/src/extensions/accesscontrol.ml
index 932b9d7..8b2b6aa 100644
--- a/src/extensions/accesscontrol.ml
+++ b/src/extensions/accesscontrol.ml
@@ -43,16 +43,18 @@ open Ocsigen_http_frame
let rec parse_condition = function
| Element ("ip", ["value", s], []) ->
- let ip_with_mask =
+ let prefix =
try
- Ip_address.parse s
- with Failure _ ->
- badconfig "Bad ip/netmask [%s] in <ip> condition" s
+ Ipaddr.Prefix.of_string_exn s
+ with Ipaddr.Parse_error _ ->
+ try
+ let ip = Ipaddr.of_string_exn s in
+ Ipaddr.Prefix.of_addr ip
+ with _ ->
+ badconfig "Bad ip/netmask [%s] in <ip> condition" s
in
(fun ri ->
- let r =
- Ip_address.match_ip ip_with_mask
- (Lazy.force ri.ri_remote_ip_parsed)
+ let r = Ipaddr.Prefix.mem (Lazy.force ri.ri_remote_ip_parsed) prefix
in
if r then
Ocsigen_messages.debug2 (sprintf "--Access control (ip): %s matches %s" ri.ri_remote_ip s)
@@ -230,10 +232,10 @@ let parse_config parse_fun = function
| Element ("nextsite", [], []) ->
(function
| Ocsigen_extensions.Req_found (_, r) ->
- Lwt.return (Ocsigen_extensions.Ext_found_stop
+ Lwt.return (Ocsigen_extensions.Ext_found_stop
(fun () -> Lwt.return r))
| Ocsigen_extensions.Req_not_found (err, ri) ->
- Lwt.return (Ocsigen_extensions.Ext_stop_site
+ Lwt.return (Ocsigen_extensions.Ext_stop_site
(Ocsigen_cookies.Cookies.empty, 404)))
| Element ("nexthost", [], []) ->
@@ -310,7 +312,7 @@ let parse_config parse_fun = function
request
| original_ip::proxies ->
let last_proxy = List.last proxies in
- let proxy_ip = fst (Ip_address.parse last_proxy) in
+ let proxy_ip = Ipaddr.of_string_exn last_proxy in
let equal_ip = proxy_ip = Lazy.force request.request_info.ri_remote_ip_parsed in
let need_equal_ip =
match param with
@@ -326,7 +328,7 @@ let parse_config parse_fun = function
{ request with request_info =
{ request.request_info with
ri_remote_ip = original_ip;
- ri_remote_ip_parsed = lazy (fst (Ip_address.parse original_ip));
+ ri_remote_ip_parsed = lazy (Ipaddr.of_string_exn original_ip);
ri_forward_ip = proxies; } }
else (* the announced ip of the proxy is not its real ip *)
( Ocsigen_messages.warning (Printf.sprintf "--Access control: X-Forwarded-For: host ip ( %s ) does not match the header ( %s )" request.request_info.ri_remote_ip header );
diff --git a/src/files/META.in b/src/files/META.in
index 6d7bcc7..1e3f38f 100644
--- a/src/files/META.in
+++ b/src/files/META.in
@@ -100,7 +100,7 @@ package "ext" (
package "accesscontrol" (
exists_if = "accesscontrol.cmo,accesscontrol.cmx"
- requires = "ocsigenserver"
+ requires = "ocsigenserver,ipaddr"
version = "[distributed with Ocsigen server]"
description = "Filtering HTTP requests"
archive(byte) = "accesscontrol.cmo"
diff --git a/src/http/http_headers.ml b/src/http/http_headers.ml
index 5e60d19..fa258a8 100644
--- a/src/http/http_headers.ml
+++ b/src/http/http_headers.ml
@@ -36,6 +36,7 @@ let content_type = name "Content-Type"
let cookie = name "Cookie"
let date = name "Date"
let etag = name "ETag"
+let expect = name "Expect"
let expires = name "Expires"
let host = name "Host"
let if_match = name "If-Match"
diff --git a/src/http/http_headers.mli b/src/http/http_headers.mli
index b2f87ee..d7d0c1c 100644
--- a/src/http/http_headers.mli
+++ b/src/http/http_headers.mli
@@ -43,6 +43,7 @@ val content_range : name
val cookie : name
val date : name
val etag : name
+val expect: name
val expires : name
val host : name
val if_match : name
diff --git a/src/http/ocsigen_headers.ml b/src/http/ocsigen_headers.ml
index bf5ed0a..ef8a66c 100644
--- a/src/http/ocsigen_headers.ml
+++ b/src/http/ocsigen_headers.ml
@@ -187,6 +187,16 @@ let get_cookie_string http_frame =
with Not_found ->
None
+let get_expect http_frame =
+ try
+ String.split ',' (
+ Http_header.get_headers_value
+ http_frame.Ocsigen_http_frame.frame_header
+ Http_headers.expect
+ )
+ with Not_found ->
+ []
+
let get_if_modified_since http_frame =
try
Some (Netdate.parse_epoch
diff --git a/src/http/ocsigen_headers.mli b/src/http/ocsigen_headers.mli
index a2d9247..b60f854 100644
--- a/src/http/ocsigen_headers.mli
+++ b/src/http/ocsigen_headers.mli
@@ -39,6 +39,7 @@ val get_host_from_host_header : Ocsigen_http_frame.t ->
string option * int option
val get_user_agent : Ocsigen_http_frame.t -> string
val get_cookie_string : Ocsigen_http_frame.t -> string option
+val get_expect : Ocsigen_http_frame.t -> string list
val get_if_modified_since : Ocsigen_http_frame.t -> float option
val get_if_unmodified_since : Ocsigen_http_frame.t -> float option
val get_if_none_match : Ocsigen_http_frame.t -> string list option
diff --git a/src/http/ocsigen_http_com.ml b/src/http/ocsigen_http_com.ml
index 781b0e2..49f8de8 100644
--- a/src/http/ocsigen_http_com.ml
+++ b/src/http/ocsigen_http_com.ml
@@ -731,6 +731,18 @@ let set_result_observer, observe_result =
observer := (fun a b -> o a b >>= fun () -> f a b)),
(fun a b -> !observer a b))
+let send_100_continue slot =
+ wait_previous_senders slot >>= fun () ->
+ let out_ch = slot.sl_chan in
+ Ocsigen_messages.debug2 "writing 100-continue";
+ let hh = Framepp.string_of_header {
+ H.mode = H.Answer 100;
+ proto = H.HTTP11;
+ headers = Http_headers.empty
+ } in
+ Ocsigen_messages.debug2 hh;
+ Lwt_chan.output_string out_ch hh
+
(** Sends the HTTP frame.
* The headers are merged with those of the sender, the priority
* being given to the newly defined header in case of conflict.
diff --git a/src/http/ocsigen_http_com.mli b/src/http/ocsigen_http_com.mli
index 6c3e748..85656c7 100644
--- a/src/http/ocsigen_http_com.mli
+++ b/src/http/ocsigen_http_com.mli
@@ -82,7 +82,8 @@ val create_sender :
(** Sender with only the server name, and HTTP/1.1 *)
val default_sender : sender_type
-
+(** send an HTTP/1.1 100 Continue message *)
+val send_100_continue : slot -> unit Lwt.t
(** send an HTTP message.
[send] may also fail with [Interrupted_stream] exception if the input
diff --git a/src/server/ocsigen_extensions.ml b/src/server/ocsigen_extensions.ml
index fee9c60..8dcddf0 100644
--- a/src/server/ocsigen_extensions.ml
+++ b/src/server/ocsigen_extensions.ml
@@ -216,7 +216,7 @@ type request_info =
ri_files: (config_info -> (string * file_info) list Lwt.t) option; (** Files sent in the request (multipart data). None if other content type or no content. *)
ri_remote_inet_addr: Unix.inet_addr; (** IP of the client *)
ri_remote_ip: string; (** IP of the client *)
- ri_remote_ip_parsed: Ip_address.t Lazy.t; (** IP of the client, parsed *)
+ ri_remote_ip_parsed: Ipaddr.t Lazy.t; (** IP of the client, parsed *)
ri_remote_port: int; (** Port used by the client *)
ri_forward_ip: string list; (** IPs of gateways the request went throught *)
ri_server_port: int; (** Port of the request (server) *)
diff --git a/src/server/ocsigen_extensions.mli b/src/server/ocsigen_extensions.mli
index ffd58db..477c9ae 100644
--- a/src/server/ocsigen_extensions.mli
+++ b/src/server/ocsigen_extensions.mli
@@ -164,7 +164,7 @@ type request_info =
ri_files: (config_info -> (string * file_info) list Lwt.t) option; (** Files sent in the request (multipart data). None if other content type or no content. *)
ri_remote_inet_addr: Unix.inet_addr; (** IP of the client *)
ri_remote_ip: string; (** IP of the client *)
- ri_remote_ip_parsed: Ip_address.t Lazy.t; (** IP of the client, parsed *)
+ ri_remote_ip_parsed: Ipaddr.t Lazy.t; (** IP of the client, parsed *)
ri_remote_port: int; (** Port used by the client *)
ri_forward_ip: string list; (** IPs of gateways the request went throught *)
ri_server_port: int; (** Port of the request (server) *)
diff --git a/src/server/ocsigen_server.ml b/src/server/ocsigen_server.ml
index 2af1c1c..a72c5a2 100644
--- a/src/server/ocsigen_server.ml
+++ b/src/server/ocsigen_server.ml
@@ -234,11 +234,47 @@ and find_post_params_multipart_form_data body_gen ctparams filenames ci =
Ocsigen_stream.consume body_gen >>= fun () ->
Lwt.return (!params, !files)
+let wrap_stream f x frame_content =
+ Ocsigen_stream.make ~finalize:(fun outcome ->
+ match frame_content with
+ | Some stream ->
+ Ocsigen_stream.finalize stream outcome
+ | None ->
+ Lwt.return ()
+ )
+ (fun () ->
+ f x >>= fun () ->
+ match frame_content with
+ | Some stream ->
+ Ocsigen_stream.next (Ocsigen_stream.get stream)
+ | None ->
+ Ocsigen_stream.empty None
+ )
+let handle_100_continue slot frame =
+ { frame with
+ frame_content = Some (wrap_stream send_100_continue slot
+ frame.frame_content)
+ }
+
+let handle_expect slot frame =
+ let expect_list = Ocsigen_headers.get_expect frame in
+ let proto = Http_header.get_proto frame.frame_header in
+ List.fold_left (fun frame tok ->
+ match String.lowercase tok with
+ | "100-continue" ->
+ if proto = Http_header.HTTP11 then
+ handle_100_continue slot frame
+ else
+ frame
+ | _ ->
+ raise (Ocsigen_http_error (Ocsigen_cookies.empty_cookieset, 417))
+ ) frame expect_list
(* reading the request *)
let get_request_infos
- meth clientproto url http_frame filenames sockaddr port receiver =
+ meth clientproto url http_frame filenames sockaddr port receiver
+ sender_slot =
Lwt.catch
(fun () ->
@@ -373,7 +409,7 @@ let get_request_infos
ri_files = files;
ri_remote_inet_addr = client_inet_addr;
ri_remote_ip = ipstring;
- ri_remote_ip_parsed = lazy (fst (Ip_address.parse ipstring));
+ ri_remote_ip_parsed = lazy (Ipaddr.of_string_exn ipstring);
ri_remote_port = port_of_sockaddr sockaddr;
ri_forward_ip = [];
ri_server_port = port;
@@ -395,7 +431,7 @@ let get_request_infos
ri_accept_charset = accept_charset;
ri_accept_encoding = accept_encoding;
ri_accept_language = accept_language;
- ri_http_frame = http_frame;
+ ri_http_frame = handle_expect sender_slot http_frame;
ri_request_cache = Polytables.create ();
ri_client = Ocsigen_extensions.client_of_connection receiver;
ri_range = lazy (Ocsigen_range.get_range http_frame);
@@ -657,7 +693,7 @@ let service receiver sender_slot request meth url port sockaddr =
(fun () ->
get_request_infos
meth clientproto url request filenames sockaddr
- port receiver)
+ port receiver sender_slot)
(fun ri ->
(* *** Now we generate the page and send it *)
(* Log *)
@@ -1365,7 +1401,7 @@ let start_server () = try
let f =
Unix.openfile
p
- [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_APPEND] 0o640 in
+ [Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC] 0o640 in
ignore (Unix.write f spid 0 len);
Unix.close f
in
--
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