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 <st...@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: "d...@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

_______________________________________________
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

Reply via email to