annotate src/eldap.c @ 276:6330739388db r21-0b36

Import from CVS: tag r21-0b36
author cvs
date Mon, 13 Aug 2007 10:30:37 +0200
parents c5d627a313b1
children 90d73dddcdc4
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
1 /* LDAP client interface for XEmacs.
265
8efd647ea9ca Import from CVS: tag r20-5b31
cvs
parents: 261
diff changeset
2 Copyright (C) 1998 Free Software Foundation, Inc.
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
3
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
4 This file is part of XEmacs.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
5
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
9 later version.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
10
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
14 for more details.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
15
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
20
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
21 /* Synched up with: Not in FSF. */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
22
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
23 /* Author: Oscar Figueiredo */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
24
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
25 /* This file provides lisp primitives for access to an LDAP library
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
26 conforming to the API defined in RFC 1823.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
27 It has been tested with:
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
28 - UMich LDAP 3.3 (http://www.umich.edu/~dirsvcs/ldap/)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
29 - Netscape's LDAP SDK 1.0 (http://developer.netscape.com) */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
30
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
31
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
32 #include <config.h>
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
33 #include "lisp.h"
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
34
265
8efd647ea9ca Import from CVS: tag r20-5b31
cvs
parents: 261
diff changeset
35 #include <errno.h>
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
36 #include <lber.h>
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
37 #include <ldap.h>
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
38
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
39 #include "eldap.h"
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
40
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
41 #ifdef HAVE_NS_LDAP
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
42 #define HAVE_LDAP_SET_OPTION 1
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
43 #define HAVE_LDAP_GET_ERRNO 1
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
44 #else
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
45 #undef HAVE_LDAP_SET_OPTION
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
46 #undef HAVE_LDAP_GET_ERRNO
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
47 #endif
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
48
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
49
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
50
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
51 static int ldap_default_port;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
52 static Lisp_Object Vldap_default_base;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
53
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
54 /* ldap-open plist keywords */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
55 static Lisp_Object Qport, Qauth, Qbinddn, Qpasswd, Qderef, Qtimelimit,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
56 Qsizelimit;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
57 /* Search scope limits */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
58 static Lisp_Object Qbase, Qonelevel, Qsubtree;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
59 /* Authentication methods */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
60 #ifdef LDAP_AUTH_KRBV41
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
61 static Lisp_Object Qkrbv41;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
62 #endif
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
63 #ifdef LDAP_AUTH_KRBV42
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
64 static Lisp_Object Qkrbv42;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
65 #endif
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
66 /* Deref policy */
261
405dd6d1825b Import from CVS: tag r20-5b29
cvs
parents: 259
diff changeset
67 static Lisp_Object Qnever, Qalways, Qfind;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
68
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
69 static Lisp_Object Qldapp;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
70
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
71
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
72 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
73 /* Utility Functions */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
74 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
75
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
76 static void
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
77 signal_ldap_error (LDAP *ld)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
78 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
79 #if HAVE_LDAP_GET_ERRNO
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
80 signal_simple_error
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
81 ("LDAP error",
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
82 build_string (ldap_err2string (ldap_get_lderrno (ld, NULL, NULL))));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
83 #else
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
84 signal_simple_error ("LDAP error",
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
85 build_string (ldap_err2string (ld->ld_errno)));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
86 #endif
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
87 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
88
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
89
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
90 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
91 /* The ldap Lisp object */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
92 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
93
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
94 /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
95 * Structure records pertinent information about an open LDAP connection.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
96 */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
97
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
98 struct Lisp_LDAP
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
99 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
100 /* lcrecord header */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
101 struct lcrecord_header header;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
102 /* The LDAP connection handle used by the LDAP API */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
103 LDAP *ld;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
104 /* Name of the host we connected to */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
105 Lisp_Object host;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
106 /* Status of the LDAP connection.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
107 This is a symbol: open or closed */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
108 Lisp_Object status_symbol;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
109 };
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
110
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
111
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
112
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
113 static Lisp_Object
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
114 mark_ldap (Lisp_Object obj, void (*markobj) (Lisp_Object))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
115 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
116 struct Lisp_LDAP *ldap = XLDAP (obj);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
117 ((markobj) (ldap->host));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
118 return ldap->status_symbol;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
119 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
120
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
121 static void
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
122 print_ldap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
123 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
124 char buf[16];
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
125
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
126 struct Lisp_LDAP *ldap = XLDAP (obj);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
127
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
128 if (print_readably)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
129 error ("printing unreadable object #<ldap %s>",
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
130 XSTRING_DATA (ldap->host));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
131
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
132 if (!escapeflag)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
133 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
134 print_internal (ldap->host, printcharfun, 0);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
135 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
136 else
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
137 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
138 write_c_string (GETTEXT ("#<ldap "), printcharfun);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
139 print_internal (ldap->host, printcharfun, 1);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
140 write_c_string (" state:",printcharfun);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
141 print_internal (ldap->status_symbol, printcharfun, 1);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
142 sprintf (buf, " 0x%x>", ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
143 write_c_string (buf, printcharfun);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
144 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
145 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
146
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
147 static struct Lisp_LDAP *
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
148 allocate_ldap (void)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
149 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
150 struct Lisp_LDAP *ldap =
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
151 alloc_lcrecord_type (struct Lisp_LDAP, lrecord_ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
152
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
153 ldap->ld = (LDAP *) NULL;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
154 ldap->host = Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
155 ldap->status_symbol = Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
156 return ldap;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
157 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
158
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
159 DEFINE_LRECORD_IMPLEMENTATION ("ldap", ldap,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
160 mark_ldap, print_ldap, NULL,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
161 NULL, NULL, struct Lisp_LDAP);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
162
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
163
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
164
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
165
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
166 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
167 /* Basic ldap accessors */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
168 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
169
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
170 DEFUN ("ldapp", Fldapp, 1, 1, 0, /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
171 Return t if OBJECT is a LDAP connection.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
172 */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
173 (object))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
174 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
175 return LDAPP (object) ? Qt : Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
176 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
177
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
178
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
179 DEFUN ("ldap-host", Fldap_host, 1, 1, 0, /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
180 Return the server host of the connection LDAP, as a string.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
181 */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
182 (ldap))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
183 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
184 CHECK_LDAP (ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
185 return (XLDAP (ldap))->host;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
186 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
187
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
188
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
189
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
190 DEFUN ("ldap-status", Fldap_status, 1, 1, 0, /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
191 Return the status of the connection LDAP.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
192 This is a symbol, one of these:
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
193
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
194 open -- for a LDAP connection that is open.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
195 closed -- for a LDAP connection that is closed.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
196 */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
197 (ldap))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
198 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
199 CHECK_LDAP (ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
200 return (XLDAP (ldap))->status_symbol;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
201 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
202
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
203
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
204
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
205 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
206 /* Opening/Closing a LDAP connection */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
207 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
208
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
209
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
210 DEFUN ("ldap-open", Fldap_open, 1, 2, 0, /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
211 Open a LDAP connection to HOST.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
212 PLIST is a plist containing additional parameters for the connection.
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
213 Valid keys in that list are:
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
214 `port' the TCP port to use for the connection if different from
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
215 `ldap-default-port'.
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
216 `auth' is the authentication method to use, possible values depend on
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
217 the LDAP library XEmacs was compiled with: `simple', `krbv41' and `krbv42'.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
218 `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax).
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
219 `passwd' is the password to use for simple authentication.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
220 `deref' is one of the symbols `never', `always', `search' or `find'.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
221 `timelimit' is the timeout limit for the connection in seconds.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
222 `sizelimit' is the maximum number of matches to return.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
223 */
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
224 (host, plist))
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
225 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
226 /* This function can call lisp */
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
227
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
228 struct Lisp_LDAP *lisp_ldap;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
229 LDAP *ld;
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
230 int ldap_port = 0;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
231 int ldap_auth = LDAP_AUTH_SIMPLE;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
232 char *ldap_binddn = NULL;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
233 char *ldap_passwd = NULL;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
234 int ldap_deref = LDAP_DEREF_NEVER;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
235 int ldap_timelimit = 0;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
236 int ldap_sizelimit = 0;
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
237 int err;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
238
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
239 Lisp_Object ldap, list, keyword, value;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
240 struct gcpro gcpro1;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
241
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
242 ldap = Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
243 GCPRO1 (ldap);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
244
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
245 CHECK_STRING (host);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
246
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
247 EXTERNAL_PROPERTY_LIST_LOOP(list, keyword, value, plist)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
248 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
249 /* TCP Port */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
250 if (EQ (keyword, Qport))
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
251 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
252 CHECK_INT (value);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
253 ldap_port = XINT (value);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
254 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
255 /* Authentication method */
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
256 if (EQ (keyword, Qauth))
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
257 {
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
258 CHECK_SYMBOL (value);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
260 if (EQ (value, Qsimple))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
261 ldap_auth = LDAP_AUTH_SIMPLE;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
262 #ifdef LDAP_AUTH_KRBV41
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
263 else if (EQ (value, Qkrbv41))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
264 ldap_auth = LDAP_AUTH_KRBV41;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
265 #endif
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
266 #ifdef LDAP_AUTH_KRBV42
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
267 else if (EQ (value, Qkrbv42))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
268 ldap_auth = LDAP_AUTH_KRBV42;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
269 #endif
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
270 else
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
271 signal_simple_error ("Invalid authentication method", value);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
272 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
273 /* Bind DN */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
274 else if (EQ (keyword, Qbinddn))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
275 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
276 CHECK_STRING (value);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
277 ldap_binddn = alloca (XSTRING_LENGTH (value) + 1);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
278 strcpy (ldap_binddn, (char *)XSTRING_DATA (value));
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
279 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
280 /* Password */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
281 else if (EQ (keyword, Qpasswd))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
282 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
283 CHECK_STRING (value);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
284 ldap_passwd = alloca (XSTRING_LENGTH (value) + 1);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
285 strcpy (ldap_passwd, (char *)XSTRING_DATA (value));
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
286 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
287 /* Deref */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
288 else if (EQ (keyword, Qderef))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
289 {
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
290 CHECK_SYMBOL (value);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
291 if (EQ (value, Qnever))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
292 ldap_deref = LDAP_DEREF_NEVER;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
293 else if (EQ (value, Qsearch))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
294 ldap_deref = LDAP_DEREF_SEARCHING;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
295 else if (EQ (value, Qfind))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
296 ldap_deref = LDAP_DEREF_FINDING;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
297 else if (EQ (value, Qalways))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
298 ldap_deref = LDAP_DEREF_ALWAYS;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
299 else
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
300 signal_simple_error ("Invalid deref value", value);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
301 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
302 /* Timelimit */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
303 else if (EQ (keyword, Qtimelimit))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
304 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
305 CHECK_INT (value);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
306 ldap_timelimit = XINT (value);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
307 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
308 /* Sizelimit */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
309 else if (EQ (keyword, Qsizelimit))
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
310 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
311 CHECK_INT (value);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
312 ldap_sizelimit = XINT (value);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
313 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
314 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
315
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
316 if (ldap_port == 0)
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
317 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
318 ldap_port = ldap_default_port;
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
319 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
320
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
321 /* Connect to the server and bind */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
322 ld = ldap_open ((char *)XSTRING_DATA (host), ldap_port);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
323 if (ld == NULL )
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
324 signal_simple_error_2 ("Failed connecting to host",
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
325 host,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
326 lisp_strerror (errno));
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
327
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
328
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
329 #if HAVE_LDAP_SET_OPTION
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
330 if (ldap_set_option (ld, LDAP_OPT_DEREF, (void *)&ldap_deref) != LDAP_SUCCESS)
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
331 signal_ldap_error (ld);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
332 if (ldap_set_option (ld, LDAP_OPT_TIMELIMIT,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
333 (void *)&ldap_timelimit) != LDAP_SUCCESS)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
334 signal_ldap_error (ld);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
335 if (ldap_set_option (ld, LDAP_OPT_SIZELIMIT,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
336 (void *)&ldap_sizelimit) != LDAP_SUCCESS)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
337 signal_ldap_error (ld);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
338 if (ldap_set_option (ld, LDAP_OPT_REFERRALS, LDAP_OPT_ON) != LDAP_SUCCESS)
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
339 signal_ldap_error (ld);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
340 #else /* HAVE_LDAP_SET_OPTION */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
341 ld->ld_deref = ldap_deref;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
342 ld->ld_timelimit = ldap_timelimit;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
343 ld->ld_sizelimit = ldap_sizelimit;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
344 #ifdef LDAP_REFERRALS
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
345 ld->ld_options = LDAP_OPT_REFERRALS;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
346 #else /* LDAP_REFERRALS */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
347 ld->ld_options = 0;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
348 #endif /* LDAP_REFERRALS */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
349 #endif /* HAVE_LDAP_SET_OPTION */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
350
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
351 /* ldap_bind_s calls select and may be wedged by spurious signals */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
352 slow_down_interrupts ();
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
353 err = ldap_bind_s (ld, ldap_binddn, ldap_passwd, ldap_auth);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
354 speed_up_interrupts ();
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
355 if (err != LDAP_SUCCESS)
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
356 signal_simple_error ("Failed binding to the server",
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
357 build_string (ldap_err2string (err)));
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
358
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
359 lisp_ldap = allocate_ldap ();
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
360 lisp_ldap->ld = ld;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
361 lisp_ldap->host = host;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
362 lisp_ldap->status_symbol = Qopen;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
363 XSETLDAP (ldap,lisp_ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
364
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
365 UNGCPRO;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
366 return ldap;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
367 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
368
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
369
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
370
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
371 DEFUN ("ldap-close", Fldap_close, 1, 1, 0, /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
372 Close an LDAP connection.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
373 Return t if the connection was actually closed or nil if
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
374 it was already closed before the call
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
375 */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
376 (ldap))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
377 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
378 CHECK_LDAP (ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
379 if ( EQ ((XLDAP (ldap))->status_symbol, Qopen) )
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
380 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
381 ldap_unbind ((XLDAP (ldap))->ld);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
382 (XLDAP (ldap))->status_symbol = Qclosed;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
383 return Qt;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
384 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
385 return Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
386 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
387
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
388
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
389
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
390 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
391 /* Working on a LDAP connection */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
392 /************************************************************************/
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
393
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
394 DEFUN ("ldap-search-internal", Fldap_search_internal, 2, 6, 0, /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
395 Perform a search on an open LDAP connection.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
396 LDAP is an LDAP connection object created with `ldap-open'.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
397 FILTER is a filter string for the search as described in RFC 1558
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
398 BASE is the distinguished name at which to start the search
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
399 SCOPE is an integer or a symbol indicating the scope of the search
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
400 Possible values are `ldap-scope-base', `ldap-scope-onelevel' or
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
401 `ldap-scope-subtree'
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
402 ATTRS is a list of strings indicating which attributes to retrieve
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
403 for each matching entry. If nil return all available attributes.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
404 If ATTRSONLY is non-nil then only the attributes are retrieved, not
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
405 the associated values
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
406 The function returns a list of matching entries. Each entry is itself
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
407 an alist of attribute/values.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
408 */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
409 (ldap, filter, base, scope, attrs, attrsonly))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
410 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
411 /* This function can call lisp */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
412
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
413 /* Vars for query */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
414 LDAP *ld;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
415 LDAPMessage *res, *e;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
416 BerElement *ptr;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
417 char *a;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
418 int i, rc, err;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
419
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
420 char **vals = NULL;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
421 int matches;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
422
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
423 int ldap_scope = LDAP_SCOPE_SUBTREE;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
424 char **ldap_attributes = NULL;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
425
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
426 Lisp_Object list, entry, result;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
427 struct gcpro gcpro1, gcpro2, gcpro3;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
428
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
429 list = entry = result = Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
430 GCPRO3(list, entry, result);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
431
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
432 /* Do all the parameter checking */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
433 CHECK_LIVE_LDAP (ldap);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
434 ld = (XLDAP (ldap))->ld;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
435
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
436 /* Filter */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
437 CHECK_STRING (filter);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
438
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
439 /* Search base */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
440 if (NILP (base))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
441 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
442 base = Vldap_default_base;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
443 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
444 if (!NILP (base))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
445 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
446 CHECK_STRING (Vldap_default_base);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
447 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
448
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
449 /* Search scope */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
450 if (!NILP (scope))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
451 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
452 CHECK_SYMBOL (scope);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
453 if (EQ (scope, Qbase))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
454 ldap_scope = LDAP_SCOPE_BASE;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
455 else if (EQ (scope, Qonelevel))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
456 ldap_scope = LDAP_SCOPE_ONELEVEL;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
457 else if (EQ (scope, Qsubtree))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
458 ldap_scope = LDAP_SCOPE_SUBTREE;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
459 else
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
460 signal_simple_error ("Invalid scope", scope);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
461 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
462
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
463 /* Attributes to search */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
464 if (!NILP (attrs))
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
465 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
466 Lisp_Object attr_left = attrs;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
467 struct gcpro ngcpro1;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
468
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
469 NGCPRO1 (attr_left);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
470 CHECK_CONS (attrs);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
471
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
472 ldap_attributes = alloca ((XINT (Flength (attrs)) + 1)*sizeof (char *));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
473
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
474 for (i=0; !NILP (attr_left); i++) {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
475 CHECK_STRING (XCAR (attr_left));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
476 ldap_attributes[i] = alloca (XSTRING_LENGTH (XCAR (attr_left)) + 1);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
477 strcpy(ldap_attributes[i],
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
478 (char *)(XSTRING_DATA( XCAR (attr_left))));
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
479 attr_left = XCDR (attr_left);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
480 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
481 ldap_attributes[i] = NULL;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
482 NUNGCPRO;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
483 }
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
484
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
485 /* Attributes only ? */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
486 CHECK_SYMBOL (attrsonly);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
487
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
488
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
489 /* Perform the search */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
490 if (ldap_search (ld,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
491 NILP (base) ? "" : (char *) XSTRING_DATA (base),
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
492 ldap_scope,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
493 NILP (filter) ? "" : (char *) XSTRING_DATA (filter),
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
494 ldap_attributes,
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
495 NILP (attrsonly) ? 0 : 1)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
496 == -1)
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
497 {
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
498 signal_ldap_error (ld);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
499 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
500
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
501 /* Build the results list */
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
502 matches = 0;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
503
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
504 /* ldap_result calls select() and can get wedged by EINTR signals */
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
505 slow_down_interrupts ();
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
506 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
507 speed_up_interrupts ();
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
508 while ( rc == LDAP_RES_SEARCH_ENTRY )
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
509 {
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
510 matches ++;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
511 e = ldap_first_entry (ld, res);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
512 message ("Parsing results... %d", matches);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
513 entry = Qnil;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
514 for (a= ldap_first_attribute (ld, e, &ptr);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
515 a != NULL;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
516 a= ldap_next_attribute (ld, e, ptr) )
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
517 {
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
518 list = Fcons (build_string (a), Qnil);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
519 vals = ldap_get_values (ld, e, a);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
520 if (vals != NULL)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
521 {
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
522 for (i=0; vals[i]!=NULL; i++)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
523 {
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
524 list = Fcons (build_string (vals[i]),
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
525 list);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
526 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
527 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
528 entry = Fcons (Fnreverse (list),
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
529 entry);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
530 ldap_value_free (vals);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
531 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
532 result = Fcons (Fnreverse (entry),
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
533 result);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
534 ldap_msgfree (res);
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
535
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
536 slow_down_interrupts ();
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
537 rc = ldap_result (ld, LDAP_RES_ANY, 0, NULL, &res);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
538 speed_up_interrupts ();
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
539 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
540
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
541 if (rc == -1)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
542 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
543 signal_ldap_error (ld);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
544 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
545
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
546 if ((rc = ldap_result2error (ld, res, 0)) != LDAP_SUCCESS)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
547 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
548 signal_ldap_error (ld);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
549 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
550
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
551 ldap_msgfree (res);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
552 message ("Done.");
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
553
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
554 result = Fnreverse (result);
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
555 clear_message ();
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
556
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
557 UNGCPRO;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
558 return result;
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
559 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
560
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
561
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
562 void
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
563 syms_of_eldap (void)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
564 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
565 defsymbol (&Qldapp, "ldapp");
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
566
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
567 DEFSUBR (Fldapp);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
568 DEFSUBR (Fldap_host);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
569 DEFSUBR (Fldap_status);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
570 DEFSUBR (Fldap_open);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
571 DEFSUBR (Fldap_close);
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
572 DEFSUBR (Fldap_search_internal);
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
573 }
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
574
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
575 void
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
576 vars_of_eldap (void)
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
577 {
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
578 Fprovide (intern ("ldap"));
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
579
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
580 ldap_default_port = LDAP_PORT;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
581 Vldap_default_base = Qnil;
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
582
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
583 DEFVAR_INT ("ldap-default-port", &ldap_default_port /*
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
584 Default TCP port for LDAP connections.
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
585 Initialized from the LDAP library. Default value is 389.
259
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
586 */ );
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
587
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
588 DEFVAR_LISP ("ldap-default-base", &Vldap_default_base /*
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
589 Default base for LDAP searches.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
590 This is a string using the syntax of RFC 1779.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
591 For instance, "o=ACME, c=US" limits the search to the
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
592 Acme organization in the United States.
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
593 */ );
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
594
11cf20601dec Import from CVS: tag r20-5b28
cvs
parents:
diff changeset
595 }
276
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
596
6330739388db Import from CVS: tag r21-0b36
cvs
parents: 272
diff changeset
597