33823
|
1 |
(* Title: Tools/WWW_Find/http_util.ML
|
33817
|
2 |
Author: Timothy Bourke, NICTA
|
|
3 |
|
|
4 |
Rudimentary utility functions for HTTP.
|
|
5 |
*)
|
33823
|
6 |
|
33817
|
7 |
signature HTTP_UTIL =
|
|
8 |
sig
|
|
9 |
val crlf : string
|
|
10 |
val reply_header : HttpStatus.t * Mime.t option * (string * string) list -> string
|
|
11 |
val parse_query_string : string -> string Symtab.table
|
|
12 |
val make_query_string : string Symtab.table -> string
|
|
13 |
end;
|
|
14 |
|
|
15 |
structure HttpUtil : HTTP_UTIL =
|
|
16 |
struct
|
|
17 |
|
|
18 |
val crlf = "\r\n";
|
|
19 |
|
43703
|
20 |
fun make_header_field (name, value) = implode [name, ": ", value, crlf];
|
33817
|
21 |
|
|
22 |
fun reply_header (status, content_type, extra_fields) =
|
|
23 |
let
|
41491
|
24 |
val code = (string_of_int o HttpStatus.to_status_code) status;
|
33817
|
25 |
val reason = HttpStatus.to_reason status;
|
|
26 |
val show_content_type = pair "Content-Type" o Mime.show_type;
|
|
27 |
in
|
43703
|
28 |
implode
|
33817
|
29 |
(map make_header_field
|
43703
|
30 |
(("Status", implode [code, " ", reason])
|
33817
|
31 |
:: (the_list o Option.map show_content_type) content_type
|
|
32 |
@ extra_fields)
|
|
33 |
@ [crlf])
|
|
34 |
end;
|
|
35 |
|
|
36 |
val split_fields = Substring.splitl (fn c => c <> #"=")
|
|
37 |
#> apsnd (Substring.triml 1);
|
|
38 |
|
|
39 |
fun decode_url s =
|
|
40 |
let
|
|
41 |
fun to_char c =
|
|
42 |
Substring.triml 1 c
|
|
43 |
|> Int.scan StringCvt.HEX Substring.getc
|
|
44 |
|> the
|
|
45 |
|> fst
|
|
46 |
|> Char.chr
|
|
47 |
|> String.str
|
|
48 |
|> Substring.full
|
|
49 |
handle Option => c;
|
|
50 |
|
|
51 |
fun f (done, s) =
|
|
52 |
let
|
|
53 |
val (pre, post) = Substring.splitl (Char.notContains "+%") s;
|
|
54 |
in
|
|
55 |
if Substring.isEmpty post
|
|
56 |
then (Substring.concat o rev) (pre::done)
|
|
57 |
else
|
|
58 |
if Substring.first post = SOME #"+"
|
|
59 |
(* Substring.isPrefix "+" post *)(* seg fault in Poly/ML 5.1 *)
|
|
60 |
then f (Substring.full " "::pre::done, Substring.triml 1 post)
|
|
61 |
else let
|
|
62 |
val (c, rest) = Substring.splitAt (post, 3)
|
43278
|
63 |
handle General.Subscript =>
|
33817
|
64 |
(Substring.full "%25", Substring.triml 1 post);
|
|
65 |
in f (to_char c::pre::done, rest) end
|
|
66 |
end;
|
|
67 |
in f ([], s) end;
|
|
68 |
|
|
69 |
val parse_query_string =
|
|
70 |
Substring.full
|
|
71 |
#> Substring.tokens (Char.contains "&;")
|
|
72 |
#> map split_fields
|
|
73 |
#> map (pairself (UnicodeSymbols.utf8_to_symbols o decode_url))
|
|
74 |
#> distinct ((op =) o pairself fst)
|
|
75 |
#> Symtab.make;
|
|
76 |
|
|
77 |
local
|
|
78 |
fun to_entity #" " = "+"
|
|
79 |
| to_entity c =
|
|
80 |
if Char.isAlphaNum c orelse Char.contains ".-~_" c
|
|
81 |
then String.str c
|
|
82 |
else "%" ^ Int.fmt StringCvt.HEX (Char.ord c);
|
|
83 |
in
|
|
84 |
val encode_url = Substring.translate to_entity o Substring.full;
|
|
85 |
end
|
|
86 |
|
|
87 |
fun join_pairs (n, v) = encode_url n ^ "=" ^ encode_url v;
|
|
88 |
|
|
89 |
val make_query_string =
|
|
90 |
Symtab.dest
|
|
91 |
#> map join_pairs
|
43703
|
92 |
#> space_implode "&";
|
33817
|
93 |
|
|
94 |
end;
|
|
95 |
|