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
open Ldap_types
open Ldap_dnparser
open Ldap_dnlexer
open Printf
exception Invalid_dn of int * string
let of_string dn_string =
let lexbuf = Lexing.from_string dn_string in
try Ldap_dnparser.dn lexdn lexbuf
with
Parsing.Parse_error -> raise (Invalid_dn (lexbuf.Lexing.lex_curr_pos, "parse error"))
| Failure msg -> raise (Invalid_dn (lexbuf.Lexing.lex_curr_pos, msg))
let hexpair_of_char c =
let hexify i =
match i with
0 -> '0'
| 1 -> '1'
| 2 -> '2'
| 3 -> '3'
| 4 -> '4'
| 5 -> '5'
| 6 -> '6'
| 7 -> '7'
| 8 -> '8'
| 9 -> '9'
| 10 -> 'a'
| 11 -> 'b'
| 12 -> 'c'
| 13 -> 'd'
| 14 -> 'e'
| 15 -> 'f'
| n -> raise (Invalid_argument ("invalid hex digit: " ^ (string_of_int n)))
in
let i = int_of_char c in
let buf = Bytes.create 2 in
Bytes.set buf 0 (hexify (i lsr 4));
Bytes.set buf 1 (hexify (i land 0b0000_1111));
Bytes.to_string buf
let escape_value valu =
let strm = Stream.of_string valu in
let buf = Buffer.create ((String.length valu) + 10) in
let rec escape strm buf =
try
match Stream.next strm with
(',' | '=' | '+' | '<' | '>' | '#' | ';' | '\\' | '"') as c ->
Buffer.add_char buf '\\';
Buffer.add_char buf c;
escape strm buf
| ' ' ->
if Stream.peek strm = None then begin
Buffer.add_string buf "\\ ";
escape strm buf
end
else begin
Buffer.add_char buf ' ';
escape strm buf
end
| c ->
if (int_of_char c) < (int_of_char ' ') ||
(int_of_char c) > (int_of_char '~')
then begin
Buffer.add_string buf ("\\" ^ (hexpair_of_char c));
escape strm buf
end
else begin
Buffer.add_char buf c;escape strm buf
end
with Stream.Failure -> Buffer.contents buf
in
match Stream.peek strm with
Some ' ' ->
Buffer.add_string buf "\\ ";
Stream.junk strm;
escape strm buf
| Some c -> escape strm buf
| None -> ""
let to_string dn =
let dn_to_strcomponents dn =
List.map
(fun {attr_type=attr;attr_vals=vals} ->
let rec string_values s attr vals =
match vals with
valu :: [] -> sprintf "%s%s=%s" s attr (escape_value valu)
| valu :: tl ->
string_values
(sprintf "%s%s=%s+"
s attr (escape_value valu))
attr tl
| [] -> s
in
if List.length vals = 0 then
raise
(Invalid_dn
(0, "invalid dn structure. no attribute " ^
"value specified for attribute: " ^ attr))
else
string_values "" attr vals)
dn
in
let rec components_to_dn s comps =
match comps with
comp :: [] -> sprintf "%s%s" s comp
| comp :: tl -> components_to_dn (sprintf "%s%s," s comp) tl
| [] -> s
in
components_to_dn "" (dn_to_strcomponents dn)
let canonical_dn dn = String.lowercase (to_string (of_string dn))