let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$"
+let anyize = function
+ | Some addr -> addr
+ | None -> Unix.ADDR_INET (Unix.inet_addr_any, -1)
+
class response
(* Warning: keep default values in sync with Http_daemon.respond function *)
- ?(body = "") ?(headers = [])
- ?(version = http_version) ?(code = 200) ?status ()
+ ?(body = "") ?(headers = []) ?(version = http_version)
+ ?clisockaddr ?srvsockaddr (* optional because response have to be easily
+ buildable in callback functions *)
+ ?(code = 200) ?status
+ ()
=
- (* remove all bindings of 'name' from hashtbl 'tbl' *)
- let rec hashtbl_remove_all tbl name =
- if not (Hashtbl.mem tbl name) then
- raise (Header_not_found name);
- Hashtbl.remove tbl name;
- if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
- in
+
+ (** if no address were supplied for client and/or server, use a foo address
+ instead *)
+ let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in
+
(* "version code reason_phrase" *)
object (self)
- val mutable _version = version
+ inherit
+ Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr
+
val mutable _code =
match status with
| None -> code
| Some (s: Http_types.status) -> code_of_status s
val mutable _reason: string option = None
- val _contentsBuf = Buffer.create 1024
- val _headers = Hashtbl.create 11
-
- initializer
- self#setContents body;
- self#addHeaders headers
-
- method version = _version
- method setVersion v = _version <- v
method code = _code
method setCode c =
method isServerError = is_server_error _code
method isError = is_error _code
- method contents = Buffer.contents _contentsBuf
- method setContents c =
- Buffer.clear _contentsBuf;
- Buffer.add_string _contentsBuf c
- method contentsBuf = _contentsBuf
- method setContentsBuf b =
- Buffer.clear _contentsBuf;
- Buffer.add_buffer _contentsBuf b
- method addContents s = Buffer.add_string _contentsBuf s
- method addContentsBuf b = Buffer.add_buffer _contentsBuf b
-
- method addHeader ~name ~value =
- Http_parser.heal_header (name, value);
- Hashtbl.add _headers name value
- method addHeaders =
- List.iter (fun (name, value) -> self#addHeader ~name ~value)
-
- method replaceHeader ~name ~value =
- Http_parser.heal_header (name, value);
- Hashtbl.replace _headers name value
- method replaceHeaders =
- List.iter (fun (name, value) -> self#replaceHeader ~name ~value)
-
(* FIXME duplication of code between this and send_basic_headers *)
method addBasicHeaders =
self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
self#addHeader ~name:"Server" ~value:server_string
- method removeHeader ~name = hashtbl_remove_all _headers name
- method hasHeader ~name = Hashtbl.mem _headers name
- method header ~name =
- if not (self#hasHeader name) then
- raise (Header_not_found name);
- String.concat ", " (List.rev (Hashtbl.find_all _headers name))
- method headers =
- List.rev
- (Hashtbl.fold
- (fun name _ headers -> (name, self#header ~name)::headers)
- _headers
- [])
method contentType = self#header "Content-Type"
method setContentType t = self#replaceHeader "Content-Type" t
method server = self#header "Server"
method setServer s = self#replaceHeader "Server" s
- method toString =
+ method private fstLineToString =
sprintf
- "%s%s%s%s%s"
- self#statusLine (* status line *)
- crlf
- (String.concat (* headers, crlf terminated *)
- ""
- (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers))
- crlf
- (Buffer.contents _contentsBuf) (* body *)
- method serialize outchan =
- output_string outchan self#toString;
- flush outchan
+ "%s %d %s"
+ (string_of_version self#version)
+ self#code
+ self#reason
end