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 exception Invalid_HTTP_version of string
  23 exception Invalid_code of int
  24 exception Invalid_status of Http_types.status
  25
  26 let http_version = `HTTP_1_1
  27 let server_string = "OCaml HTTP Daemon"
  28 let crlf = "\r\n"
  29
  30 let string_of_version = function
  31   | `HTTP_1_0 -> "HTTP/1.0"
  32   | `HTTP_1_1 -> "HTTP/1.1"
  33
  34 let version_of_string = function
  35   | "HTTP/1.0" -> `HTTP_1_0
  36   | "HTTP/1.1" -> `HTTP_1_1
  37   | invalid_version -> raise (Invalid_HTTP_version invalid_version)
  38
  39 let status_of_code = function
  40   | 100 -> `Informational `Continue
  41   | 101 -> `Informational `Switching_protocols
  42   | 200 -> `Success `OK
  43   | 201 -> `Success `Created
  44   | 202 -> `Success `Accepted
  45   | 203 -> `Success `Non_authoritative_information
  46   | 204 -> `Success `No_content
  47   | 205 -> `Success `Reset_content
  48   | 206 -> `Success `Partial_content
  49   | 300 -> `Redirection `Multiple_choices
  50   | 301 -> `Redirection `Moved_permanently
  51   | 302 -> `Redirection `Found
  52   | 303 -> `Redirection `See_other
  53   | 304 -> `Redirection `Not_modified
  54   | 305 -> `Redirection `Use_proxy
  55   | 307 -> `Redirection `Temporary_redirect
  56   | 400 -> `Client_error `Bad_request
  57   | 401 -> `Client_error `Unauthorized
  58   | 402 -> `Client_error `Payment_required
  59   | 403 -> `Client_error `Forbidden
  60   | 404 -> `Client_error `Not_found
  61   | 405 -> `Client_error `Method_not_allowed
  62   | 406 -> `Client_error `Not_acceptable
  63   | 407 -> `Client_error `Proxy_authentication_required
  64   | 408 -> `Client_error `Request_time_out
  65   | 409 -> `Client_error `Conflict
  66   | 410 -> `Client_error `Gone
  67   | 411 -> `Client_error `Length_required
  68   | 412 -> `Client_error `Precondition_failed
  69   | 413 -> `Client_error `Request_entity_too_large
  70   | 414 -> `Client_error `Request_URI_too_large
  71   | 415 -> `Client_error `Unsupported_media_type
  72   | 416 -> `Client_error `Requested_range_not_satisfiable
  73   | 417 -> `Client_error `Expectation_failed
  74   | 500 -> `Server_error `Internal_server_error
  75   | 501 -> `Server_error `Not_implemented
  76   | 502 -> `Server_error `Bad_gateway
  77   | 503 -> `Server_error `Service_unavailable
  78   | 504 -> `Server_error `Gateway_time_out
  79   | 505 -> `Server_error `HTTP_version_not_supported
  80   | invalid_code -> raise (Invalid_code invalid_code)
  81
  82 let code_of_status = function
  83   | `Informational `Continue -> 100
  84   | `Informational `Switching_protocols -> 101
  85   | `Success `OK -> 200
  86   | `Success `Created -> 201
  87   | `Success `Accepted -> 202
  88   | `Success `Non_authoritative_information -> 203
  89   | `Success `No_content -> 204
  90   | `Success `Reset_content -> 205
  91   | `Success `Partial_content -> 206
  92   | `Redirection `Multiple_choices -> 300
  93   | `Redirection `Moved_permanently -> 301
  94   | `Redirection `Found -> 302
  95   | `Redirection `See_other -> 303
  96   | `Redirection `Not_modified -> 304
  97   | `Redirection `Use_proxy -> 305
  98   | `Redirection `Temporary_redirect -> 307
  99   | `Client_error `Bad_request -> 400
 100   | `Client_error `Unauthorized -> 401
 101   | `Client_error `Payment_required -> 402
 102   | `Client_error `Forbidden -> 403
 103   | `Client_error `Not_found -> 404
 104   | `Client_error `Method_not_allowed -> 405
 105   | `Client_error `Not_acceptable -> 406
 106   | `Client_error `Proxy_authentication_required -> 407
 107   | `Client_error `Request_time_out -> 408
 108   | `Client_error `Conflict -> 409
 109   | `Client_error `Gone -> 410
 110   | `Client_error `Length_required -> 411
 111   | `Client_error `Precondition_failed -> 412
 112   | `Client_error `Request_entity_too_large -> 413
 113   | `Client_error `Request_URI_too_large -> 414
 114   | `Client_error `Unsupported_media_type -> 415
 115   | `Client_error `Requested_range_not_satisfiable -> 416
 116   | `Client_error `Expectation_failed -> 417
 117   | `Server_error `Internal_server_error -> 500
 118   | `Server_error `Not_implemented -> 501
 119   | `Server_error `Bad_gateway -> 502
 120   | `Server_error `Service_unavailable -> 503
 121   | `Server_error `Gateway_time_out -> 504
 122   | `Server_error `HTTP_version_not_supported -> 505
 123
 124 let reason_phrase_of_code = function
 125   | 100 -> "Continue"
 126   | 101 -> "Switching protocols"
 127   | 200 -> "OK"
 128   | 201 -> "Created"
 129   | 202 -> "Accepted"
 130   | 203 -> "Non authoritative information"
 131   | 204 -> "No content"
 132   | 205 -> "Reset content"
 133   | 206 -> "Partial content"
 134   | 300 -> "Multiple choices"
 135   | 301 -> "Moved permanently"
 136   | 302 -> "Found"
 137   | 303 -> "See other"
 138   | 304 -> "Not modified"
 139   | 305 -> "Use proxy"
 140   | 307 -> "Temporary redirect"
 141   | 400 -> "Bad request"
 142   | 401 -> "Unauthorized"
 143   | 402 -> "Payment required"
 144   | 403 -> "Forbidden"
 145   | 404 -> "Not found"
 146   | 405 -> "Method not allowed"
 147   | 406 -> "Not acceptable"
 148   | 407 -> "Proxy authentication required"
 149   | 408 -> "Request time out"
 150   | 409 -> "Conflict"
 151   | 410 -> "Gone"
 152   | 411 -> "Length required"
 153   | 412 -> "Precondition failed"
 154   | 413 -> "Request entity too large"
 155   | 414 -> "Request URI too large"
 156   | 415 -> "Unsupported media type"
 157   | 416 -> "Requested range not satisfiable"
 158   | 417 -> "Expectation failed"
 159   | 500 -> "Internal server error"
 160   | 501 -> "Not implemented"
 161   | 502 -> "Bad gateway"
 162   | 503 -> "Service unavailable"
 163   | 504 -> "Gateway time out"
 164   | 505 -> "HTTP version not supported"
 165   | invalid_code -> raise (Invalid_code invalid_code)
 166
 167 let reason_phrase_of_status s = reason_phrase_of_code (code_of_status s)
 168
 169 let is_informational code =
 170   match status_of_code code with
 171   | `Informational _ -> true
 172   | _ -> false
 173
 174 let is_success code =
 175   match status_of_code code with
 176   | `Success _ -> true
 177   | _ -> false
 178
 179 let is_redirection code =
 180   match status_of_code code with
 181   | `Redirection _ -> true
 182   | _ -> false
 183
 184 let is_client_error code =
 185   match status_of_code code with
 186   | `Client_error _ -> true
 187   | _ -> false
 188
 189 let is_server_error code =
 190   match status_of_code code with
 191   | `Server_error _ -> true
 192   | _ -> false
 193
 194 let is_error code = is_client_error code || is_server_error code
 195