http_misc.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 Http_types;;
  23
  24 let date_822 () =
  25   Netdate.mk_mail_date ~zone:Netdate.localzone (Unix.time ())
  26
  27 let is_directory name =
  28   match Unix.lstat name with
  29   | { Unix.st_kind = Unix.S_DIR } -> true
  30   | _ -> false
  31
  32 let filesize fname = (Unix.stat fname).Unix.st_size
  33
  34 let strip_trailing_slash =
  35   let rex = Pcre.regexp "/$" in
  36   fun s -> Pcre.replace ~rex ~templ:"" s
  37
  38 let strip_heading_slash =
  39   let rex = Pcre.regexp "^/" in
  40   fun s -> Pcre.replace ~rex ~templ:"" s
  41
  42 let ls dir =
  43   let rec ls' entries =
  44     try ls' ((Unix.readdir dir)::entries) with End_of_file -> entries
  45   in
  46   ls' []
  47
  48 let string_explode s =
  49   let rec string_explode' acc = function
  50     | "" -> acc
  51     | s -> string_explode' (s.[0] :: acc) (String.sub s 1 (String.length s - 1))
  52   in
  53   List.rev (string_explode' [] s)
  54
  55 let string_implode = List.fold_left (fun s c -> s ^ (String.make 1 c)) ""
  56
  57 let reason_phrase_of_code = function
  58   | 100 -> "Continue"
  59   | 101 -> "Switching protocols"
  60   | 200 -> "OK"
  61   | 201 -> "Created"
  62   | 202 -> "Accepted"
  63   | 203 -> "Non authoritative information"
  64   | 204 -> "No content"
  65   | 205 -> "Reset content"
  66   | 206 -> "Partial content"
  67   | 300 -> "Multiple choices"
  68   | 301 -> "Moved permanently"
  69   | 302 -> "Found"
  70   | 303 -> "See other"
  71   | 304 -> "Not modified"
  72   | 305 -> "Use proxy"
  73   | 307 -> "Temporary redirect"
  74   | 400 -> "Bad request"
  75   | 401 -> "Unauthorized"
  76   | 402 -> "Payment required"
  77   | 403 -> "Forbidden"
  78   | 404 -> "Not found"
  79   | 405 -> "Method not allowed"
  80   | 406 -> "Not acceptable"
  81   | 407 -> "Proxy authentication required"
  82   | 408 -> "Request time out"
  83   | 409 -> "Conflict"
  84   | 410 -> "Gone"
  85   | 411 -> "Length required"
  86   | 412 -> "Precondition failed"
  87   | 413 -> "Request entity too large"
  88   | 414 -> "Request URI too large"
  89   | 415 -> "Unsupported media type"
  90   | 416 -> "Requested range not satisfiable"
  91   | 417 -> "Expectation failed"
  92   | 500 -> "Internal server error"
  93   | 501 -> "Not implemented"
  94   | 502 -> "Bad gateway"
  95   | 503 -> "Service unavailable"
  96   | 504 -> "Gateway time out"
  97   | 505 -> "HTTP version not supported"
  98   | invalid_code -> raise (Invalid_code invalid_code)
  99
 100 let build_sockaddr (addr, port) =
 101   Unix.ADDR_INET (Unix.inet_addr_of_string addr, port)
 102
 103 let explode_sockaddr = function
 104   | Unix.ADDR_INET (addr, port) -> (Unix.string_of_inet_addr addr, port)
 105   | _ -> assert false (* can explode only inet address *)
 106
 107 let peername_of_out_channel outchan =
 108   Unix.getpeername (Unix.descr_of_out_channel outchan)
 109 let peername_of_in_channel inchan =
 110   Unix.getpeername (Unix.descr_of_in_channel inchan)
 111 let sockname_of_out_channel outchan =
 112   Unix.getsockname (Unix.descr_of_out_channel outchan)
 113 let sockname_of_in_channel inchan =
 114   Unix.getsockname (Unix.descr_of_in_channel inchan)
 115
 116 let buf_of_inchan ?limit ic =
 117   let buf = Buffer.create 10240 in
 118   let tmp = String.make 1024 '\000' in
 119   let rec buf_of_inchan' limit =
 120     (match limit with
 121     | None ->
 122         let bytes = input ic tmp 0 1024 in
 123         if bytes > 0 then begin
 124           Buffer.add_substring buf tmp 0 bytes;
 125           buf_of_inchan' None
 126         end
 127     | Some lim -> (* TODO what about using a single really_input call? *)
 128         let bytes = input ic tmp 0 (min lim 1024) in
 129         if bytes > 0 then begin
 130           Buffer.add_substring buf tmp 0 bytes;
 131           buf_of_inchan' (Some (lim - bytes))
 132         end)
 133   in
 134   (try buf_of_inchan' limit with End_of_file -> ());
 135   buf
 136
 137 let list_assoc_all key pairs =
 138   snd (List.split (List.filter (fun (k, v) -> k = key) pairs))
 139