OCaml implementation of the Mozilla Public Suffix service
Merge remote-tracking branch 'samoht/main'
+1190
-166
+38
-25
README.md
+38
-25
README.md
···
13
13
## Usage
14
14
15
15
```ocaml
16
+
(* Create a PSL instance *)
17
+
let psl = Publicsuffix.v ()
16
18
(* Determine the registrable domain (public suffix + one label) *)
17
-
let domain = Domain_name.of_string_exn "www.example.com" in
18
-
match Publicsuffix.registrable_domain domain with
19
-
| Some reg_domain -> Format.printf "Registrable: %a\n" Domain_name.pp reg_domain
20
-
| None -> Format.printf "No registrable domain\n"
19
+
match Publicsuffix.registrable_domain psl "www.example.com" with
20
+
| Ok reg_domain -> Format.printf "Registrable: %s\n" reg_domain
21
+
| Error e -> Format.printf "Error: %a\n" Publicsuffix.pp_error e
21
22
(* Output: Registrable: example.com *)
22
23
23
24
(* Find the public suffix *)
24
-
match Publicsuffix.public_suffix domain with
25
-
| Some suffix -> Format.printf "Suffix: %a\n" Domain_name.pp suffix
26
-
| None -> Format.printf "No public suffix\n"
25
+
match Publicsuffix.public_suffix psl "www.example.com" with
26
+
| Ok suffix -> Format.printf "Suffix: %s\n" suffix
27
+
| Error e -> Format.printf "Error: %a\n" Publicsuffix.pp_error e
27
28
(* Output: Suffix: com *)
28
29
29
30
(* Check if a domain is itself a public suffix *)
30
-
let is_suffix = Publicsuffix.is_public_suffix domain in
31
-
Format.printf "Is public suffix: %b\n" is_suffix
32
-
(* Output: Is public suffix: false *)
31
+
match Publicsuffix.is_public_suffix psl "com" with
32
+
| Ok is_suffix -> Format.printf "Is public suffix: %b\n" is_suffix
33
+
| Error e -> Format.printf "Error: %a\n" Publicsuffix.pp_error e
34
+
(* Output: Is public suffix: true *)
33
35
```
34
36
35
37
For domains with wildcards and exceptions:
36
38
37
39
```ocaml
38
40
(* Example with wildcard rule: *.uk *)
39
-
let domain = Domain_name.of_string_exn "example.uk" in
40
-
match Publicsuffix.public_suffix domain with
41
-
| Some suffix -> Format.printf "Suffix: %a\n" Domain_name.pp suffix
42
-
| None -> ()
41
+
match Publicsuffix.public_suffix psl "example.uk" with
42
+
| Ok suffix -> Format.printf "Suffix: %s\n" suffix
43
+
| Error _ -> ()
43
44
(* Output: Suffix: uk *)
44
45
45
46
(* Example with exception rule: !parliament.uk *)
46
-
let domain = Domain_name.of_string_exn "parliament.uk" in
47
-
match Publicsuffix.registrable_domain domain with
48
-
| Some reg_domain -> Format.printf "Registrable: %a\n" Domain_name.pp reg_domain
49
-
| None -> ()
47
+
match Publicsuffix.registrable_domain psl "parliament.uk" with
48
+
| Ok reg_domain -> Format.printf "Registrable: %s\n" reg_domain
49
+
| Error _ -> ()
50
50
(* Output: Registrable: parliament.uk *)
51
51
```
52
52
53
53
## Installation
54
54
55
+
Install with opam:
56
+
57
+
```sh
58
+
$ opam install publicsuffix
55
59
```
56
-
opam install publicsuffix
60
+
61
+
If opam cannot find the package, it may not yet be released in the public
62
+
`opam-repository`. Add the overlay repository, then install it:
63
+
64
+
```sh
65
+
$ opam repo add samoht https://tangled.org/gazagnaire.org/opam-overlay.git
66
+
$ opam update
67
+
$ opam install publicsuffix
57
68
```
58
69
59
70
## Updating the Public Suffix List Data
60
71
61
72
The `data/public_suffix_list.dat` file contains the PSL data, which is compiled into the library at build time. To update to the latest version:
62
73
63
-
```bash
64
-
curl -o data/public_suffix_list.dat https://publicsuffix.org/list/public_suffix_list.dat
65
-
opam exec -- dune build
74
+
<!-- $MDX non-deterministic=command -->
75
+
```sh
76
+
$ curl -o data/public_suffix_list.dat https://publicsuffix.org/list/public_suffix_list.dat
77
+
$ opam exec -- dune build
66
78
```
67
79
68
80
## Documentation
···
76
88
77
89
Or build locally:
78
90
79
-
```bash
80
-
opam exec -- dune build @doc
91
+
<!-- $MDX non-deterministic=command -->
92
+
```sh
93
+
$ opam exec -- dune build @doc
81
94
```
82
95
83
96
## Technical Standards
···
92
105
93
106
RFC specifications are available in the `spec/` directory for reference.
94
107
95
-
## License
108
+
## Licence
96
109
97
110
ISC
+8
-8
bin/main.ml
+8
-8
bin/main.ml
···
5
5
6
6
open Cmdliner
7
7
8
-
let psl = lazy (Publicsuffix.create ())
8
+
let psl = lazy (Publicsuffix.v ())
9
9
let psl () = Lazy.force psl
10
10
11
11
(* Helper functions for printing results *)
12
12
13
-
let print_error e = Printf.printf "ERROR: %s\n" (Publicsuffix.error_to_string e)
13
+
let print_error e = Fmt.pr "ERROR: %s@." (Publicsuffix.error_to_string e)
14
14
let print_result = function Ok s -> print_endline s | Error e -> print_error e
15
15
16
16
let print_bool_result = function
···
24
24
| Publicsuffix.ICANN -> "ICANN"
25
25
| Publicsuffix.Private -> "PRIVATE"
26
26
in
27
-
Printf.printf "%s (%s)\n" s sec_str
27
+
Fmt.pr "%s (%s)@." s sec_str
28
28
| Error e -> print_error e
29
29
30
30
let registrable_cmd =
···
86
86
let term =
87
87
Term.(
88
88
const (fun (total, icann, private_rules) ->
89
-
Printf.printf "Total rules: %d\n" total;
90
-
Printf.printf "ICANN rules: %d\n" icann;
91
-
Printf.printf "Private rules: %d\n" private_rules)
89
+
Fmt.pr "Total rules: %d@." total;
90
+
Fmt.pr "ICANN rules: %d@." icann;
91
+
Fmt.pr "Private rules: %d@." private_rules)
92
92
$ Publicsuffix_cmd.stats_term (psl ()))
93
93
in
94
94
Cmd.v info term
···
99
99
let term =
100
100
Term.(
101
101
const (fun (version, commit) ->
102
-
Printf.printf "Version: %s\n" version;
103
-
Printf.printf "Commit: %s\n" commit)
102
+
Fmt.pr "Version: %s@." version;
103
+
Fmt.pr "Commit: %s@." commit)
104
104
$ Publicsuffix_cmd.version_term (psl ()))
105
105
in
106
106
Cmd.v info term
+8
dune
+8
dune
···
1
+
(env
2
+
(dev
3
+
(flags :standard %{dune-warnings})))
4
+
1
5
; Root dune file
2
6
3
7
; Ignore third_party directory (for fetched dependency sources)
4
8
5
9
(data_only_dirs third_party)
10
+
11
+
(mdx
12
+
(files README.md)
13
+
(libraries publicsuffix publicsuffix.cmd publicsuffix.data))
+4
dune-project
+4
dune-project
···
1
1
(lang dune 3.21)
2
+
(using mdx 0.4)
2
3
(name publicsuffix)
3
4
4
5
(generate_opam_files true)
···
11
12
(package
12
13
(name publicsuffix)
13
14
(synopsis "Public Suffix List implementation for OCaml")
15
+
(tags (org:blacksun network))
14
16
(description
15
17
"Parse and query the Mozilla Public Suffix List (PSL) to determine public suffixes and registrable domains. Supports ICANN and private domain sections, wildcard rules, and exception rules per the PSL specification.")
16
18
(depends
17
19
(ocaml (>= 4.14.0))
18
20
(domain-name (>= 0.4.0))
21
+
(fmt (>= 0.9.0))
19
22
punycode
20
23
(cmdliner (>= 1.3.0))
24
+
(mdx :with-test)
21
25
(alcotest :with-test)))
+1
-2
gen/dune
+1
-2
gen/dune
+52
-67
gen/gen_psl.ml
+52
-67
gen/gen_psl.ml
···
34
34
(** A parsed rule *)
35
35
36
36
type trie_node = {
37
-
id : int; (* Unique identifier for this node *)
37
+
id : int; (* Unique identifier for this node *)
38
38
mutable rule : (rule_type * section) option;
39
39
mutable children : (string * trie_node) list;
40
40
mutable wildcard_child : trie_node option;
···
43
43
44
44
let node_id_counter = ref 0
45
45
46
-
let make_node () =
46
+
let new_node () =
47
47
let id = !node_id_counter in
48
48
incr node_id_counter;
49
49
{ id; rule = None; children = []; wildcard_child = None }
···
99
99
match node.wildcard_child with
100
100
| Some c -> c
101
101
| None ->
102
-
let c = make_node () in
102
+
let c = new_node () in
103
103
node.wildcard_child <- Some c;
104
104
c
105
105
in
···
112
112
match List.assoc_opt label node.children with
113
113
| Some c -> c
114
114
| None ->
115
-
let c = make_node () in
115
+
let c = new_node () in
116
116
node.children <- (label, c) :: node.children;
117
117
c
118
118
in
···
123
123
(** Parse the entire PSL file *)
124
124
let parse_file filename =
125
125
let ic = open_in filename in
126
-
let trie = make_node () in
126
+
let trie = new_node () in
127
127
let current_section = ref ICANN in
128
128
let rule_count = ref 0 in
129
129
let icann_count = ref 0 in
···
131
131
let version = ref None in
132
132
let commit = ref None in
133
133
(* Helper to check if string contains substring *)
134
-
let contains_substring s sub =
135
-
try
136
-
let _ = Str.search_forward (Str.regexp_string sub) s 0 in
137
-
true
138
-
with Not_found -> false
139
-
in
134
+
let contains_substring s sub = Re.execp (Re.compile (Re.str sub)) s in
140
135
(* Helper to extract value after "KEY: " pattern *)
141
136
let extract_value line prefix =
142
137
let prefix_len = String.length prefix in
···
190
185
s;
191
186
Buffer.contents b
192
187
193
-
(** Generate OCaml code for the trie *)
194
-
let generate_code trie rule_count icann_count private_count version commit =
195
-
(* Print header *)
188
+
let print_generated_header rule_count icann_count private_count version commit =
196
189
print_string
197
190
{|(* Auto-generated from public_suffix_list.dat - DO NOT EDIT *)
198
191
(* This file contains the parsed Public Suffix List as OCaml data structures *)
···
211
204
}
212
205
213
206
|};
214
-
Printf.printf "(* Statistics: %d total rules (%d ICANN, %d private) *)\n"
215
-
rule_count icann_count private_count;
216
-
Printf.printf "(* Version: %s *)\n" version;
217
-
Printf.printf "(* Commit: %s *)\n" commit;
218
-
print_string "\n";
207
+
Fmt.pr "(* Statistics: %d total rules (%d ICANN, %d private) *)\n" rule_count
208
+
icann_count private_count;
209
+
Fmt.pr "(* Version: %s *)\n" version;
210
+
Fmt.pr "(* Commit: %s *)\n" commit;
211
+
print_string "\n"
219
212
220
-
(* Generate the trie as nested let bindings using a depth-first traversal *)
221
-
let node_counter = ref 0 in
222
-
let node_names = Hashtbl.create 1000 in
213
+
let print_generated_footer rule_count icann_count private_count version commit
214
+
root_name =
215
+
Fmt.pr "let root = %s\n" root_name;
216
+
print_string
217
+
{|
218
+
(** Get the root of the suffix trie *)
219
+
let root () = root
223
220
224
-
(* First pass: assign names to all nodes *)
225
-
let rec assign_names node =
226
-
let name = Printf.sprintf "n%d" !node_counter in
221
+
(** Total number of rules in the list *)
222
+
|};
223
+
Fmt.pr "let rule_count = %d\n\n" rule_count;
224
+
Fmt.pr "let icann_rule_count = %d\n\n" icann_count;
225
+
Fmt.pr "let private_rule_count = %d\n\n" private_count;
226
+
Fmt.pr "let version = %S\n\n" version;
227
+
Fmt.pr "let commit = %S\n" commit
228
+
229
+
let assign_node_names node_counter node_names =
230
+
let rec go node =
231
+
let name = Fmt.str "n%d" !node_counter in
227
232
incr node_counter;
228
233
Hashtbl.add node_names node.id name;
229
-
List.iter (fun (_, child) -> assign_names child) node.children;
230
-
Option.iter assign_names node.wildcard_child
234
+
List.iter (fun (_, child) -> go child) node.children;
235
+
Option.iter go node.wildcard_child
231
236
in
232
-
assign_names trie;
237
+
go
233
238
234
-
(* Generate nodes in reverse order (leaves first) *)
239
+
let generate_trie_nodes trie =
240
+
let node_counter = ref 0 in
241
+
let node_names = Hashtbl.create 1000 in
242
+
assign_node_names node_counter node_names trie;
235
243
let generated = Hashtbl.create 1000 in
236
244
let output_buffer = Buffer.create (1024 * 1024) in
237
-
238
245
let rec generate_node node =
239
246
let node_id = node.id in
240
247
if Hashtbl.mem generated node_id then Hashtbl.find node_names node_id
241
248
else begin
242
-
(* First generate all children *)
243
249
List.iter (fun (_, child) -> ignore (generate_node child)) node.children;
244
250
Option.iter
245
251
(fun child -> ignore (generate_node child))
246
252
node.wildcard_child;
247
-
248
253
let name = Hashtbl.find node_names node_id in
249
-
250
-
(* Generate the node definition *)
251
-
Buffer.add_string output_buffer (Printf.sprintf "let %s = {\n" name);
252
-
253
-
(* Rule field *)
254
+
Buffer.add_string output_buffer (Fmt.str "let %s = {\n" name);
254
255
(match node.rule with
255
256
| None -> Buffer.add_string output_buffer " rule = None;\n"
256
257
| Some (rt, sec) ->
···
264
265
match sec with ICANN -> "ICANN" | Private -> "Private"
265
266
in
266
267
Buffer.add_string output_buffer
267
-
(Printf.sprintf " rule = Some (%s, %s);\n" rt_str sec_str));
268
-
269
-
(* Children field *)
268
+
(Fmt.str " rule = Some (%s, %s);\n" rt_str sec_str));
270
269
if node.children = [] then
271
270
Buffer.add_string output_buffer " children = [];\n"
272
271
else begin
···
275
274
(fun (label, child) ->
276
275
let child_name = Hashtbl.find node_names child.id in
277
276
Buffer.add_string output_buffer
278
-
(Printf.sprintf " (\"%s\", %s);\n" (escape_string label)
279
-
child_name))
277
+
(Fmt.str " (\"%s\", %s);\n" (escape_string label) child_name))
280
278
node.children;
281
279
Buffer.add_string output_buffer " ];\n"
282
280
end;
283
-
284
-
(* Wildcard child field *)
285
281
(match node.wildcard_child with
286
282
| None -> Buffer.add_string output_buffer " wildcard_child = None;\n"
287
283
| Some child ->
288
284
let child_name = Hashtbl.find node_names child.id in
289
285
Buffer.add_string output_buffer
290
-
(Printf.sprintf " wildcard_child = Some %s;\n" child_name));
291
-
286
+
(Fmt.str " wildcard_child = Some %s;\n" child_name));
292
287
Buffer.add_string output_buffer "}\n\n";
293
-
294
288
Hashtbl.add generated node_id true;
295
289
name
296
290
end
297
291
in
298
-
299
292
let root_name = generate_node trie in
300
-
print_string (Buffer.contents output_buffer);
301
-
Printf.printf "let root = %s\n" root_name;
293
+
(Buffer.contents output_buffer, root_name)
302
294
303
-
(* Generate helper to get the root *)
304
-
print_string
305
-
{|
306
-
(** Get the root of the suffix trie *)
307
-
let get_root () = root
308
-
309
-
(** Total number of rules in the list *)
310
-
|};
311
-
Printf.printf "let rule_count = %d\n\n" rule_count;
312
-
Printf.printf "let icann_rule_count = %d\n\n" icann_count;
313
-
Printf.printf "let private_rule_count = %d\n\n" private_count;
314
-
(* Generate version and commit values *)
315
-
Printf.printf "let version = %S\n\n" version;
316
-
Printf.printf "let commit = %S\n" commit
295
+
(** Generate OCaml code for the trie *)
296
+
let generate_code trie rule_count icann_count private_count version commit =
297
+
print_generated_header rule_count icann_count private_count version commit;
298
+
let node_output, root_name = generate_trie_nodes trie in
299
+
print_string node_output;
300
+
print_generated_footer rule_count icann_count private_count version commit
301
+
root_name
317
302
318
303
let () =
319
304
if Array.length Sys.argv < 2 then begin
320
-
Printf.eprintf "Usage: %s <public_suffix_list.dat>\n" Sys.argv.(0);
305
+
Fmt.epr "Usage: %s <public_suffix_list.dat>\n" Sys.argv.(0);
321
306
exit 1
322
307
end;
323
308
let filename = Sys.argv.(1) in
···
329
314
match version with
330
315
| Some v -> v
331
316
| None ->
332
-
Printf.eprintf "ERROR: VERSION not found in %s\n" filename;
317
+
Fmt.epr "ERROR: VERSION not found in %s\n" filename;
333
318
exit 1
334
319
in
335
320
let commit =
336
321
match commit with
337
322
| Some c -> c
338
323
| None ->
339
-
Printf.eprintf "ERROR: COMMIT not found in %s\n" filename;
324
+
Fmt.epr "ERROR: COMMIT not found in %s\n" filename;
340
325
exit 1
341
326
in
342
327
generate_code trie rule_count icann_count private_count version commit
+1
-1
lib/dune
+1
-1
lib/dune
+20
-21
lib/publicsuffix.ml
+20
-21
lib/publicsuffix.ml
···
35
35
| Domain_is_public_suffix
36
36
37
37
let pp_error fmt = function
38
-
| Empty_domain -> Format.fprintf fmt "Empty domain"
39
-
| Invalid_domain s -> Format.fprintf fmt "Invalid domain: %s" s
40
-
| Leading_dot -> Format.fprintf fmt "Domain has a leading dot"
41
-
| Punycode_error s -> Format.fprintf fmt "Punycode conversion error: %s" s
42
-
| No_public_suffix -> Format.fprintf fmt "No public suffix found"
43
-
| Domain_is_public_suffix ->
44
-
Format.fprintf fmt "Domain is itself a public suffix"
38
+
| Empty_domain -> Fmt.pf fmt "Empty domain"
39
+
| Invalid_domain s -> Fmt.pf fmt "Invalid domain: %s" s
40
+
| Leading_dot -> Fmt.pf fmt "Domain has a leading dot"
41
+
| Punycode_error s -> Fmt.pf fmt "Punycode conversion error: %s" s
42
+
| No_public_suffix -> Fmt.pf fmt "No public suffix found"
43
+
| Domain_is_public_suffix -> Fmt.pf fmt "Domain is itself a public suffix"
45
44
46
-
let error_to_string err = Format.asprintf "%a" pp_error err
47
-
let create () = { root = Publicsuffix_data.get_root () }
45
+
let error_to_string err = Fmt.str "%a" pp_error err
46
+
let v () = { root = Publicsuffix_data.root () }
47
+
let pp fmt _t = Fmt.pf fmt "<Publicsuffix>"
48
48
49
49
(* Find a child node by label (case-insensitive) *)
50
-
let find_child (node : trie_node) label =
50
+
let child (node : trie_node) label =
51
51
let label_lower = String.lowercase_ascii label in
52
52
List.find_opt
53
53
(fun (l, _) -> String.lowercase_ascii l = label_lower)
···
63
63
64
64
(** Find all matching rules for a domain. Labels should be in reverse order (TLD
65
65
first). *)
66
-
let find_matches (root : trie_node) labels =
66
+
let matches (root : trie_node) labels =
67
67
let matches = ref [] in
68
68
69
69
(* Track whether we matched the implicit * rule *)
···
110
110
wc.rule);
111
111
112
112
(* Check for exact label match *)
113
-
find_child node label
114
-
|> Option.iter (fun child -> traverse child (depth + 1) rest)
113
+
child node label |> Option.iter (fun c -> traverse c (depth + 1) rest)
115
114
in
116
115
117
116
traverse root 0 labels;
···
155
154
match
156
155
try Ok (Punycode_idna.to_ascii domain)
157
156
with Punycode_idna.Error e ->
158
-
let msg = Format.asprintf "%a" Punycode_idna.pp_error_reason e in
157
+
let msg = Fmt.str "%a" Punycode_idna.pp_error_reason e in
159
158
Error (Punycode_error msg)
160
159
with
161
160
| Error e -> Error e
···
187
186
else prevailing.matched_labels
188
187
189
188
(** Find the prevailing rule for a domain *)
190
-
let find_prevailing_rule t labels =
189
+
let prevailing_rule t labels =
191
190
let rev_labels = List.rev labels in
192
-
let matches = find_matches t.root rev_labels in
193
-
select_prevailing_rule matches
191
+
let ms = matches t.root rev_labels in
192
+
select_prevailing_rule ms
194
193
195
194
let public_suffix_with_section t domain =
196
195
match normalize_domain domain with
197
196
| Error e -> Error e
198
197
| Ok (labels, has_trailing_dot) ->
199
-
let prevailing = find_prevailing_rule t labels in
198
+
let prevailing = prevailing_rule t labels in
200
199
let count = suffix_label_count prevailing in
201
200
if count > List.length labels then Error No_public_suffix
202
201
else
···
211
210
match normalize_domain domain with
212
211
| Error e -> Error e
213
212
| Ok (labels, has_trailing_dot) ->
214
-
let prevailing = find_prevailing_rule t labels in
213
+
let prevailing = prevailing_rule t labels in
215
214
let count = suffix_label_count prevailing in
216
215
(* Registrable domain = suffix + 1 label *)
217
216
let reg_label_count = count + 1 in
···
228
227
match normalize_domain domain with
229
228
| Error e -> Error e
230
229
| Ok (labels, _) ->
231
-
let prevailing = find_prevailing_rule t labels in
230
+
let prevailing = prevailing_rule t labels in
232
231
let count = suffix_label_count prevailing in
233
232
(* Domain is a public suffix if it has exactly suffix_label_count labels *)
234
233
Ok (List.length labels = count)
···
237
236
match normalize_domain domain with
238
237
| Error e -> Error e
239
238
| Ok (labels, _) ->
240
-
let prevailing = find_prevailing_rule t labels in
239
+
let prevailing = prevailing_rule t labels in
241
240
let count = suffix_label_count prevailing in
242
241
let reg_label_count = count + 1 in
243
242
(* Domain is registrable if it has exactly reg_label_count labels *)
+36
-33
lib/publicsuffix.mli
+36
-33
lib/publicsuffix.mli
···
50
50
{1 Example Usage}
51
51
52
52
{[
53
-
let psl = Publicsuffix.create () in
53
+
let psl = Publicsuffix.v () in
54
54
55
-
(* Get the public suffix of a domain *)
56
-
Publicsuffix.public_suffix psl "www.example.com" (* Returns: Ok "com" *)
57
-
Publicsuffix.public_suffix psl
58
-
"www.example.co.uk" (* Returns: Ok "co.uk" *)
59
-
(* Get the registrable domain *)
60
-
Publicsuffix.registrable_domain psl
61
-
"www.example.com" (* Returns: Ok "example.com" *)
62
-
(* Check if a domain is a public suffix *)
63
-
Publicsuffix.is_public_suffix psl "com" (* Returns: Ok true *)
64
-
Publicsuffix.is_public_suffix psl "example.com"
65
-
(* Returns: Ok false *)
55
+
(* Get the public suffix of a domain *)
56
+
Publicsuffix.public_suffix psl "www.example.com" (* Returns: Ok "com" *)
57
+
Publicsuffix.public_suffix psl
58
+
"www.example.co.uk" (* Returns: Ok "co.uk" *)
59
+
(* Get the registrable domain *)
60
+
Publicsuffix.registrable_domain psl
61
+
"www.example.com" (* Returns: Ok "example.com" *)
62
+
(* Check if a domain is a public suffix *)
63
+
Publicsuffix.is_public_suffix psl "com" (* Returns: Ok true *)
64
+
Publicsuffix.is_public_suffix psl "example.com"
65
+
(* Returns: Ok false *)
66
66
]}
67
67
68
68
{1 Internationalized Domain Names}
···
81
81
encoding implementation. Both Unicode and Punycode input are accepted:
82
82
83
83
{[
84
-
Publicsuffix.registrable_domain psl
85
-
"www.食狮.com.cn" (* Returns: Ok "食狮.com.cn" *)
86
-
Publicsuffix.registrable_domain psl "www.xn--85x722f.com.cn"
87
-
(* Returns: Ok "xn--85x722f.com.cn" *)
84
+
Publicsuffix.registrable_domain psl
85
+
"www.食狮.com.cn" (* Returns: Ok "食狮.com.cn" *)
86
+
Publicsuffix.registrable_domain psl "www.xn--85x722f.com.cn"
87
+
(* Returns: Ok "xn--85x722f.com.cn" *)
88
88
]}
89
89
90
90
{1 Trailing Dots}
···
93
93
names) are preserved in the output:
94
94
95
95
{[
96
-
Publicsuffix.public_suffix psl "example.com" (* Returns: Ok "com" *)
97
-
Publicsuffix.public_suffix psl "example.com."
98
-
(* Returns: Ok "com." *)
96
+
Publicsuffix.public_suffix psl "example.com" (* Returns: Ok "com" *)
97
+
Publicsuffix.public_suffix psl "example.com."
98
+
(* Returns: Ok "com." *)
99
99
]}
100
100
101
101
{1 References}
···
129
129
| Private (** Domains submitted by private parties *)
130
130
131
131
type t
132
-
(** A handle to the parsed Public Suffix List *)
132
+
(** A handle to the parsed Public Suffix List. *)
133
+
134
+
val pp : Format.formatter -> t -> unit
135
+
(** [pp fmt t] pretty-prints a summary of the PSL handle. *)
133
136
134
137
(** {1 Errors} *)
135
138
···
158
161
(** The domain is itself a public suffix and has no registrable domain *)
159
162
160
163
val pp_error : Format.formatter -> error -> unit
161
-
(** Pretty-print an error *)
164
+
(** Pretty-print an error. *)
162
165
163
166
val error_to_string : error -> string
164
-
(** Convert an error to a human-readable string *)
167
+
(** Convert an error to a human-readable string. *)
165
168
166
169
(** {1 Creation} *)
167
170
168
-
val create : unit -> t
169
-
(** Create a PSL instance using the embedded Public Suffix List data. The data
170
-
is compiled into the library at build time. *)
171
+
val v : unit -> t
172
+
(** [v ()] creates a PSL instance using the embedded Public Suffix List data.
173
+
The data is compiled into the library at build time. *)
171
174
172
175
(** {1 Core Operations} *)
173
176
···
202
205
If the implicit [*] rule was used (no explicit rule matched), the section is
203
206
[ICANN].
204
207
205
-
@return [Ok (suffix, section)] or [Error e] on failure *)
208
+
@return [Ok (suffix, section)] or [Error e] on failure. *)
206
209
207
210
val registrable_domain : t -> string -> (string, error) result
208
211
(** [registrable_domain t domain] returns the registrable domain portion.
···
225
228
Examples:
226
229
- [registrable_domain t "www.example.com"] returns [Ok "example.com"]
227
230
- [registrable_domain t "example.com"] returns [Ok "example.com"]
228
-
- [registrable_domain t "com"] returns [Error Domain_is_public_suffix] *)
231
+
- [registrable_domain t "com"] returns [Error Domain_is_public_suffix]. *)
229
232
230
233
val registrable_domain_with_section :
231
234
t -> string -> (string * section, error) result
232
235
(** [registrable_domain_with_section t domain] is like {!registrable_domain} but
233
236
also returns the section where the matching rule was found.
234
237
235
-
@return [Ok (domain, section)] or [Error e] on failure *)
238
+
@return [Ok (domain, section)] or [Error e] on failure. *)
236
239
237
240
(** {1 Predicates} *)
238
241
···
255
258
Examples:
256
259
- [is_registrable_domain t "example.com"] returns [Ok true]
257
260
- [is_registrable_domain t "www.example.com"] returns [Ok false]
258
-
- [is_registrable_domain t "com"] returns [Ok false] *)
261
+
- [is_registrable_domain t "com"] returns [Ok false]. *)
259
262
260
263
(** {1 Statistics} *)
261
264
262
265
val rule_count : t -> int
263
-
(** Total number of rules in the embedded PSL *)
266
+
(** Total number of rules in the embedded PSL. *)
264
267
265
268
val icann_rule_count : t -> int
266
-
(** Number of ICANN section rules *)
269
+
(** Number of ICANN section rules. *)
267
270
268
271
val private_rule_count : t -> int
269
-
(** Number of private section rules *)
272
+
(** Number of private section rules. *)
270
273
271
274
(** {1 Version Information} *)
272
275
···
274
277
(** Version string from the embedded PSL data.
275
278
276
279
Returns the version identifier from the Public Suffix List source file,
277
-
typically in the format ["YYYY-MM-DD_HH-MM-SS_UTC"]. *)
280
+
typically in the format "YYYY-MM-DD_HH-MM-SS_UTC". *)
278
281
279
282
val commit : t -> string
280
283
(** Commit hash from the embedded PSL data.
+2
-2
lib/publicsuffix_data.mli
+2
-2
lib/publicsuffix_data.mli
···
119
119
120
120
(** {1 Data Access} *)
121
121
122
-
val get_root : unit -> trie_node
122
+
val root : unit -> trie_node
123
123
(** Get the root of the suffix trie.
124
124
125
125
The root node represents the starting point for all PSL lookups. Domain
126
126
labels should be traversed in reverse order (TLD first) from this root.
127
127
128
-
@return The root trie node containing all PSL rules *)
128
+
@return The root trie node containing all PSL rules. *)
129
129
130
130
(** {1 Statistics}
131
131
+5
publicsuffix.opam
+5
publicsuffix.opam
···
6
6
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
7
authors: ["Anil Madhavapeddy"]
8
8
license: "ISC"
9
+
tags: ["org:blacksun" "network"]
9
10
homepage: "https://tangled.org/anil.recoil.org/ocaml-publicsuffix"
10
11
bug-reports: "https://tangled.org/anil.recoil.org/ocaml-publicsuffix/issues"
11
12
depends: [
12
13
"dune" {>= "3.21"}
13
14
"ocaml" {>= "4.14.0"}
14
15
"domain-name" {>= "0.4.0"}
16
+
"fmt" {>= "0.9.0"}
15
17
"punycode"
16
18
"cmdliner" {>= "1.3.0"}
19
+
"mdx" {with-test}
17
20
"alcotest" {with-test}
18
21
"odoc" {with-doc}
19
22
]
···
33
36
]
34
37
dev-repo: "git+https://tangled.org/anil.recoil.org/ocaml-publicsuffix"
35
38
x-maintenance-intent: ["(latest)"]
39
+
x-quality-build: "2026-04-15"
40
+
x-quality-test: "2026-04-15"
+2
publicsuffix.opam.template
+2
publicsuffix.opam.template
+3
test/cmd/dune
+3
test/cmd/dune
+1
test/cmd/test.ml
+1
test/cmd/test.ml
···
1
+
let () = Alcotest.run "Publicsuffix_cmd" [ Test_publicsuffix_cmd.suite ]
+159
test/cmd/test_publicsuffix_cmd.ml
+159
test/cmd/test_publicsuffix_cmd.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Alcotest unit tests for the Publicsuffix_cmd module.
7
+
8
+
The module exposes Cmdliner Term.t values. We evaluate each term by
9
+
providing synthetic argv through Cmdliner.Cmd.eval_value, which lets
10
+
us exercise the full term pipeline (argument parsing + PSL lookup)
11
+
without spawning a subprocess. *)
12
+
13
+
open Alcotest
14
+
15
+
let psl = Publicsuffix.v ()
16
+
17
+
(* Helper: evaluate a Cmdliner term with a given domain argument and return
18
+
the result. We build a throwaway Cmd.t, set argv to include the domain,
19
+
and extract the value produced by eval_value. *)
20
+
let eval_term_with_domain term domain =
21
+
let info = Cmdliner.Cmd.info "test" in
22
+
let cmd = Cmdliner.Cmd.v info term in
23
+
let argv = [| "test"; domain |] in
24
+
match Cmdliner.Cmd.eval_value ~argv cmd with
25
+
| Ok (`Ok v) -> Some v
26
+
| _ -> None
27
+
28
+
let eval_term_no_args term =
29
+
let info = Cmdliner.Cmd.info "test" in
30
+
let cmd = Cmdliner.Cmd.v info term in
31
+
let argv = [| "test" |] in
32
+
match Cmdliner.Cmd.eval_value ~argv cmd with
33
+
| Ok (`Ok v) -> Some v
34
+
| _ -> None
35
+
36
+
(* ---------- registrable_term ------------------------------------------ *)
37
+
38
+
let test_registrable_term () =
39
+
let term = Publicsuffix_cmd.registrable_term psl in
40
+
match eval_term_with_domain term "www.example.com" with
41
+
| Some (Ok v) -> check string "registrable" "example.com" v
42
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
43
+
| None -> fail "term evaluation failed"
44
+
45
+
let test_registrable_term_suffix () =
46
+
let term = Publicsuffix_cmd.registrable_term psl in
47
+
match eval_term_with_domain term "com" with
48
+
| Some (Error Publicsuffix.Domain_is_public_suffix) -> ()
49
+
| Some (Ok v) -> failf "expected error, got Ok %S" v
50
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
51
+
| None -> fail "term evaluation failed"
52
+
53
+
(* ---------- suffix_term ----------------------------------------------- *)
54
+
55
+
let test_suffix_term () =
56
+
let term = Publicsuffix_cmd.suffix_term psl in
57
+
match eval_term_with_domain term "www.example.co.uk" with
58
+
| Some (Ok v) -> check string "suffix" "co.uk" v
59
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
60
+
| None -> fail "term evaluation failed"
61
+
62
+
(* ---------- is_suffix_term -------------------------------------------- *)
63
+
64
+
let test_is_suffix_term () =
65
+
let term = Publicsuffix_cmd.is_suffix_term psl in
66
+
match eval_term_with_domain term "com" with
67
+
| Some (Ok v) -> check bool "is suffix" true v
68
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
69
+
| None -> fail "term evaluation failed"
70
+
71
+
let test_is_suffix_term_false () =
72
+
let term = Publicsuffix_cmd.is_suffix_term psl in
73
+
match eval_term_with_domain term "example.com" with
74
+
| Some (Ok v) -> check bool "not suffix" false v
75
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
76
+
| None -> fail "term evaluation failed"
77
+
78
+
(* ---------- is_registrable_term --------------------------------------- *)
79
+
80
+
let test_is_registrable_term () =
81
+
let term = Publicsuffix_cmd.is_registrable_term psl in
82
+
match eval_term_with_domain term "example.com" with
83
+
| Some (Ok v) -> check bool "is registrable" true v
84
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
85
+
| None -> fail "term evaluation failed"
86
+
87
+
(* ---------- section terms --------------------------------------------- *)
88
+
89
+
let test_registrable_section_term () =
90
+
let term = Publicsuffix_cmd.registrable_section_term psl in
91
+
match eval_term_with_domain term "example.blogspot.com" with
92
+
| Some (Ok (domain, sec)) ->
93
+
check string "domain" "example.blogspot.com" domain;
94
+
check bool "private section" true (sec = Publicsuffix.Private)
95
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
96
+
| None -> fail "term evaluation failed"
97
+
98
+
let test_suffix_section_term () =
99
+
let term = Publicsuffix_cmd.suffix_section_term psl in
100
+
match eval_term_with_domain term "example.com" with
101
+
| Some (Ok (suffix, sec)) ->
102
+
check string "suffix" "com" suffix;
103
+
check bool "ICANN section" true (sec = Publicsuffix.ICANN)
104
+
| Some (Error e) -> fail (Publicsuffix.error_to_string e)
105
+
| None -> fail "term evaluation failed"
106
+
107
+
(* ---------- stats_term ------------------------------------------------ *)
108
+
109
+
let test_stats_term () =
110
+
let term = Publicsuffix_cmd.stats_term psl in
111
+
match eval_term_no_args term with
112
+
| Some (total, icann, priv) ->
113
+
check bool "total > 0" true (total > 0);
114
+
check bool "icann > 0" true (icann > 0);
115
+
check bool "private > 0" true (priv > 0);
116
+
check bool "sum" true (icann + priv = total)
117
+
| None -> fail "term evaluation failed"
118
+
119
+
(* ---------- version_term ---------------------------------------------- *)
120
+
121
+
let test_version_term () =
122
+
let term = Publicsuffix_cmd.version_term psl in
123
+
match eval_term_no_args term with
124
+
| Some (version, commit) ->
125
+
check bool "version non-empty" true (String.length version > 0);
126
+
check bool "commit non-empty" true (String.length commit > 0)
127
+
| None -> fail "term evaluation failed"
128
+
129
+
(* ---------- domain_arg ------------------------------------------------ *)
130
+
131
+
let test_domain_arg_missing () =
132
+
(* When no domain argument is provided, the registrable_term should fail
133
+
at the Cmdliner level (missing required positional argument). *)
134
+
let term = Publicsuffix_cmd.registrable_term psl in
135
+
let info = Cmdliner.Cmd.info "test" in
136
+
let cmd = Cmdliner.Cmd.v info term in
137
+
let argv = [| "test" |] in
138
+
match Cmdliner.Cmd.eval_value ~argv cmd with
139
+
| Ok (`Ok _) -> fail "expected failure for missing domain"
140
+
| _ -> () (* Any non-Ok result is expected *)
141
+
142
+
(* ---------- suite export ---------------------------------------------- *)
143
+
144
+
let suite =
145
+
( "publicsuffix_cmd",
146
+
[
147
+
test_case "registrable_term" `Quick test_registrable_term;
148
+
test_case "registrable_term suffix error" `Quick
149
+
test_registrable_term_suffix;
150
+
test_case "suffix_term" `Quick test_suffix_term;
151
+
test_case "is_suffix_term true" `Quick test_is_suffix_term;
152
+
test_case "is_suffix_term false" `Quick test_is_suffix_term_false;
153
+
test_case "is_registrable_term" `Quick test_is_registrable_term;
154
+
test_case "registrable_section_term" `Quick test_registrable_section_term;
155
+
test_case "suffix_section_term" `Quick test_suffix_section_term;
156
+
test_case "stats_term" `Quick test_stats_term;
157
+
test_case "version_term" `Quick test_version_term;
158
+
test_case "domain_arg missing" `Quick test_domain_arg_missing;
159
+
] )
+4
test/cmd/test_publicsuffix_cmd.mli
+4
test/cmd/test_publicsuffix_cmd.mli
+481
test/cram/publicsuffix.t
+481
test/cram/publicsuffix.t
···
1
+
Public Suffix List Tests
2
+
========================
3
+
4
+
These tests are based on the official test vectors from:
5
+
https://raw.githubusercontent.com/publicsuffix/list/master/tests/test_psl.txt
6
+
7
+
The checkPublicSuffix function tests the registrable domain output.
8
+
null input -> null output means an error is expected.
9
+
domain -> null means the domain is a public suffix (no registrable domain).
10
+
11
+
Basic Statistics
12
+
----------------
13
+
14
+
$ publicsuffix stats
15
+
Total rules: 10064
16
+
ICANN rules: 6930
17
+
Private rules: 3134
18
+
19
+
Null Input (Empty Domain)
20
+
-------------------------
21
+
22
+
$ publicsuffix registrable ""
23
+
ERROR: Empty domain
24
+
25
+
Mixed Case Tests
26
+
----------------
27
+
28
+
$ publicsuffix registrable "COM"
29
+
ERROR: Domain is itself a public suffix
30
+
31
+
$ publicsuffix registrable "example.COM"
32
+
example.com
33
+
34
+
$ publicsuffix registrable "WwW.example.COM"
35
+
example.com
36
+
37
+
Leading Dot Tests
38
+
-----------------
39
+
40
+
$ publicsuffix registrable ".com"
41
+
ERROR: Domain has a leading dot
42
+
43
+
$ publicsuffix registrable ".example"
44
+
ERROR: Domain has a leading dot
45
+
46
+
$ publicsuffix registrable ".example.com"
47
+
ERROR: Domain has a leading dot
48
+
49
+
$ publicsuffix registrable ".example.example"
50
+
ERROR: Domain has a leading dot
51
+
52
+
Unlisted TLD (Implicit * Rule)
53
+
------------------------------
54
+
55
+
Per the algorithm, if no rules match, the implicit * rule applies.
56
+
For an unlisted TLD like "example", the TLD itself is the suffix.
57
+
58
+
$ publicsuffix registrable "example"
59
+
ERROR: Domain is itself a public suffix
60
+
61
+
$ publicsuffix registrable "example.example"
62
+
example.example
63
+
64
+
$ publicsuffix registrable "b.example.example"
65
+
example.example
66
+
67
+
$ publicsuffix registrable "a.b.example.example"
68
+
example.example
69
+
70
+
TLD Listed With No Subdomains (.biz)
71
+
------------------------------------
72
+
73
+
$ publicsuffix registrable "biz"
74
+
ERROR: Domain is itself a public suffix
75
+
76
+
$ publicsuffix registrable "domain.biz"
77
+
domain.biz
78
+
79
+
$ publicsuffix registrable "b.domain.biz"
80
+
domain.biz
81
+
82
+
$ publicsuffix registrable "a.b.domain.biz"
83
+
domain.biz
84
+
85
+
TLD Listed With Subdomains (.com)
86
+
---------------------------------
87
+
88
+
$ publicsuffix registrable "com"
89
+
ERROR: Domain is itself a public suffix
90
+
91
+
$ publicsuffix registrable "example.com"
92
+
example.com
93
+
94
+
$ publicsuffix registrable "b.example.com"
95
+
example.com
96
+
97
+
$ publicsuffix registrable "a.b.example.com"
98
+
example.com
99
+
100
+
Second-Level Domain (.uk.com)
101
+
-----------------------------
102
+
103
+
$ publicsuffix registrable "uk.com"
104
+
ERROR: Domain is itself a public suffix
105
+
106
+
$ publicsuffix registrable "example.uk.com"
107
+
example.uk.com
108
+
109
+
$ publicsuffix registrable "b.example.uk.com"
110
+
example.uk.com
111
+
112
+
$ publicsuffix registrable "a.b.example.uk.com"
113
+
example.uk.com
114
+
115
+
TLD with Single Character (.ac)
116
+
-------------------------------
117
+
118
+
$ publicsuffix registrable "test.ac"
119
+
test.ac
120
+
121
+
Wildcard TLD (.mm has *.mm rule, so c.mm is a suffix)
122
+
-----------------------------------------------------
123
+
124
+
$ publicsuffix registrable "mm"
125
+
ERROR: Domain is itself a public suffix
126
+
127
+
$ publicsuffix registrable "c.mm"
128
+
ERROR: Domain is itself a public suffix
129
+
130
+
$ publicsuffix registrable "b.c.mm"
131
+
b.c.mm
132
+
133
+
$ publicsuffix registrable "a.b.c.mm"
134
+
b.c.mm
135
+
136
+
Japan Tests (.jp)
137
+
-----------------
138
+
139
+
More complex TLD with multiple levels:
140
+
141
+
$ publicsuffix registrable "jp"
142
+
ERROR: Domain is itself a public suffix
143
+
144
+
$ publicsuffix registrable "test.jp"
145
+
test.jp
146
+
147
+
$ publicsuffix registrable "www.test.jp"
148
+
test.jp
149
+
150
+
Second-level suffix under .jp:
151
+
152
+
$ publicsuffix registrable "ac.jp"
153
+
ERROR: Domain is itself a public suffix
154
+
155
+
$ publicsuffix registrable "test.ac.jp"
156
+
test.ac.jp
157
+
158
+
$ publicsuffix registrable "www.test.ac.jp"
159
+
test.ac.jp
160
+
161
+
Kyoto has a rule, so kyoto.jp is a suffix:
162
+
163
+
$ publicsuffix registrable "kyoto.jp"
164
+
ERROR: Domain is itself a public suffix
165
+
166
+
$ publicsuffix registrable "test.kyoto.jp"
167
+
test.kyoto.jp
168
+
169
+
ide.kyoto.jp has *.ide.kyoto.jp rule (wildcard):
170
+
171
+
$ publicsuffix registrable "ide.kyoto.jp"
172
+
ERROR: Domain is itself a public suffix
173
+
174
+
$ publicsuffix registrable "b.ide.kyoto.jp"
175
+
b.ide.kyoto.jp
176
+
177
+
$ publicsuffix registrable "a.b.ide.kyoto.jp"
178
+
b.ide.kyoto.jp
179
+
180
+
Kobe has *.kobe.jp wildcard but !city.kobe.jp exception:
181
+
182
+
$ publicsuffix registrable "c.kobe.jp"
183
+
ERROR: Domain is itself a public suffix
184
+
185
+
$ publicsuffix registrable "b.c.kobe.jp"
186
+
b.c.kobe.jp
187
+
188
+
$ publicsuffix registrable "a.b.c.kobe.jp"
189
+
b.c.kobe.jp
190
+
191
+
Exception rule: city.kobe.jp is registrable despite *.kobe.jp:
192
+
193
+
$ publicsuffix registrable "city.kobe.jp"
194
+
city.kobe.jp
195
+
196
+
$ publicsuffix registrable "www.city.kobe.jp"
197
+
city.kobe.jp
198
+
199
+
Cook Islands Tests (.ck with !www.ck exception)
200
+
-----------------------------------------------
201
+
202
+
.ck has *.ck wildcard rule and !www.ck exception:
203
+
204
+
$ publicsuffix registrable "ck"
205
+
ERROR: Domain is itself a public suffix
206
+
207
+
$ publicsuffix registrable "test.ck"
208
+
ERROR: Domain is itself a public suffix
209
+
210
+
$ publicsuffix registrable "b.test.ck"
211
+
b.test.ck
212
+
213
+
$ publicsuffix registrable "a.b.test.ck"
214
+
b.test.ck
215
+
216
+
Exception: www.ck is registrable:
217
+
218
+
$ publicsuffix registrable "www.ck"
219
+
www.ck
220
+
221
+
$ publicsuffix registrable "www.www.ck"
222
+
www.ck
223
+
224
+
United States Tests (.us)
225
+
-------------------------
226
+
227
+
$ publicsuffix registrable "us"
228
+
ERROR: Domain is itself a public suffix
229
+
230
+
$ publicsuffix registrable "test.us"
231
+
test.us
232
+
233
+
$ publicsuffix registrable "www.test.us"
234
+
test.us
235
+
236
+
State subdivision (.ak.us):
237
+
238
+
$ publicsuffix registrable "ak.us"
239
+
ERROR: Domain is itself a public suffix
240
+
241
+
$ publicsuffix registrable "test.ak.us"
242
+
test.ak.us
243
+
244
+
$ publicsuffix registrable "www.test.ak.us"
245
+
test.ak.us
246
+
247
+
Deep subdivision (.k12.ak.us):
248
+
249
+
$ publicsuffix registrable "k12.ak.us"
250
+
ERROR: Domain is itself a public suffix
251
+
252
+
$ publicsuffix registrable "test.k12.ak.us"
253
+
test.k12.ak.us
254
+
255
+
$ publicsuffix registrable "www.test.k12.ak.us"
256
+
test.k12.ak.us
257
+
258
+
Internationalized Domain Names (IDN) - Chinese
259
+
----------------------------------------------
260
+
261
+
These tests use Chinese characters.
262
+
食狮 = "food lion" in Chinese
263
+
公司 = "company" in Chinese
264
+
265
+
$ publicsuffix registrable "食狮.com.cn"
266
+
xn--85x722f.com.cn
267
+
268
+
$ publicsuffix registrable "食狮.公司.cn"
269
+
xn--85x722f.xn--55qx5d.cn
270
+
271
+
$ publicsuffix registrable "www.食狮.公司.cn"
272
+
xn--85x722f.xn--55qx5d.cn
273
+
274
+
$ publicsuffix registrable "shishi.公司.cn"
275
+
shishi.xn--55qx5d.cn
276
+
277
+
$ publicsuffix registrable "公司.cn"
278
+
ERROR: Domain is itself a public suffix
279
+
280
+
IDN TLD (中国 = China):
281
+
282
+
$ publicsuffix registrable "食狮.中国"
283
+
xn--85x722f.xn--fiqs8s
284
+
285
+
$ publicsuffix registrable "www.食狮.中国"
286
+
xn--85x722f.xn--fiqs8s
287
+
288
+
$ publicsuffix registrable "shishi.中国"
289
+
shishi.xn--fiqs8s
290
+
291
+
$ publicsuffix registrable "中国"
292
+
ERROR: Domain is itself a public suffix
293
+
294
+
Punycode Input (Same as Above in ASCII)
295
+
---------------------------------------
296
+
297
+
$ publicsuffix registrable "xn--85x722f.com.cn"
298
+
xn--85x722f.com.cn
299
+
300
+
$ publicsuffix registrable "xn--85x722f.xn--55qx5d.cn"
301
+
xn--85x722f.xn--55qx5d.cn
302
+
303
+
$ publicsuffix registrable "www.xn--85x722f.xn--55qx5d.cn"
304
+
xn--85x722f.xn--55qx5d.cn
305
+
306
+
$ publicsuffix registrable "shishi.xn--55qx5d.cn"
307
+
shishi.xn--55qx5d.cn
308
+
309
+
$ publicsuffix registrable "xn--55qx5d.cn"
310
+
ERROR: Domain is itself a public suffix
311
+
312
+
$ publicsuffix registrable "xn--85x722f.xn--fiqs8s"
313
+
xn--85x722f.xn--fiqs8s
314
+
315
+
$ publicsuffix registrable "www.xn--85x722f.xn--fiqs8s"
316
+
xn--85x722f.xn--fiqs8s
317
+
318
+
$ publicsuffix registrable "shishi.xn--fiqs8s"
319
+
shishi.xn--fiqs8s
320
+
321
+
$ publicsuffix registrable "xn--fiqs8s"
322
+
ERROR: Domain is itself a public suffix
323
+
324
+
Public Suffix Tests
325
+
-------------------
326
+
327
+
Test the public_suffix function directly:
328
+
329
+
$ publicsuffix suffix "www.example.com"
330
+
com
331
+
332
+
$ publicsuffix suffix "www.example.co.uk"
333
+
co.uk
334
+
335
+
$ publicsuffix suffix "example.com"
336
+
com
337
+
338
+
$ publicsuffix suffix "com"
339
+
com
340
+
341
+
$ publicsuffix suffix "b.ide.kyoto.jp"
342
+
ide.kyoto.jp
343
+
344
+
$ publicsuffix suffix "city.kobe.jp"
345
+
kobe.jp
346
+
347
+
$ publicsuffix suffix "www.ck"
348
+
ck
349
+
350
+
is_public_suffix Tests
351
+
----------------------
352
+
353
+
$ publicsuffix is_suffix "com"
354
+
true
355
+
356
+
$ publicsuffix is_suffix "example.com"
357
+
false
358
+
359
+
$ publicsuffix is_suffix "co.uk"
360
+
true
361
+
362
+
$ publicsuffix is_suffix "example.co.uk"
363
+
false
364
+
365
+
$ publicsuffix is_suffix "test.ck"
366
+
true
367
+
368
+
$ publicsuffix is_suffix "www.ck"
369
+
false
370
+
371
+
$ publicsuffix is_suffix "city.kobe.jp"
372
+
false
373
+
374
+
$ publicsuffix is_suffix "ide.kyoto.jp"
375
+
true
376
+
377
+
is_registrable_domain Tests
378
+
---------------------------
379
+
380
+
$ publicsuffix is_registrable "example.com"
381
+
true
382
+
383
+
$ publicsuffix is_registrable "www.example.com"
384
+
false
385
+
386
+
$ publicsuffix is_registrable "com"
387
+
false
388
+
389
+
$ publicsuffix is_registrable "city.kobe.jp"
390
+
true
391
+
392
+
$ publicsuffix is_registrable "www.city.kobe.jp"
393
+
false
394
+
395
+
Section Information Tests
396
+
-------------------------
397
+
398
+
Test that ICANN vs Private section is correctly reported:
399
+
400
+
$ publicsuffix suffix_section "example.com"
401
+
com (ICANN)
402
+
403
+
$ publicsuffix suffix_section "example.co.uk"
404
+
co.uk (ICANN)
405
+
406
+
Blogspot.com is in the PRIVATE section:
407
+
408
+
$ publicsuffix suffix_section "example.blogspot.com"
409
+
blogspot.com (PRIVATE)
410
+
411
+
$ publicsuffix registrable_section "www.example.blogspot.com"
412
+
example.blogspot.com (PRIVATE)
413
+
414
+
GitHub.io is in the PRIVATE section:
415
+
416
+
$ publicsuffix suffix_section "example.github.io"
417
+
github.io (PRIVATE)
418
+
419
+
$ publicsuffix registrable_section "myproject.github.io"
420
+
myproject.github.io (PRIVATE)
421
+
422
+
Trailing Dot Tests (FQDN)
423
+
-------------------------
424
+
425
+
Per the wiki, trailing dots should be preserved:
426
+
427
+
$ publicsuffix suffix "example.com."
428
+
com.
429
+
430
+
$ publicsuffix suffix "example.com"
431
+
com
432
+
433
+
$ publicsuffix registrable "www.example.com."
434
+
example.com.
435
+
436
+
$ publicsuffix registrable "www.example.com"
437
+
example.com
438
+
439
+
Edge Cases from Wiki Examples
440
+
-----------------------------
441
+
442
+
From the Format.md examples:
443
+
444
+
Rule 1 (com): Cookies MAY be set for foo.com
445
+
446
+
$ publicsuffix registrable "foo.com"
447
+
foo.com
448
+
449
+
Rule 2 (*.foo.com): This isn't in the real PSL, but we test similar patterns
450
+
with *.ck:
451
+
452
+
$ publicsuffix is_suffix "bar.ck"
453
+
true
454
+
455
+
Rule 3 (*.jp): bar.jp is a suffix
456
+
457
+
$ publicsuffix is_suffix "bar.jp"
458
+
false
459
+
460
+
Rule 4: Note that *.hokkaido.jp is not in the actual PSL - only specific
461
+
city subdomains are listed. So bar.hokkaido.jp follows hokkaido.jp rule.
462
+
463
+
$ publicsuffix is_suffix "bar.hokkaido.jp"
464
+
false
465
+
466
+
$ publicsuffix registrable "foo.bar.hokkaido.jp"
467
+
bar.hokkaido.jp
468
+
469
+
$ publicsuffix is_suffix "abashiri.hokkaido.jp"
470
+
true
471
+
472
+
$ publicsuffix registrable "foo.abashiri.hokkaido.jp"
473
+
foo.abashiri.hokkaido.jp
474
+
475
+
Rule 6 (!pref.hokkaido.jp): pref.hokkaido.jp is registrable (exception)
476
+
477
+
$ publicsuffix registrable "pref.hokkaido.jp"
478
+
pref.hokkaido.jp
479
+
480
+
$ publicsuffix is_suffix "pref.hokkaido.jp"
481
+
false
+3
-6
test/dune
+3
-6
test/dune
+72
test/psl_cli/main.ml
+72
test/psl_cli/main.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* psl_cli.ml - Command-line tool for testing the Public Suffix List library
7
+
8
+
Usage:
9
+
psl_cli registrable <domain>
10
+
psl_cli suffix <domain>
11
+
psl_cli is_suffix <domain>
12
+
psl_cli is_registrable <domain>
13
+
14
+
This tool is used by the cram tests to verify correct behavior.
15
+
*)
16
+
17
+
let psl = Publicsuffix.v ()
18
+
let print_error e = Fmt.pr "ERROR: %s\n" (Publicsuffix.error_to_string e)
19
+
let print_result = function Ok s -> print_endline s | Error e -> print_error e
20
+
21
+
let print_bool_result = function
22
+
| Ok b -> print_endline (string_of_bool b)
23
+
| Error e -> print_error e
24
+
25
+
let print_result_with_section = function
26
+
| Ok (s, sec) ->
27
+
let sec_str =
28
+
match sec with
29
+
| Publicsuffix.ICANN -> "ICANN"
30
+
| Publicsuffix.Private -> "PRIVATE"
31
+
in
32
+
Fmt.pr "%s (%s)\n" s sec_str
33
+
| Error e -> print_error e
34
+
35
+
let () =
36
+
if Array.length Sys.argv < 2 then begin
37
+
print_endline "Usage: psl_cli <command> [args...]";
38
+
print_endline "Commands:";
39
+
print_endline " registrable <domain> - Get registrable domain";
40
+
print_endline " suffix <domain> - Get public suffix";
41
+
print_endline
42
+
" is_suffix <domain> - Check if domain is a public suffix";
43
+
print_endline
44
+
" is_registrable <domain> - Check if domain is a registrable domain";
45
+
print_endline
46
+
" registrable_section <domain> - Get registrable domain with section";
47
+
print_endline " suffix_section <domain> - Get public suffix with section";
48
+
print_endline " stats - Print rule statistics";
49
+
exit 1
50
+
end;
51
+
match Sys.argv.(1) with
52
+
| "registrable" when Array.length Sys.argv >= 3 ->
53
+
print_result (Publicsuffix.registrable_domain psl Sys.argv.(2))
54
+
| "suffix" when Array.length Sys.argv >= 3 ->
55
+
print_result (Publicsuffix.public_suffix psl Sys.argv.(2))
56
+
| "is_suffix" when Array.length Sys.argv >= 3 ->
57
+
print_bool_result (Publicsuffix.is_public_suffix psl Sys.argv.(2))
58
+
| "is_registrable" when Array.length Sys.argv >= 3 ->
59
+
print_bool_result (Publicsuffix.is_registrable_domain psl Sys.argv.(2))
60
+
| "registrable_section" when Array.length Sys.argv >= 3 ->
61
+
print_result_with_section
62
+
(Publicsuffix.registrable_domain_with_section psl Sys.argv.(2))
63
+
| "suffix_section" when Array.length Sys.argv >= 3 ->
64
+
print_result_with_section
65
+
(Publicsuffix.public_suffix_with_section psl Sys.argv.(2))
66
+
| "stats" ->
67
+
Fmt.pr "Total rules: %d\n" (Publicsuffix.rule_count psl);
68
+
Fmt.pr "ICANN rules: %d\n" (Publicsuffix.icann_rule_count psl);
69
+
Fmt.pr "Private rules: %d\n" (Publicsuffix.private_rule_count psl)
70
+
| cmd ->
71
+
Fmt.epr "Unknown command or missing arguments: %s\n" cmd;
72
+
exit 1
+279
test/test_publicsuffix.ml
+279
test/test_publicsuffix.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(* Alcotest unit tests for the Publicsuffix library.
7
+
8
+
Test vectors are drawn from the official Mozilla PSL test algorithm:
9
+
https://raw.githubusercontent.com/publicsuffix/list/master/tests/test_psl.txt *)
10
+
11
+
open Alcotest
12
+
13
+
let psl = Publicsuffix.v ()
14
+
15
+
(* ---------- helpers --------------------------------------------------- *)
16
+
17
+
let check_ok msg expected f =
18
+
match f () with
19
+
| Ok v -> check string msg expected v
20
+
| Error e -> fail (Publicsuffix.error_to_string e)
21
+
22
+
let check_ok_bool msg expected f =
23
+
match f () with
24
+
| Ok v -> check bool msg expected v
25
+
| Error e -> fail (Publicsuffix.error_to_string e)
26
+
27
+
let check_err msg expected_err f =
28
+
match f () with
29
+
| Ok v -> failf "%s: expected error, got Ok %S" msg v
30
+
| Error e ->
31
+
check string msg
32
+
(Publicsuffix.error_to_string expected_err)
33
+
(Publicsuffix.error_to_string e)
34
+
35
+
let check_err_bool msg expected_err f =
36
+
match f () with
37
+
| Ok v -> failf "%s: expected error, got Ok %b" msg v
38
+
| Error e ->
39
+
check string msg
40
+
(Publicsuffix.error_to_string expected_err)
41
+
(Publicsuffix.error_to_string e)
42
+
43
+
let check_section msg expected_section f =
44
+
match f () with
45
+
| Ok (_, sec) ->
46
+
check string msg expected_section
47
+
(match sec with Publicsuffix.ICANN -> "ICANN" | Private -> "PRIVATE")
48
+
| Error e -> fail (Publicsuffix.error_to_string e)
49
+
50
+
(* ---------- public_suffix tests --------------------------------------- *)
51
+
52
+
let test_suffix_basic () =
53
+
check_ok "com" "com" (fun () ->
54
+
Publicsuffix.public_suffix psl "www.example.com");
55
+
check_ok "co.uk" "co.uk" (fun () ->
56
+
Publicsuffix.public_suffix psl "www.example.co.uk");
57
+
check_ok "example.com suffix" "com" (fun () ->
58
+
Publicsuffix.public_suffix psl "example.com");
59
+
check_ok "com itself" "com" (fun () -> Publicsuffix.public_suffix psl "com")
60
+
61
+
let test_suffix_wildcard () =
62
+
(* *.mm rule: c.mm is a public suffix *)
63
+
check_ok "ide.kyoto.jp" "ide.kyoto.jp" (fun () ->
64
+
Publicsuffix.public_suffix psl "b.ide.kyoto.jp")
65
+
66
+
let test_suffix_exception () =
67
+
(* *.kobe.jp wildcard but !city.kobe.jp exception *)
68
+
check_ok "city.kobe.jp exception => kobe.jp" "kobe.jp" (fun () ->
69
+
Publicsuffix.public_suffix psl "city.kobe.jp");
70
+
(* *.ck wildcard but !www.ck exception *)
71
+
check_ok "www.ck exception => ck" "ck" (fun () ->
72
+
Publicsuffix.public_suffix psl "www.ck")
73
+
74
+
let test_suffix_trailing_dot () =
75
+
check_ok "trailing dot preserved" "com." (fun () ->
76
+
Publicsuffix.public_suffix psl "example.com.");
77
+
check_ok "no trailing dot" "com" (fun () ->
78
+
Publicsuffix.public_suffix psl "example.com")
79
+
80
+
let test_suffix_errors () =
81
+
check_err "empty domain" Publicsuffix.Empty_domain (fun () ->
82
+
Publicsuffix.public_suffix psl "");
83
+
check_err "leading dot" Publicsuffix.Leading_dot (fun () ->
84
+
Publicsuffix.public_suffix psl ".example.com")
85
+
86
+
(* ---------- registrable_domain tests ---------------------------------- *)
87
+
88
+
let test_reg_icann_basic () =
89
+
check_ok "example.com" "example.com" (fun () ->
90
+
Publicsuffix.registrable_domain psl "example.com");
91
+
check_ok "www.example.com" "example.com" (fun () ->
92
+
Publicsuffix.registrable_domain psl "www.example.com");
93
+
check_ok "b.example.com" "example.com" (fun () ->
94
+
Publicsuffix.registrable_domain psl "b.example.com");
95
+
check_ok "a.b.example.com" "example.com" (fun () ->
96
+
Publicsuffix.registrable_domain psl "a.b.example.com")
97
+
98
+
let test_reg_second_level () =
99
+
(* uk.com is itself a suffix *)
100
+
check_err "uk.com is suffix" Publicsuffix.Domain_is_public_suffix (fun () ->
101
+
Publicsuffix.registrable_domain psl "uk.com");
102
+
check_ok "example.uk.com" "example.uk.com" (fun () ->
103
+
Publicsuffix.registrable_domain psl "example.uk.com");
104
+
check_ok "b.example.uk.com" "example.uk.com" (fun () ->
105
+
Publicsuffix.registrable_domain psl "b.example.uk.com")
106
+
107
+
let test_reg_wildcard () =
108
+
(* *.mm rule *)
109
+
check_err "mm is suffix" Publicsuffix.Domain_is_public_suffix (fun () ->
110
+
Publicsuffix.registrable_domain psl "mm");
111
+
check_err "c.mm is suffix (wildcard)" Publicsuffix.Domain_is_public_suffix
112
+
(fun () -> Publicsuffix.registrable_domain psl "c.mm");
113
+
check_ok "b.c.mm" "b.c.mm" (fun () ->
114
+
Publicsuffix.registrable_domain psl "b.c.mm");
115
+
check_ok "a.b.c.mm" "b.c.mm" (fun () ->
116
+
Publicsuffix.registrable_domain psl "a.b.c.mm")
117
+
118
+
let test_reg_exception () =
119
+
(* *.ck wildcard but !www.ck exception *)
120
+
check_err "test.ck is suffix" Publicsuffix.Domain_is_public_suffix (fun () ->
121
+
Publicsuffix.registrable_domain psl "test.ck");
122
+
check_ok "www.ck (exception)" "www.ck" (fun () ->
123
+
Publicsuffix.registrable_domain psl "www.ck");
124
+
check_ok "foo.www.ck" "www.ck" (fun () ->
125
+
Publicsuffix.registrable_domain psl "www.www.ck");
126
+
(* *.kobe.jp but !city.kobe.jp *)
127
+
check_ok "city.kobe.jp (exception)" "city.kobe.jp" (fun () ->
128
+
Publicsuffix.registrable_domain psl "city.kobe.jp");
129
+
check_ok "www.city.kobe.jp" "city.kobe.jp" (fun () ->
130
+
Publicsuffix.registrable_domain psl "www.city.kobe.jp")
131
+
132
+
let test_reg_com_is_suffix () =
133
+
check_err "com is suffix" Publicsuffix.Domain_is_public_suffix (fun () ->
134
+
Publicsuffix.registrable_domain psl "com")
135
+
136
+
let test_reg_trailing_dot () =
137
+
check_ok "trailing dot preserved" "example.com." (fun () ->
138
+
Publicsuffix.registrable_domain psl "www.example.com.");
139
+
check_ok "no trailing dot" "example.com" (fun () ->
140
+
Publicsuffix.registrable_domain psl "www.example.com")
141
+
142
+
let test_reg_errors () =
143
+
check_err "empty domain" Publicsuffix.Empty_domain (fun () ->
144
+
Publicsuffix.registrable_domain psl "");
145
+
check_err "leading dot" Publicsuffix.Leading_dot (fun () ->
146
+
Publicsuffix.registrable_domain psl ".example.com");
147
+
check_err "domain is suffix" Publicsuffix.Domain_is_public_suffix (fun () ->
148
+
Publicsuffix.registrable_domain psl "com")
149
+
150
+
let test_reg_idn () =
151
+
check_ok "food lion" "xn--85x722f.com.cn" (fun () ->
152
+
Publicsuffix.registrable_domain psl "\xe9\xa3\x9f\xe7\x8b\xae.com.cn");
153
+
check_ok "punycode input" "xn--85x722f.com.cn" (fun () ->
154
+
Publicsuffix.registrable_domain psl "xn--85x722f.com.cn");
155
+
check_ok "food lion with company" "xn--85x722f.xn--55qx5d.cn" (fun () ->
156
+
Publicsuffix.registrable_domain psl
157
+
"\xe9\xa3\x9f\xe7\x8b\xae.\xe5\x85\xac\xe5\x8f\xb8.cn");
158
+
check_ok "www prefix idn" "xn--85x722f.xn--55qx5d.cn" (fun () ->
159
+
Publicsuffix.registrable_domain psl
160
+
"www.\xe9\xa3\x9f\xe7\x8b\xae.\xe5\x85\xac\xe5\x8f\xb8.cn")
161
+
162
+
let test_reg_mixed_case () =
163
+
check_err "COM is suffix" Publicsuffix.Domain_is_public_suffix (fun () ->
164
+
Publicsuffix.registrable_domain psl "COM");
165
+
check_ok "example.COM" "example.com" (fun () ->
166
+
Publicsuffix.registrable_domain psl "example.COM");
167
+
check_ok "WwW.example.COM" "example.com" (fun () ->
168
+
Publicsuffix.registrable_domain psl "WwW.example.COM")
169
+
170
+
(* ---------- is_public_suffix tests ------------------------------------ *)
171
+
172
+
let test_is_suffix () =
173
+
check_ok_bool "com" true (fun () -> Publicsuffix.is_public_suffix psl "com");
174
+
check_ok_bool "example.com" false (fun () ->
175
+
Publicsuffix.is_public_suffix psl "example.com");
176
+
check_ok_bool "co.uk" true (fun () ->
177
+
Publicsuffix.is_public_suffix psl "co.uk");
178
+
check_ok_bool "example.co.uk" false (fun () ->
179
+
Publicsuffix.is_public_suffix psl "example.co.uk");
180
+
(* wildcard: *.ck makes test.ck a suffix *)
181
+
check_ok_bool "test.ck (wildcard)" true (fun () ->
182
+
Publicsuffix.is_public_suffix psl "test.ck");
183
+
(* exception: !www.ck means www.ck is NOT a suffix *)
184
+
check_ok_bool "www.ck (exception)" false (fun () ->
185
+
Publicsuffix.is_public_suffix psl "www.ck");
186
+
check_ok_bool "ide.kyoto.jp" true (fun () ->
187
+
Publicsuffix.is_public_suffix psl "ide.kyoto.jp")
188
+
189
+
let test_is_suffix_errors () =
190
+
check_err_bool "empty domain" Publicsuffix.Empty_domain (fun () ->
191
+
Publicsuffix.is_public_suffix psl "");
192
+
check_err_bool "leading dot" Publicsuffix.Leading_dot (fun () ->
193
+
Publicsuffix.is_public_suffix psl ".com")
194
+
195
+
(* ---------- is_registrable_domain tests ------------------------------- *)
196
+
197
+
let test_is_registrable () =
198
+
check_ok_bool "example.com" true (fun () ->
199
+
Publicsuffix.is_registrable_domain psl "example.com");
200
+
check_ok_bool "www.example.com" false (fun () ->
201
+
Publicsuffix.is_registrable_domain psl "www.example.com");
202
+
check_ok_bool "com" false (fun () ->
203
+
Publicsuffix.is_registrable_domain psl "com");
204
+
check_ok_bool "city.kobe.jp (exception)" true (fun () ->
205
+
Publicsuffix.is_registrable_domain psl "city.kobe.jp");
206
+
check_ok_bool "www.city.kobe.jp" false (fun () ->
207
+
Publicsuffix.is_registrable_domain psl "www.city.kobe.jp")
208
+
209
+
(* ---------- section classification tests ------------------------------ *)
210
+
211
+
let test_section_suffix () =
212
+
check_section "com is ICANN" "ICANN" (fun () ->
213
+
Publicsuffix.public_suffix_with_section psl "example.com");
214
+
check_section "co.uk is ICANN" "ICANN" (fun () ->
215
+
Publicsuffix.public_suffix_with_section psl "example.co.uk");
216
+
check_section "blogspot.com is PRIVATE" "PRIVATE" (fun () ->
217
+
Publicsuffix.public_suffix_with_section psl "example.blogspot.com");
218
+
check_section "github.io is PRIVATE" "PRIVATE" (fun () ->
219
+
Publicsuffix.public_suffix_with_section psl "example.github.io")
220
+
221
+
let test_section_registrable () =
222
+
check_section "registrable ICANN" "ICANN" (fun () ->
223
+
Publicsuffix.registrable_domain_with_section psl "www.example.com");
224
+
check_section "registrable blogspot PRIVATE" "PRIVATE" (fun () ->
225
+
Publicsuffix.registrable_domain_with_section psl
226
+
"www.example.blogspot.com");
227
+
check_section "registrable github PRIVATE" "PRIVATE" (fun () ->
228
+
Publicsuffix.registrable_domain_with_section psl "myproject.github.io")
229
+
230
+
(* ---------- rule count tests ------------------------------------------ *)
231
+
232
+
let test_rule_counts () =
233
+
let total = Publicsuffix.rule_count psl in
234
+
let icann = Publicsuffix.icann_rule_count psl in
235
+
let priv = Publicsuffix.private_rule_count psl in
236
+
check bool "total > 0" true (total > 0);
237
+
check bool "icann > 0" true (icann > 0);
238
+
check bool "private > 0" true (priv > 0);
239
+
check bool "icann + private = total" true (icann + priv = total);
240
+
(* Sanity: the real PSL has thousands of rules *)
241
+
check bool "total > 1000" true (total > 1000)
242
+
243
+
(* ---------- version / commit ------------------------------------------ *)
244
+
245
+
let test_version_info () =
246
+
let v = Publicsuffix.version psl in
247
+
let c = Publicsuffix.commit psl in
248
+
check bool "version non-empty" true (String.length v > 0);
249
+
check bool "commit non-empty" true (String.length c > 0)
250
+
251
+
(* ---------- suite export ---------------------------------------------- *)
252
+
253
+
let suite =
254
+
( "publicsuffix",
255
+
[
256
+
test_case "suffix basic lookups" `Quick test_suffix_basic;
257
+
test_case "suffix wildcard rules" `Quick test_suffix_wildcard;
258
+
test_case "suffix exception rules" `Quick test_suffix_exception;
259
+
test_case "suffix trailing dot" `Quick test_suffix_trailing_dot;
260
+
test_case "suffix error cases" `Quick test_suffix_errors;
261
+
test_case "registrable ICANN basic" `Quick test_reg_icann_basic;
262
+
test_case "registrable second-level suffix" `Quick test_reg_second_level;
263
+
test_case "registrable wildcard rules" `Quick test_reg_wildcard;
264
+
test_case "registrable exception rules" `Quick test_reg_exception;
265
+
test_case "registrable com is suffix" `Quick test_reg_com_is_suffix;
266
+
test_case "registrable trailing dot" `Quick test_reg_trailing_dot;
267
+
test_case "registrable error cases" `Quick test_reg_errors;
268
+
test_case "registrable IDN / punycode" `Quick test_reg_idn;
269
+
test_case "registrable mixed case" `Quick test_reg_mixed_case;
270
+
test_case "is_suffix basic checks" `Quick test_is_suffix;
271
+
test_case "is_suffix error cases" `Quick test_is_suffix_errors;
272
+
test_case "is_registrable basic checks" `Quick test_is_registrable;
273
+
test_case "section suffix" `Quick test_section_suffix;
274
+
test_case "section registrable" `Quick test_section_registrable;
275
+
test_case "stats rule counts" `Quick test_rule_counts;
276
+
test_case "stats version info" `Quick test_version_info;
277
+
] )
278
+
279
+
let () = run "Publicsuffix" [ suite ]