1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
let src = Logs.Src.create "pct"
module Log = (val Logs.src_log src : Logs.LOG)
let safe = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_.-~"
let pchar =
let arr = Array.make 256 false in
for i = 0 to String.length safe - 1 do
arr.(Char.code safe.[i]) <- true
done;
arr.(Char.code ':') <- true;
arr.(Char.code '@') <- true;
arr
let safe_host = pchar
let safe_path =
let v = "!$&'()*+,;=" in
let arr = Array.copy pchar in
for i = 0 to String.length v - 1 do
arr.(Char.code v.[i]) <- true
done;
arr.(Char.code '/') <- true;
arr
let safe_query =
let arr = Array.copy pchar in
arr.(Char.code '/') <- true;
arr.(Char.code '?') <- true;
arr.(Char.code '&') <- false;
arr.(Char.code ';') <- false;
arr.(Char.code '+') <- false;
arr
let safe_query_key =
let arr = Array.copy safe_query in
arr.(Char.code '=') <- false;
arr
let safe_query_value =
let arr = Array.copy safe_query in
arr.(Char.code ',') <- false;
arr
let encode safe_chars str =
let len = String.length str in
let buf = Buffer.create len in
let rec scan start cur =
if cur >= len then Buffer.add_substring buf str start (cur - start)
else if safe_chars.(Char.code str.[cur]) then scan start (succ cur)
else begin
if cur > start then Buffer.add_substring buf str start (cur - start);
Buffer.add_string buf (Format.asprintf "%%%02X" (Char.code str.[cur]));
scan (succ cur) (succ cur)
end
in
scan 0 0; Buffer.contents buf
let encode_path str = encode safe_path str
let encode_host str = encode safe_host str
let encode_query lst =
let enc =
List.map
(fun (k, vs) ->
let k' = encode safe_query_key k in
let vs' = List.map (encode safe_query_value) vs in
k' ^ "=" ^ String.concat "," vs')
lst
in
match lst with _ :: _ -> "?" ^ String.concat "&" enc | [] -> ""
let int_of_hex chr =
let code = int_of_char (Char.uppercase_ascii chr) - 48 in
if code > 9 then
if code > 16 && code < 23 then code - 7 else failwith "int_of_hex"
else if code >= 0 then code
else failwith "int_of_hex"
let plus_to_space str =
let buf = Bytes.unsafe_of_string str in
for i = 0 to Bytes.length buf - 1 do
if Bytes.get buf i = '+' then Bytes.set buf i ' '
done;
Bytes.unsafe_to_string buf
let decode_pct str =
let len = String.length str in
let buf = Buffer.create len in
let rec go start cur =
if cur >= len then Buffer.add_substring buf str start (cur - start)
else if str.[cur] = '%' then begin
Buffer.add_substring buf str start (cur - start);
let cur = cur + 1 in
if cur >= len then Buffer.add_char buf '%'
else
match int_of_hex str.[cur] with
| exception _ -> Buffer.add_char buf '%'; go cur cur
| hi ->
let cur = cur + 1 in
if cur >= len then begin
Buffer.add_char buf '%';
Buffer.add_char buf str.[cur - 1]
end
else
let start_at =
match int_of_hex str.[cur] with
| exception _ ->
Buffer.add_char buf '%';
Buffer.add_char buf str.[cur - 1];
cur
| lo ->
Buffer.add_char buf (Char.chr ((hi lsl 4) + lo));
cur + 1
in
go start_at start_at
end
else go start (cur + 1)
in
go 0 0; Buffer.contents buf
let decode_query str =
let split_query str =
let rec go acc = function
| (k, Some v) :: r ->
let k = plus_to_space k in
let v = plus_to_space v in
let v = String.split_on_char ',' v in
go ((k, v) :: acc) r
| (k, None) :: r ->
let k = plus_to_space k in
go ((k, []) :: acc) r
| [] -> acc
in
match String.split_on_char '&' str with
| [] -> assert false
| els ->
let fn str =
match String.split_on_char '=' str with
| [] -> assert false
| [ x ] -> (x, None)
| k :: v :: r ->
let v = String.concat "=" (v :: r) in
(k, Some v)
in
let els = List.rev_map fn els in
go [] els
in
let lst = split_query str in
List.map (fun (k, v) -> (decode_pct k, List.map decode_pct v)) lst
let query_of_target str =
match String.split_on_char '?' str with
| [] | [ _ ] -> []
| _ :: rest ->
let str = String.concat "?" rest in
Log.debug (fun m -> m "decode the query part: %s" str);
decode_query str