1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
(* Ocsigen
* framepp.ml Copyright (C) 2005 Denis Berthod
* Laboratoire PPS - CNRS Universit Paris Diderot
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)
(** pretty printer for http frames*)
open Ocsigen_http_frame
module H = Http_header
(** converts the method into a string*)
let string_of_method =
function
| H.GET -> "GET"
| H.POST -> "POST"
| H.HEAD -> "HEAD"
| H.PUT -> "PUT"
| H.DELETE -> "DELETE"
| H.TRACE -> "TRACE"
| H.OPTIONS -> "OPTIONS"
| H.CONNECT -> "CONNECT"
| H.LINK -> "LINK"
| H.UNLINK -> "UNLINK"
| H.PATCH -> "PATCH"
(** converts a string to a method *)
let method_of_string =
function
| "GET" -> H.GET
| "POST" -> H.POST
| "HEAD" -> H.HEAD
| "PUT" -> H.PUT
| "DELETE" -> H.DELETE
| "TRACE" -> H.TRACE
| "OPTIONS" -> H.OPTIONS
| "CONNECT" -> H.CONNECT
| "LINK" -> H.LINK
| "UNLINK" -> H.UNLINK
| "PATCH" -> H.PATCH
| _ -> failwith "method_of_string"
(** converts the protocol into a string *)
let string_of_proto = function
| H.HTTP10 -> "HTTP/1.0"
| H.HTTP11 -> "HTTP/1.1"
(** converts a string to a protocol *)
let proto_of_string = function
| "HTTP/1.0" -> H.HTTP10
| "HTTP/1.1" -> H.HTTP11
| _ -> failwith "proto_of_string"
(** Write the first line of an HTTP frame to a string buffer *)
let fst_line buf header =
match header.H.mode with
| H.Nofirstline -> ()
| H.Answer code ->
Printf.bprintf buf "%s %i %s\r\n" (string_of_proto header.H.proto)
code (Http_error.expl_of_code code)
| H.Query (meth, url) ->
Printf.bprintf buf "%s %s %s\r\n"
(string_of_method meth) url (string_of_proto header.H.proto)
(** Prints the content of a header. To prevent http header injection,
we insert spaces (' ') after CRLF, in case the user has not done this
himself. Also, if we find single CR or LF, we replace them by spaces .
(This is correct according to the RFC, as the headers content should not
contain single CR or LF anyway) *)
let print_header_content buf content =
let s = String.length content in
let rec aux prev i =
if i = s then
(if prev < s then
Buffer.add_substring buf content prev (s-prev))
else
let add_prev () = Buffer.add_substring buf content prev (i-prev) in
match content.[i] with
| '\n' | '\r' as c ->
let i' = i+1 in
let escape_c () =
add_prev ();
Buffer.add_char buf c;
Buffer.add_char buf ' ';
aux i' i'
in
if i' < s then
(match content.[i'] with
| '\n' | '\r' as c' when c <> c' ->
add_prev ();
Buffer.add_char buf c; Buffer.add_char buf c';
Buffer.add_char buf ' ';
aux (i+2) (i+2)
| _ -> escape_c ()
) else
escape_c ()
| _ ->
aux prev (i+1)
in
aux 0 0
(* Debug *)
let test s =
let b = Buffer.create 0 in print_header_content b s; Buffer.contents b
(** Write the header lines to a string buffer *)
let headers buf header =
Http_headers.iter
(fun name value ->
Printf.bprintf buf "%s: %a\r\n"
(Http_headers.name_to_string name) print_header_content value)
header.H.headers
(** Convert a HTTP header into a string *)
let string_of_header hds =
let buf = Buffer.create 200 in
fst_line buf hds;
headers buf hds;
Printf.bprintf buf "\r\n%!";
Buffer.contents buf
|
