implement full compliance of content-type for uploaded files w.r.t. RFC

Author: Vincent Balat

src/http/ocsigen_headers.ml

@@ -156,8 +156,8 @@ let get_keepalive http_header =
 (* RFC 2616, sect. 14.23 *)
 (* XXX Not so simple: the host name may contain a colon! (RFC 3986) *)
 let get_host_from_host_header =
-  let host_re = 
-    Netstring_pcre.regexp "^(\\[[0-9A-Fa-f:.]+\\]|[^:]+)(:([0-9]+))?$" 
+  let host_re =
+    Netstring_pcre.regexp "^(\\[[0-9A-Fa-f:.]+\\]|[^:]+)(:([0-9]+))?$"
   in
   fun http_frame ->
     try
@@ -166,9 +166,9 @@ let get_host_from_host_header =
           http_frame.Ocsigen_http_frame.frame_header Http_headers.host
       in
       match Netstring_pcre.string_match host_re hostport 0 with
-        | Some m -> 
+        | Some m ->
             (Some (Netstring_pcre.matched_group m 1 hostport),
-             try Some (int_of_string 
+             try Some (int_of_string
                          (Netstring_pcre.matched_group m 3 hostport))
              with Not_found -> None | Failure _ -> raise Ocsigen_Bad_Request)
         | None -> raise Ocsigen_Bad_Request
@@ -237,16 +237,18 @@ let parse_content_type = function
       match String.split ';' s with
         | [] -> None
         | a::l ->
+          let (typ, subtype) =
             try
-              let (typ, subtype) = String.sep '/' a in
-              let params = 
-                try
-                  List.map (String.sep '=') l 
-                with Not_found -> []
-              in 
+              let typ, subtype = String.sep '/' a in (typ, Some subtype)
+            with Not_found -> a, None
+          in
+          let params =
+            try
+              List.map (String.sep '=') l
+            with Not_found -> []
+          in
 (*VVV If syntax error, we return no parameter at all *)
-              Some ((typ, subtype), params)
-            with Not_found -> None
+          Some ((typ, subtype), params)
 (*VVV If syntax error in type, we return None *)
 
 
@@ -336,4 +338,3 @@ let get_accept_language http_frame =
       (Http_header.get_headers_values
          http_frame.Ocsigen_http_frame.frame_header Http_headers.accept_language)
   with _ -> []
-

src/http/ocsigen_senders.ml

@@ -114,10 +114,10 @@ module Text_content =
          res_headers= Http_headers.dyn_headers;
          res_stream =
             (Ocsigen_stream.make
-               (fun () -> 
+               (fun () ->
                   Ocsigen_stream.cont c (fun () -> Ocsigen_stream.empty None)),
              None)
-               
+
             }
 
   end
@@ -195,7 +195,7 @@ module Streamlist_content =
         {default_result with
          res_content_length = None;
          res_etag = get_etag c;
-         res_stream = 
+         res_stream =
             (Ocsigen_stream.make ~finalize (fun _ -> next_stream c), None);
          res_headers= Http_headers.dyn_headers;
          res_content_type = Some ct}

src/server/ocsigen_extensions.ml

@@ -193,7 +193,8 @@ type file_info = {
     filesize: int64;
     raw_original_filename: string;
     original_basename: string ;
-    file_content_type: (string * string option) option;
+    file_content_type:
+      ((string * string option) * (string * string) list) option;
   }
 
 type request_info =

src/server/ocsigen_extensions.mli

@@ -140,7 +140,8 @@ type file_info = {
     filesize: int64;
     raw_original_filename: string;
     original_basename: string ;
-    file_content_type: (string * string option) option;
+    file_content_type:
+      ((string * string option) * (string * string) list) option;
   }
 
 (** The request *)

src/server/ocsigen_server.ml

@@ -31,7 +31,6 @@ open Ocsigen_parseconfig
 open Ocsigen_cookies
 open Lazy
 
-
 exception Ocsigen_unsupported_media
 exception Ssl_Exception
 exception Ocsigen_upload_forbidden
@@ -79,17 +78,17 @@ let make_sockets addr port =
            corresponds to the net.ipv6.bindv6only=0 behaviour on Linux,
            but is portable and should work with
            net.ipv6.bindv6only=1 as well. *)
-        let ipv6_socket =
-          try [make_ipv6_socket Unix.inet6_addr_any port]
-          with Unix.Unix_error
-              ((Unix.EAFNOSUPPORT | Unix.EPROTONOSUPPORT),
-               _, _) -> []
-        in
-        (make_ipv4_socket Unix.inet_addr_any port)::ipv6_socket
+      let ipv6_socket =
+        try [make_ipv6_socket Unix.inet6_addr_any port]
+        with Unix.Unix_error
+            ((Unix.EAFNOSUPPORT | Unix.EPROTONOSUPPORT),
+             _, _) -> []
+      in
+      (make_ipv4_socket Unix.inet_addr_any port)::ipv6_socket
     | IPv4 addr ->
-        [make_ipv4_socket addr port]
+      [make_ipv4_socket addr port]
     | IPv6 addr ->
-        [make_ipv6_socket addr port]
+      [make_ipv6_socket addr port]
 
 let sslctx = Ocsigen_http_client.sslcontext
 
@@ -112,7 +111,8 @@ let find_field field content_disp =
 
 type to_write =
     No_File of string * Buffer.t
-  | A_File of (string * string * string * Unix.file_descr * (string * string option) option)
+  | A_File of (string * string * string * Unix.file_descr
+               * ((string * string option) * (string * string) list) option)
 
 let counter = let c = ref (Random.int 1000000) in fun () -> c := !c + 1 ; !c
 
@@ -127,8 +127,6 @@ let dbg sockaddr s =
        "While talking to " ^ ip ^ ": " ^ s)
 
 
-let r_content_type = Netstring_pcre.regexp "([^ ]*)"
-
 let http_url_syntax = Hashtbl.find Neturl.common_url_syntax "http"
 
 let rec find_post_params http_frame ct filenames =
@@ -176,14 +174,7 @@ and find_post_params_multipart_form_data body_gen ctparams filenames ci =
     let content_type =
       try
         let ct = List.assoc "content-type" hs in
-        let content_type =
-          let (_, res) = Netstring_pcre.search_forward r_content_type ct 0 in
-          Netstring_pcre.matched_group res 1 ct
-        in
-        let charset = try
-          Some (find_field "charset" ct)
-        with _ -> None
-        in Some (content_type, charset)
+        Ocsigen_headers.parse_content_type (Some ct)
       with _ -> None
     in
     let cd = List.assoc "content-disposition" hs in