]> matita.cs.unibo.it Git - helm.git/blob - helm/DEVEL/ocaml-http/http_common.ml
atmost/atleast/exactly constraints are now used only for the "hint" method.
[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-2004> 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 Http_types;;
23 open Printf;;
24
25 let debug = ref false
26 let debug_print s =
27   if !debug then
28     prerr_endline (sprintf "[OCaml HTTP] DEBUG: %s" s)
29
30 let http_version = Http_constants.version
31 let server_string = Http_constants.server_string
32
33 let string_of_version = function
34   | `HTTP_1_0 -> "HTTP/1.0"
35   | `HTTP_1_1 -> "HTTP/1.1"
36
37 let version_of_string = function
38   | "HTTP/1.0" -> `HTTP_1_0
39   | "HTTP/1.1" -> `HTTP_1_1
40   | invalid_version -> raise (Invalid_HTTP_version invalid_version)
41
42 let string_of_method = function
43   | `GET -> "GET"
44   | `POST -> "POST"
45
46 let method_of_string = function
47   | "GET" -> `GET
48   | "POST" -> `POST
49   | invalid_method -> raise (Invalid_HTTP_method invalid_method)
50
51 let status_of_code = function
52   | 100 -> `Informational `Continue
53   | 101 -> `Informational `Switching_protocols
54   | 200 -> `Success `OK
55   | 201 -> `Success `Created
56   | 202 -> `Success `Accepted
57   | 203 -> `Success `Non_authoritative_information
58   | 204 -> `Success `No_content
59   | 205 -> `Success `Reset_content
60   | 206 -> `Success `Partial_content
61   | 300 -> `Redirection `Multiple_choices
62   | 301 -> `Redirection `Moved_permanently
63   | 302 -> `Redirection `Found
64   | 303 -> `Redirection `See_other
65   | 304 -> `Redirection `Not_modified
66   | 305 -> `Redirection `Use_proxy
67   | 307 -> `Redirection `Temporary_redirect
68   | 400 -> `Client_error `Bad_request
69   | 401 -> `Client_error `Unauthorized
70   | 402 -> `Client_error `Payment_required
71   | 403 -> `Client_error `Forbidden
72   | 404 -> `Client_error `Not_found
73   | 405 -> `Client_error `Method_not_allowed
74   | 406 -> `Client_error `Not_acceptable
75   | 407 -> `Client_error `Proxy_authentication_required
76   | 408 -> `Client_error `Request_time_out
77   | 409 -> `Client_error `Conflict
78   | 410 -> `Client_error `Gone
79   | 411 -> `Client_error `Length_required
80   | 412 -> `Client_error `Precondition_failed
81   | 413 -> `Client_error `Request_entity_too_large
82   | 414 -> `Client_error `Request_URI_too_large
83   | 415 -> `Client_error `Unsupported_media_type
84   | 416 -> `Client_error `Requested_range_not_satisfiable
85   | 417 -> `Client_error `Expectation_failed
86   | 500 -> `Server_error `Internal_server_error
87   | 501 -> `Server_error `Not_implemented
88   | 502 -> `Server_error `Bad_gateway
89   | 503 -> `Server_error `Service_unavailable
90   | 504 -> `Server_error `Gateway_time_out
91   | 505 -> `Server_error `HTTP_version_not_supported
92   | invalid_code -> raise (Invalid_code invalid_code)
93
94 let code_of_status = function
95   | `Informational `Continue -> 100
96   | `Informational `Switching_protocols -> 101
97   | `Success `OK -> 200
98   | `Success `Created -> 201
99   | `Success `Accepted -> 202
100   | `Success `Non_authoritative_information -> 203
101   | `Success `No_content -> 204
102   | `Success `Reset_content -> 205
103   | `Success `Partial_content -> 206
104   | `Redirection `Multiple_choices -> 300
105   | `Redirection `Moved_permanently -> 301
106   | `Redirection `Found -> 302
107   | `Redirection `See_other -> 303
108   | `Redirection `Not_modified -> 304
109   | `Redirection `Use_proxy -> 305
110   | `Redirection `Temporary_redirect -> 307
111   | `Client_error `Bad_request -> 400
112   | `Client_error `Unauthorized -> 401
113   | `Client_error `Payment_required -> 402
114   | `Client_error `Forbidden -> 403
115   | `Client_error `Not_found -> 404
116   | `Client_error `Method_not_allowed -> 405
117   | `Client_error `Not_acceptable -> 406
118   | `Client_error `Proxy_authentication_required -> 407
119   | `Client_error `Request_time_out -> 408
120   | `Client_error `Conflict -> 409
121   | `Client_error `Gone -> 410
122   | `Client_error `Length_required -> 411
123   | `Client_error `Precondition_failed -> 412
124   | `Client_error `Request_entity_too_large -> 413
125   | `Client_error `Request_URI_too_large -> 414
126   | `Client_error `Unsupported_media_type -> 415
127   | `Client_error `Requested_range_not_satisfiable -> 416
128   | `Client_error `Expectation_failed -> 417
129   | `Server_error `Internal_server_error -> 500
130   | `Server_error `Not_implemented -> 501
131   | `Server_error `Bad_gateway -> 502
132   | `Server_error `Service_unavailable -> 503
133   | `Server_error `Gateway_time_out -> 504
134   | `Server_error `HTTP_version_not_supported -> 505
135
136 let is_informational code =
137   match status_of_code code with
138   | `Informational _ -> true
139   | _ -> false
140
141 let is_success code =
142   match status_of_code code with
143   | `Success _ -> true
144   | _ -> false
145
146 let is_redirection code =
147   match status_of_code code with
148   | `Redirection _ -> true
149   | _ -> false
150
151 let is_client_error code =
152   match status_of_code code with
153   | `Client_error _ -> true
154   | _ -> false
155
156 let is_server_error code =
157   match status_of_code code with
158   | `Server_error _ -> true
159   | _ -> false
160
161 let is_error code = is_client_error code || is_server_error code
162