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
open Netencoding
open Ldap_ooclient
open Ldif_parser
let safe_string_regex =
Str.regexp "^[\x01-\x09\x0b-\x0c\x0e-\x7f]+$"
let password_regex =
Str.regexp_case_fold ".*p\\(ass\\)?w\\(or\\)?d$"
let empty_regex =
Str.regexp "^ *$\\|^ *.*$"
let safe_val buf s =
if
(Str.string_match safe_string_regex s 0) &&
(not (Str.string_match empty_regex s 0))
then begin
Buffer.add_string buf ": ";
Buffer.add_string buf s
end
else begin
Buffer.add_string buf ":: ";
Buffer.add_string buf (Base64.encode s)
end
let safe_attr_val buf a v =
if Str.string_match password_regex a 0 then begin
Buffer.add_string buf a;
Buffer.add_string buf ":: ";
Buffer.add_string buf (Base64.encode v)
end
else begin
Buffer.add_string buf a;
safe_val buf v
end
let entry2ldif ?(ext=false) outbuf e =
Buffer.add_string outbuf "dn";
safe_val outbuf e#dn;
if ext then Buffer.add_string outbuf "\nchangetype: add";
Buffer.add_char outbuf '\n';
(List.iter
(fun attr ->
(List.iter
(fun value ->
safe_attr_val outbuf attr value;
Buffer.add_char outbuf '\n')
(e#get_value attr)))
e#attributes);
Buffer.add_char outbuf '\n';
outbuf
let iter (f: ('a -> unit)) ldif =
try
while true
do
f ldif#read_entry
done
with End -> ()
let fold f ldif v =
let objects =
let objects = ref [] in
try
while true
do
objects := (ldif#read_entry) :: !objects
done;
!objects
with End -> !objects
in
List.fold_left f v objects
class ldif ?(in_ch=stdin) ?(out_ch=stdout) () =
object (_self)
val in_ch = {stream=(Stream.of_channel in_ch);buf=Buffer.create 256;line=1}
val out_ch = out_ch
val outbuf = Buffer.create 50
method read_entry = Ldap_ooclient.to_entry (`Entry (ldif_attrval_record in_ch))
method of_string s =
let strm = {stream=(Stream.of_string s);buf=Buffer.create 256;line=1} in
Ldap_ooclient.to_entry (`Entry (ldif_attrval_record strm))
method to_string (e:ldapentry_t) =
try
let contents = Buffer.contents (entry2ldif outbuf e) in
Buffer.clear outbuf;
contents
with exn ->
Buffer.clear outbuf;
raise exn
method write_entry (e:ldapentry_t) =
try
Buffer.output_buffer out_ch (entry2ldif outbuf e);
Buffer.clear outbuf
with exn ->
Buffer.clear outbuf;
raise exn
end
let read_ldif_file file =
let fd = open_in file in
try
let ldif = new ldif ~in_ch:fd () in
let entries = fold (fun l e -> e :: l) ldif [] in
close_in fd;
entries
with exn -> close_in fd;raise exn
let write_ldif_file file entries =
let fd = open_out file in
try
let ldif = new ldif ~out_ch:fd () in
List.iter ldif#write_entry entries;
close_out fd
with exn -> close_out fd;raise exn