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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331 | ------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library is distributed in the hope that it will be --
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Provides an API to add, read, modify and delete information from a LDAP
-- server. It is a thick binding, see AWS.LDAP.Thin for a thin binding.
--
-- This API has been tested on Windows and Linux (OpenLDAP).
with Ada.Containers.Indefinite_Vectors;
with Ada.Exceptions;
with Ada.Strings.Unbounded;
with AWS.LDAP.Thin;
package AWS.LDAP.Client is
use Ada.Exceptions;
use Ada.Strings.Unbounded;
LDAP_Error : exception renames LDAP.LDAP_Error;
Default_Port : constant Positive := Positive (Thin.LDAP_PORT);
subtype Directory is Thin.LDAP_Type;
-- An LDAP directory. This object must be initialized with Init and Bind
-- and terminated with Unbind.
subtype LDAP_Message is Thin.LDAPMessage;
-- An LDAP message or set of messages. There is a set of iterators to
-- access all messages returned by the search procedure.
subtype BER_Element is Thin.BerElement;
-- An iterator structure. Initialized and used to iterate through all the
-- attributes for a specific message.
Null_Directory : constant Directory := Thin.Null_LDAP_Type;
Null_LDAP_Message : constant LDAP_Message := Thin.Null_LDAPMessage;
type Scope_Type is
(LDAP_Scope_Default, LDAP_Scope_Base,
LDAP_Scope_One_Level, LDAP_Scope_Subtree);
-- LDAP scope for the search
type String_Set is array (Positive range <>) of Unbounded_String;
-- A set of strings, this is used to map C array of strings (a char **)
-- from the thin binding.
Null_Set : constant String_Set;
function Get_Error (E : Exception_Occurrence) return Thin.Return_Code;
-- Returns the error code in the LDAP_Error exception occurence E. Returns
-- Think.LDAP_SUCCESS if no error code has been found.
----------------
-- Attributes --
----------------
subtype Attribute_Set is String_Set;
-- Used to represent the set of attributes to retrieve from the LDAP server
function Attributes
(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10 : String := "")
return Attribute_Set;
-- Returns a String_Set object containing only none empty values. Values
-- for S1 through S10 must be set in the order of the parameters. This is
-- an helper routine to help building an array of unbounded string from a
-- set of string.
function uid (Val : String := "") return String;
-- Returns the uid attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function givenName (Val : String := "") return String;
-- Returns the given name (firstname) attribute. if Val is specified
-- "=<Val>" is added after the attribute name.
function cn (Val : String := "") return String;
function commonName (Val : String := "") return String renames cn;
-- Returns the common Name attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function sn (Val : String := "") return String;
function surname (Val : String := "") return String renames sn;
-- Returns the surname attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function telephoneNumber (Val : String := "") return String;
-- Returns the phone number. if Val is specified "=<Val>" is
-- added after the attribute name. Val must use the international notation
-- according to CCITT E.123.
function mail (Val : String := "") return String;
-- Returns the mail attribute. if Val is specified "=<Val>" is added after
-- the attribute name.
function l (Val : String := "") return String;
function localityName (Val : String := "") return String renames l;
-- Returns the locality attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function o (Val : String := "") return String;
function organizationName (Val : String := "") return String renames o;
-- Returns the organization attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function ou (Val : String := "") return String;
function organizationalUnitName (Val : String := "") return String
renames ou;
-- Returns the organizational unit attribute, if Val is specified "=<Val>"
-- is added after the attribute name.
function st (Val : String := "") return String;
function stateOrProvinceName (Val : String := "") return String
renames st;
-- Returns the state name attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function c (Val : String := "") return String;
function countryName (Val : String) return String renames c;
-- Returns country code attribute, if Val is specified "=<Val>" is
-- added after the attribute name. Val must be a two-letter ISO 3166
-- country code.
function dc (Val : String := "") return String;
function domainComponent (Val : String := "") return String renames dc;
-- Returns a domain component attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function Cat
(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10 : String := "") return String;
-- Returns a string object containing only none empty values. Values for
-- S1 through S10 must be set in the order of the parameters. All values
-- are catenated and separated with a coma. This is an helper routine to
-- help building a filter objects or base distinguished name.
----------------
-- Initialize --
----------------
function Init
(Host : String;
Port : Positive := Default_Port) return Directory;
-- Must be called first, to initialize the LDAP communication with the
-- server. Returns Null_Directory in case of error.
procedure Bind
(Dir : Directory;
Login : String;
Password : String);
-- Bind to the server by providing a login and password
procedure Unbind (Dir : in out Directory);
-- Must be called to release resources associated with the Directory. Does
-- nothing if Dir is Null_Directory.
function Is_Open (Dir : Directory) return Boolean;
-- Returns True if the directory has correctly been initialized and binded
-- with the server.
------------
-- Search --
------------
function Search
(Dir : Directory;
Base : String;
Filter : String;
Scope : Scope_Type := LDAP_Scope_Default;
Attrs : Attribute_Set := Null_Set;
Attrs_Only : Boolean := False) return LDAP_Message;
-- Do a search on the LDAP server. Base is the name of the database.
-- Filter can be used to retrieve a specific set of entries. Attrs specify
-- the set of attributes to retrieve. If Attrs_Only is set to True only
-- the types are returned. Raises LDAP_Error in case of problem.
-----------------------
-- Add/Modify/Delete --
-----------------------
type Mod_Type is (LDAP_Mod_Add, LDAP_Mod_Replace, LDAP_Mod_BValues);
-- Modification types: Add, Replace and BER flag
type Mod_Element (Values_Size : Natural) is record
Mod_Op : Mod_Type;
Mod_Type : Unbounded_String;
Mod_Values : Attribute_Set (1 .. Values_Size);
end record;
-- Holds modification elements. 'Abstraction' of the LDAPMod_Element type
-- used in the thin-binding. Mod_Values is static to make it less complex.
package LDAP_Mods is
new Ada.Containers.Indefinite_Vectors (Positive, Mod_Element);
-- Vector-based Storage for all modification elements. Will be
-- mapped to C LDAPMod **.
procedure Add
(Dir : Directory;
DN : String;
Mods : LDAP_Mods.Vector);
-- Add an entry specified by 'DN' to the LDAP server. The Mods-Vector
-- contains the attributes for the entry.
procedure Modify
(Dir : Directory;
DN : String;
Mods : LDAP_Mods.Vector);
-- Modify an attribute of entry specified by 'DN'. The Mods-Vector
-- contains the attributes to add/replace/delete for the entry.
procedure Delete (Dir : Directory; DN : String);
-- Delete an entry specified by 'DN' from the LDAP server
---------------
-- Iterators --
---------------
function First_Entry
(Dir : Directory;
Chain : LDAP_Message) return LDAP_Message;
-- Returns the first entry (or Node) for the search result (Chain)
function Next_Entry
(Dir : Directory;
Entries : LDAP_Message) return LDAP_Message;
-- Returns next entry (or Node) for Entries
function Count_Entries
(Dir : Directory;
Chain : LDAP_Message) return Natural;
-- Returns the number of entries in the search result (Chain)
procedure Free (Chain : LDAP_Message);
-- Release memory associated with the search result Chain
generic
with procedure Action
(Node : LDAP_Message;
Quit : in out Boolean);
procedure For_Every_Entry (Dir : Directory; Chain : LDAP_Message);
-- This iterator call Action for each entry (Node) found in the LDAP result
-- set as returned by the search procedure. Quit can be set to True to
-- stop iteration; its initial value is False.
function First_Attribute
(Dir : Directory;
Node : LDAP_Message;
BER : not null access BER_Element) return String;
-- Returns the first attribute for the entry. It initialize an iteraror
-- (the BER structure). The BER structure must be released after used by
-- using the Free routine below.
function Next_Attribute
(Dir : Directory;
Node : LDAP_Message;
BER : BER_Element) return String;
-- Returns next attribute for iterator BER. First_Attribute must have been
-- called to initialize this iterator.
procedure Free (BER : BER_Element);
-- Releases memory associated with the BER structure which has been
-- allocated by the First_Attribute routine.
generic
with procedure Action
(Attribute : String;
Quit : in out Boolean);
procedure For_Every_Attribute
(Dir : Directory;
Node : LDAP_Message);
-- This iterator call action for each attribute found in the LDAP Entries
-- Node as returned by First_Entry or Next_Entry. Quit can be set to True
-- to stop iteration; its initial value is False.
---------------
-- Accessors --
---------------
function Get_DN
(Dir : Directory;
Node : LDAP_Message) return String;
-- Returns the distinguished name for the given entry Node
function DN2UFN (DN : String) return String;
-- Returns a distinguished name converted to a user-friendly format
function Get_Values
(Dir : Directory;
Node : LDAP_Message;
Target : String) return String_Set;
-- Returns the list of values of a given attribute (Target) found in entry
-- Node.
function Explode_DN
(DN : String;
No_Types : Boolean := True) return String_Set;
-- Breaks up an entry name into its component parts. If No_Types is set to
-- True the types information ("cn=") won't be included.
private
Null_Set : constant String_Set (1 .. 0) :=
(1 .. 0 => Null_Unbounded_String);
end AWS.LDAP.Client;
|