Skip to content

Commit 6b5e77c

Browse files
davesnxdavesnx
authored
Merge pull request #43 from davesnx/support-http-11-header
Treat chunks as HTTP 1.1
2 parents 6faa0c5 + 44c764e commit 6b5e77c

File tree

2 files changed

+48
-38
lines changed

2 files changed

+48
-38
lines changed

‎httpev.ml

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -382,10 +382,10 @@ let set_blocking req =
382382
req.blocking <- Some io;
383383
io
384384

385-
let make_request_headers code hdrs =
385+
let make_request_headers ~version code hdrs =
386386
let b = Buffer.create 1024 in
387387
let put s = Buffer.add_string b s; Buffer.add_string b "\r\n" in
388-
put (show_http_reply code);
388+
put (show_http_reply ~version code);
389389
List.iter (fun (n,v) -> bprintf b "%s: %s\r\n" n v) hdrs;
390390
put "Connection: close";
391391
put "";
@@ -403,7 +403,8 @@ let send_reply_async c encoding (code,hdrs,body) =
403403
let hdrs = ("Content-Length", string_of_int (String.length body)) :: hdrs in
404404
(* do not transfer body for HEAD requests *)
405405
let body = match c.req with Ready { meth = `HEAD; _ } -> "" | _ -> body in
406-
let headers = make_request_headers code hdrs in
406+
let version = `Http_1_0 in
407+
let headers = make_request_headers ~version code hdrs in
407408
if c.server.config.debug then
408409
log #info "will answer to %s with %d+%d bytes"
409410
(show_peer c)
@@ -413,9 +414,9 @@ let send_reply_async c encoding (code,hdrs,body) =
413414
with
414415
| exn -> abort c exn "send_reply_async"
415416

416-
let send_reply_blocking c (code,hdrs) =
417+
let send_reply_blocking c ~version (code,hdrs) =
417418
try
418-
write_reply_blocking c @@ make_request_headers code hdrs
419+
write_reply_blocking c @@ make_request_headers ~version code hdrs
419420
with
420421
exn -> abort c exn "send_reply_blocking"; raise exn
421422

@@ -458,7 +459,7 @@ let send_reply_user c req (code,hdrs,body) =
458459
(* this is forked child, events are gone, so write to socket with blocking *)
459460
Unix.clear_nonblock c.fd;
460461
let hdrs = match req.encoding with Identity -> hdrs | Gzip -> ("Content-Encoding", "gzip") :: hdrs in
461-
send_reply_blocking c (code,hdrs);
462+
send_reply_blocking c ~version:`Http_1_0 (code,hdrs);
462463
| false ->
463464
send_reply_async c req.encoding (code,hdrs,body)
464465

@@ -941,7 +942,8 @@ let send_reply c cout reply =
941942
in
942943
(* do not transfer body for HEAD requests *)
943944
let body = match c.req with Ready { meth = `HEAD; _ } -> `Body "" | _ -> body in
944-
let headers = make_request_headers code hdrs in
945+
let version = match body with `Body _ -> `Http_1_0 | `Chunks _ -> `Http_1_1 in
946+
let headers = make_request_headers ~version code hdrs in
945947
if c.server.config.debug then
946948
log #info "will answer to %s with %d+%s bytes"
947949
(show_peer c)

‎httpev_common.ml

Lines changed: 39 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ type request = { addr : Unix.sockaddr;
2929
encoding : encoding;
3030
}
3131

32-
type reply_status =
32+
type status_code =
3333
[ `Ok
3434
| `Created
3535
| `Accepted
@@ -52,9 +52,9 @@ type reply_status =
5252
| `Internal_server_error
5353
| `Not_implemented
5454
| `Service_unavailable
55-
| `Version_not_supported
56-
| `Custom of string ]
55+
| `Version_not_supported ]
5756

57+
type reply_status = [ status_code | `Custom of string ]
5858
type extended_reply_status = [ reply_status | `No_reply ]
5959

6060
type 'status reply' = 'status * (string * string) list * string
@@ -136,35 +136,43 @@ let status_code : reply_status -> int = function
136136

