From: Prashanth Mundkur Date: Fri, 3 Jul 2009 20:04:42 +0000 (-0700) Subject: [http] added a generic response builder X-Git-Url: http://xenbits.xensource.com/gitweb?a=commitdiff_plain;h=5dc87e3bc28b35a24a797f30dd79670f920e97c1;p=xenclient%2Ftoolstack.git [http] added a generic response builder --- diff --git a/libs/http/http.ml b/libs/http/http.ml index b87c848..ea514ee 100644 --- a/libs/http/http.ml +++ b/libs/http/http.ml @@ -87,6 +87,7 @@ let rec strip_leading_spaces = function strip_leading_spaces clist | cl -> cl +(* Header utilities *) type header_fields = (string * string list) list @@ -101,6 +102,9 @@ let rec add_header fname fvalue = let lookup_header name hdrs = List.assoc (String.lowercase name) hdrs +let is_header_present hdr headers = + try ignore (lookup_header hdr headers); true + with Not_found -> false type version = | HTTP09 @@ -481,6 +485,114 @@ end module Response_header = struct + type status = + (* Informational 1xx *) + | Status_continue + | Status_switching_protocols + + (* Successful 2xx *) + | Status_ok + | Status_created + | Status_accepted + | Status_non_authoritative + | Status_no_content + | Status_reset_content + | Status_partial_content + + (* Redirection 3xx *) + | Status_multiple_choices + | Status_moved_permanently + | Status_found + | Status_see_other + | Status_not_modified + | Status_use_proxy + | Status_temporary_redirect + + (* Client Error 4xx *) + | Status_bad_request + | Status_unauthorized + | Status_payment_required + | Status_forbidden + | Status_not_found + | Status_method_not_allowed + | Status_not_acceptable + | Status_proxy_authentication_required + | Status_request_timeout + | Status_conflict + | Status_gone + | Status_length_required + | Status_precondition_failed + | Status_request_entity_too_large + | Status_request_uri_too_large + | Status_unsupported_media_type + | Status_requested_range_not_satisfiable + | Status_expectation_failed + + (* Server Error 5xx *) + | Status_internal_server_error + | Status_not_implemented + | Status_bad_gateway + | Status_service_unavailable + | Status_gateway_timeout + | Status_version_not_supported + + (* Other *) + | Status_other of int * string + + let status_info = function + (* Informational 1xx *) + | Status_continue -> 100, "Continue" + | Status_switching_protocols -> 101, "Switching Protocols" + + (* Successful 2xx *) + | Status_ok -> 200, "Ok" + | Status_created -> 201, "Created" + | Status_accepted -> 202, "Accepted" + | Status_non_authoritative -> 203, "Non-Authoritative Information" + | Status_no_content -> 204, "No Content" + | Status_reset_content -> 205, "Reset Content" + | Status_partial_content -> 206, "Partial Content" + + (* Redirection 3xx *) + | Status_multiple_choices -> 300, "Multiple Choices" + | Status_moved_permanently -> 301, "Moved Permanently" + | Status_found -> 302, "Found" + | Status_see_other -> 303, "See Other" + | Status_not_modified -> 304, "Not Modified" + | Status_use_proxy -> 305, "Use Proxy" + | Status_temporary_redirect -> 307, "Temporary Redirect" + + (* Client Error 4xx *) + | Status_bad_request -> 400, "Bad Request" + | Status_unauthorized -> 401, "Unauthorized" + | Status_payment_required -> 402, "Payment Required" + | Status_forbidden -> 403, "Forbidden" + | Status_not_found -> 404, "Not Found" + | Status_method_not_allowed -> 405, "Method Not Allowed" + | Status_not_acceptable -> 406, "Not Acceptable" + | Status_proxy_authentication_required -> 407, "Proxy Authentication Required" + | Status_request_timeout -> 408, "Request Timeout" + | Status_conflict -> 409, "Conflict" + | Status_gone -> 410, "Gone" + | Status_length_required -> 411, "Length Required" + | Status_precondition_failed -> 412, "Precondition Failed" + | Status_request_entity_too_large -> 413, "Request Entity Too Large" + | Status_request_uri_too_large -> 414, "Request-URI Too Large" + | Status_unsupported_media_type -> 415, "Unsupported Media Type" + | Status_requested_range_not_satisfiable -> 416, "Range Not Satisfiable" + | Status_expectation_failed -> 417, "Expectation Failed" + + (* Server Error 5xx *) + | Status_internal_server_error -> 500, "Internal Server Error" + | Status_not_implemented -> 501, "Not Implemented" + | Status_bad_gateway -> 502, "Bad Gateway" + | Status_service_unavailable -> 503, "Service Unavailable" + | Status_gateway_timeout -> 504, "Gateway Timeout" + | Status_version_not_supported -> 505, "HTTP Version Not Supported" + + (* Other *) + | Status_other (code, reason) -> code, reason + type cursor = | Start | In_version of char list @@ -1240,4 +1352,19 @@ module Response = struct match resp.payload with | Some p -> Payload.serialize_of_response resp.response buf p | None -> () + + let make_response ?payload ~headers status = + let code, reason = Response_header.status_info status in + let payload_length = (match payload with + | None -> 0 + | Some p -> Buffer.length p.Payload.content) in + let headers = (if is_header_present "Content-Length" headers then headers + else (add_header "Content-Length" (Printf.sprintf "%d" payload_length) + headers)) in + let resp_header = { Response_header.version = HTTP11; + Response_header.status_code = code; + Response_header.reason_phrase = reason; + Response_header.headers = headers } + in { response = resp_header; + payload = payload } end diff --git a/libs/http/http.mli b/libs/http/http.mli index 730fc7c..2c28269 100644 --- a/libs/http/http.mli +++ b/libs/http/http.mli @@ -16,6 +16,10 @@ type header_fields = (string * string list) list +val add_header : string -> string -> header_fields -> header_fields +val is_header_present : string -> header_fields -> bool +val lookup_header : string -> header_fields -> string list (* can throw Not_found *) + type version = HTTP09 | HTTP10 | HTTP11 module Headers : sig @@ -65,6 +69,62 @@ module Request_header : sig end module Response_header : sig + type status = + (* Informational 1xx *) + | Status_continue + | Status_switching_protocols + + (* Successful 2xx *) + | Status_ok + | Status_created + | Status_accepted + | Status_non_authoritative + | Status_no_content + | Status_reset_content + | Status_partial_content + + (* Redirection 3xx *) + | Status_multiple_choices + | Status_moved_permanently + | Status_found + | Status_see_other + | Status_not_modified + | Status_use_proxy + | Status_temporary_redirect + + (* Client Error 4xx *) + | Status_bad_request + | Status_unauthorized + | Status_payment_required + | Status_forbidden + | Status_not_found + | Status_method_not_allowed + | Status_not_acceptable + | Status_proxy_authentication_required + | Status_request_timeout + | Status_conflict + | Status_gone + | Status_length_required + | Status_precondition_failed + | Status_request_entity_too_large + | Status_request_uri_too_large + | Status_unsupported_media_type + | Status_requested_range_not_satisfiable + | Status_expectation_failed + + (* Server Error 5xx *) + | Status_internal_server_error + | Status_not_implemented + | Status_bad_gateway + | Status_service_unavailable + | Status_gateway_timeout + | Status_version_not_supported + + (* Other *) + | Status_other of int * string + + val status_info : status -> (* status code *) int * (* reason phrase *) string + type state val init_state : unit -> state val num_bytes_parsed : state -> int @@ -184,4 +244,6 @@ module Response : sig val connection_closed : state -> unit val serialize : Buffer.t -> t -> unit + + val make_response : ?payload:Payload.t -> headers:header_fields -> Response_header.status -> t end