helm/software/DEVEL/ocaml-http/http_common.ml

   1
   2 (*
   3   OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
   4
   5   Copyright (C) <2002-2005> 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 Library General Public License as
   9   published by the Free Software Foundation, version 2.
  10
  11   This program is distributed in the hope that it will be useful,
  12   but WITHOUT ANY WARRANTY; without even the implied warranty of
  13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14   GNU Library General Public License for more details.
  15
  16   You should have received a copy of the GNU Library General Public
  17   License along with this program; if not, write to the Free Software
  18   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307
  19   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