ocsigenserver: implement "Expect: 100-continue" support

Match the expect header case insensitively, and send a 100-continue header.
This makes the PUT query in a64f168 actually
useful.

The code was tested on top of ocsigenserver-2.2.0 for quite some time,
as shown by the original commit date.

Author: Török Edwin

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"

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

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

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

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.

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

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 () ->
@@ -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 *)