]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/ocaml-http/http_common.ml
Added debug flag and debug_print function
[helm.git] / helm / DEVEL / ocaml-http / http_common.ml
1
2 (*
3   OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
4
5   Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
6
7   This program is free software; you can redistribute it and/or modify
8   it under the terms of the GNU General Public License as published by
9   the Free Software Foundation; either version 2 of the License, or
10   (at your option) any later version.
11
12   This program is distributed in the hope that it will be useful,
13   but WITHOUT ANY WARRANTY; without even the implied warranty of
14   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
15   GNU General Public License for more details.
16
17   You should have received a copy of the GNU General Public License
18   along with this program; if not, write to the Free Software
19   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
20 *)
21
22 open Printf;;
23
24 let debug = ref false
25 let debug_print s =
26   if !debug then
27     prerr_endline (sprintf "DEBUG: %s" s)
28
29 exception Invalid_HTTP_version of string
30 exception Invalid_code of int
31 exception Invalid_status of Http_types.status
32
33 let http_version = `HTTP_1_1
34 let server_string = "OCaml HTTP Daemon"
35 let crlf = "\r\n"
36
37 let string_of_version = function
38   | `HTTP_1_0 -> "HTTP/1.0"
39   | `HTTP_1_1 -> "HTTP/1.1"
40
41 let version_of_string = function
42   | "HTTP/1.0" -> `HTTP_1_0
43   | "HTTP/1.1" -> `HTTP_1_1
44   | invalid_version -> raise (Invalid_HTTP_version invalid_version)
45
46 let status_of_code = function
47   | 100 -> `Informational `Continue
48   | 101 -> `Informational `Switching_protocols
49   | 200 -> `Success `OK
50   | 201 -> `Success `Created
51   | 202 -> `Success `Accepted
52   | 203 -> `Success `Non_authoritative_information
53   | 204 -> `Success `No_content
54   | 205 -> `Success `Reset_content
55   | 206 -> `Success `Partial_content
56   | 300 -> `Redirection `Multiple_choices
57   | 301 -> `Redirection `Moved_permanently
58   | 302 -> `Redirection `Found
59   | 303 -> `Redirection `See_other
60   | 304 -> `Redirection `Not_modified
61   | 305 -> `Redirection `Use_proxy
62   | 307 -> `Redirection `Temporary_redirect
63   | 400 -> `Client_error `Bad_request
64   | 401 -> `Client_error `Unauthorized
65   | 402 -> `Client_error `Payment_required
66   | 403 -> `Client_error `Forbidden
67   | 404 -> `Client_error `Not_found
68   | 405 -> `Client_error `Method_not_allowed
69   | 406 -> `Client_error `Not_acceptable
70   | 407 -> `Client_error `Proxy_authentication_required
71   | 408 -> `Client_error `Request_time_out
72   | 409 -> `Client_error `Conflict
73   | 410 -> `Client_error `Gone
74   | 411 -> `Client_error `Length_required
75   | 412 -> `Client_error `Precondition_failed
76   | 413 -> `Client_error `Request_entity_too_large
77   | 414 -> `Client_error `Request_URI_too_large
78   | 415 -> `Client_error `Unsupported_media_type
79   | 416 -> `Client_error `Requested_range_not_satisfiable
80   | 417 -> `Client_error `Expectation_failed
81   | 500 -> `Server_error `Internal_server_error
82   | 501 -> `Server_error `Not_implemented
83   | 502 -> `Server_error `Bad_gateway
84   | 503 -> `Server_error `Service_unavailable
85   | 504 -> `Server_error `Gateway_time_out
86   | 505 -> `Server_error `HTTP_version_not_supported
87   | invalid_code -> raise (Invalid_code invalid_code)
88
89 let code_of_status = function
90   | `Informational `Continue -> 100
91   | `Informational `Switching_protocols -> 101
92   | `Success `OK -> 200
93   | `Success `Created -> 201
94   | `Success `Accepted -> 202
95   | `Success `Non_authoritative_information -> 203
96   | `Success `No_content -> 204
97   | `Success `Reset_content -> 205
98   | `Success `Partial_content -> 206
99   | `Redirection `Multiple_choices -> 300
100   | `Redirection `Moved_permanently -> 301
101   | `Redirection `Found -> 302
102   | `Redirection `See_other -> 303
103   | `Redirection `Not_modified -> 304
104   | `Redirection `Use_proxy -> 305
105   | `Redirection `Temporary_redirect -> 307
106   | `Client_error `Bad_request -> 400
107   | `Client_error `Unauthorized -> 401
108   | `Client_error `Payment_required -> 402
109   | `Client_error `Forbidden -> 403
110   | `Client_error `Not_found -> 404
111   | `Client_error `Method_not_allowed -> 405
112   | `Client_error `Not_acceptable -> 406
113   | `Client_error `Proxy_authentication_required -> 407
114   | `Client_error `Request_time_out -> 408
115   | `Client_error `Conflict -> 409
116   | `Client_error `Gone -> 410
117   | `Client_error `Length_required -> 411
118   | `Client_error `Precondition_failed -> 412
119   | `Client_error `Request_entity_too_large -> 413
120   | `Client_error `Request_URI_too_large -> 414
121   | `Client_error `Unsupported_media_type -> 415
122   | `Client_error `Requested_range_not_satisfiable -> 416
123   | `Client_error `Expectation_failed -> 417
124   | `Server_error `Internal_server_error -> 500
125   | `Server_error `Not_implemented -> 501
126   | `Server_error `Bad_gateway -> 502
127   | `Server_error `Service_unavailable -> 503
128   | `Server_error `Gateway_time_out -> 504
129   | `Server_error `HTTP_version_not_supported -> 505
130
131 let reason_phrase_of_code = function
132   | 100 -> "Continue"
133   | 101 -> "Switching protocols"
134   | 200 -> "OK"
135   | 201 -> "Created"
136   | 202 -> "Accepted"
137   | 203 -> "Non authoritative information"
138   | 204 -> "No content"
139   | 205 -> "Reset content"
140   | 206 -> "Partial content"
141   | 300 -> "Multiple choices"
142   | 301 -> "Moved permanently"
143   | 302 -> "Found"
144   | 303 -> "See other"
145   | 304 -> "Not modified"
146   | 305 -> "Use proxy"
147   | 307 -> "Temporary redirect"
148   | 400 -> "Bad request"
149   | 401 -> "Unauthorized"
150   | 402 -> "Payment required"
151   | 403 -> "Forbidden"
152   | 404 -> "Not found"
153   | 405 -> "Method not allowed"
154   | 406 -> "Not acceptable"
155   | 407 -> "Proxy authentication required"
156   | 408 -> "Request time out"
157   | 409 -> "Conflict"
158   | 410 -> "Gone"
159   | 411 -> "Length required"
160   | 412 -> "Precondition failed"
161   | 413 -> "Request entity too large"
162   | 414 -> "Request URI too large"
163   | 415 -> "Unsupported media type"
164   | 416 -> "Requested range not satisfiable"
165   | 417 -> "Expectation failed"
166   | 500 -> "Internal server error"
167   | 501 -> "Not implemented"
168   | 502 -> "Bad gateway"
169   | 503 -> "Service unavailable"
170   | 504 -> "Gateway time out"
171   | 505 -> "HTTP version not supported"
172   | invalid_code -> raise (Invalid_code invalid_code)
173
174 let reason_phrase_of_status s = reason_phrase_of_code (code_of_status s)
175
176 let is_informational code =
177   match status_of_code code with
178   | `Informational _ -> true
179   | _ -> false
180
181 let is_success code =
182   match status_of_code code with
183   | `Success _ -> true
184   | _ -> false
185
186 let is_redirection code =
187   match status_of_code code with
188   | `Redirection _ -> true
189   | _ -> false
190
191 let is_client_error code =
192   match status_of_code code with
193   | `Client_error _ -> true
194   | _ -> false
195
196 let is_server_error code =
197   match status_of_code code with
198   | `Server_error _ -> true
199   | _ -> false
200
201 let is_error code = is_client_error code || is_server_error code
202