]> matita.cs.unibo.it Git - helm.git/blob - http_misc.ml
191508c49a01cb8e9e96f88482db96f17dac8090
[helm.git] / 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