137137
| `Custom _ -> 999
138138

139-
let show_http_reply : reply_status -> string = function
140-
| `Ok -> "HTTP/1.0 200 OK"
141-
| `Created -> "HTTP/1.0 201 Created"
142-
| `Accepted -> "HTTP/1.0 202 Accepted"
143-
| `No_content -> "HTTP/1.0 204 No Content"
144-
145-
| `Moved -> "HTTP/1.0 301 Moved Permanently"
146-
| `Found -> "HTTP/1.0 302 Found"
147-
148-
| `Bad_request -> "HTTP/1.0 400 Bad Request"
149-
| `Unauthorized -> "HTTP/1.0 401 Unauthorized"
150-
| `Payment_required -> "HTTP/1.0 402 Payment Required"
151-
| `Forbidden -> "HTTP/1.0 403 Forbidden"
152-
| `Not_found -> "HTTP/1.0 404 Not Found"
153-
| `Method_not_allowed -> "HTTP/1.0 405 Method Not Allowed"
154-
| `Not_acceptable -> "HTTP/1.0 406 Not Acceptable"
155-
| `Conflict -> "HTTP/1.0 409 Conflict"
156-
| `Length_required -> "HTTP/1.0 411 Length Required"
157-
| `Request_too_large -> "HTTP/1.0 413 Request Entity Too Large"
158-
| `I'm_a_teapot -> "HTTP/1.0 418 I'm a teapot"
159-
| `Unprocessable_content -> "HTTP/1.0 422 Unprocessable Content"
160-
| `Too_many_requests -> "HTTP/1.0 429 Too Many Requests"
161-
162-
| `Internal_server_error -> "HTTP/1.0 500 Internal Server Error"
163-
| `Not_implemented -> "HTTP/1.0 501 Not Implemented"
164-
| `Service_unavailable -> "HTTP/1.0 503 Service Unavailable"
165-
| `Version_not_supported -> "HTTP/1.0 505 HTTP Version Not Supported"
166-
139+
let show_http_version = function
140+
| `Http_1_0 -> "HTTP/1.0"
141+
| `Http_1_1 -> "HTTP/1.1"
142+
143+
let show_status_code : status_code -> string = function
144+
| `Ok -> sprintf "200 OK"
145+
| `Created -> sprintf "201 Created"
146+
| `Accepted -> sprintf "202 Accepted"
147+
| `No_content -> sprintf "204 No Content"
148+
149+
| `Moved -> sprintf "301 Moved Permanently"
150+
| `Found -> sprintf "302 Found"
151+
152+
| `Bad_request -> sprintf "400 Bad Request"
153+
| `Unauthorized -> sprintf "401 Unauthorized"
154+
| `Payment_required -> sprintf "402 Payment Required"
155+
| `Forbidden -> sprintf "403 Forbidden"
156+
| `Not_found -> sprintf "404 Not Found"
157+
| `Method_not_allowed -> sprintf "405 Method Not Allowed"
158+
| `Not_acceptable -> sprintf "406 Not Acceptable"
159+
| `Conflict -> sprintf "409 Conflict"
160+
| `Length_required -> sprintf "411 Length Required"
161+
| `Request_too_large -> sprintf "413 Request Entity Too Large"
162+
| `I'm_a_teapot -> sprintf "418 I'm a teapot"
163+
| `Unprocessable_content -> sprintf "422 Unprocessable Content"
164+
| `Too_many_requests -> sprintf "429 Too Many Requests"
165+
166+
| `Internal_server_error -> sprintf "500 Internal Server Error"
167+
| `Not_implemented -> sprintf "501 Not Implemented"
168+
| `Service_unavailable -> sprintf "503 Service Unavailable"
169+
| `Version_not_supported -> sprintf "505 HTTP Version Not Supported"
170+
171+
let show_http_reply : version:[ `Http_1_0 | `Http_1_1 ] -> reply_status -> string =
172+
fun ~version reply_status ->
173+
match reply_status with
167174
| `Custom s -> s
175+
| #status_code as code -> sprintf "%s %s" (show_status_code code) (show_http_version version)
168176

169177
(* basically allow all *)
170178
let cors_preflight_allow_all = (`No_content, [

0 commit comments

Comments
 (0)