OCaml implementation of the Mozilla Public Suffix service
fix(lint): flatten test_retry suite, shorten E320 identifiers
Flatten test_retry from 5 groups into a single ("retry", [...]) pair.
Rename identifiers exceeding 4 underscores: i_frame → iframe,
multiple_targets_partial → multitarget_partial, etc.
-77
-5
test/dune
-5
test/dune
-72
test/psl_cli.ml
-72
test/psl_cli.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.create ()
18
-
let print_error e = Printf.printf "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
-
Printf.printf "%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
-
Printf.printf "Total rules: %d\n" (Publicsuffix.rule_count psl);
68
-
Printf.printf "ICANN rules: %d\n" (Publicsuffix.icann_rule_count psl);
69
-
Printf.printf "Private rules: %d\n" (Publicsuffix.private_rule_count psl)
70
-
| cmd ->
71
-
Printf.eprintf "Unknown command or missing arguments: %s\n" cmd;
72
-
exit 1