Commit | Line | Data |
---|---|---|
01c52d31 MB |
1 | ;;; smime-ldap.el --- client interface to LDAP for Emacs |
2 | ||
3 | ;; Copyright (C) 1998, 1999, 2000, 2005 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> | |
6 | ;; Maintainer: Arne J\e,Ax\e(Brgensen <arne@arnested.dk> | |
7 | ;; Created: February 2005 | |
8 | ;; Keywords: comm | |
9 | ||
10 | ;; This file is part of GNU Emacs. | |
11 | ||
12 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
13 | ;; it under the terms of the GNU General Public License as published by | |
14 | ;; the Free Software Foundation; either version 3, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
20 | ;; GNU General Public License for more details. | |
21 | ||
22 | ;; You should have received a copy of the GNU General Public License | |
23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
25 | ;; Boston, MA 02110-1301, USA. | |
26 | ||
27 | ;;; Commentary: | |
28 | ||
29 | ;; This file has a slightly changed implementation of Emacs 21.3's | |
30 | ;; ldap-search and ldap-search-internal from ldap.el. The changes are | |
31 | ;; made to achieve compatibility with OpenLDAP v2 and to make it | |
32 | ;; possible to retrieve LDAP attributes that are tagged ie ";binary". | |
33 | ||
34 | ;; The file also adds a compatibility layer for Emacs and XEmacs. | |
35 | ||
36 | ;;; Code: | |
37 | ||
38 | (require 'ldap) | |
39 | ||
40 | (defun smime-ldap-search (filter &optional host attributes attrsonly withdn) | |
41 | "Perform an LDAP search. | |
42 | FILTER is the search filter in RFC1558 syntax. | |
43 | HOST is the LDAP host on which to perform the search. | |
44 | ATTRIBUTES are the specific attributes to retrieve, nil means | |
45 | retrieve all. | |
46 | ATTRSONLY, if non-nil, retrieves the attributes only, without | |
47 | the associated values. | |
48 | If WITHDN is non-nil, each entry in the result will be prepended with | |
49 | its distinguished name WITHDN. | |
50 | Additional search parameters can be specified through | |
51 | `ldap-host-parameters-alist', which see." | |
52 | (interactive "sFilter:") | |
53 | ;; for XEmacs | |
54 | (if (fboundp 'ldap-search-entries) | |
55 | (ldap-search-entries filter host attributes attrsonly) | |
56 | ;; for Emacs 22 | |
57 | (if (>= emacs-major-version 22) | |
58 | (cdr (ldap-search filter host attributes attrsonly)) | |
59 | ;; for Emacs 21.x | |
60 | (or host | |
61 | (setq host ldap-default-host) | |
62 | (error "No LDAP host specified")) | |
63 | (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
64 | result) | |
65 | (setq result (smime-ldap-search-internal | |
66 | (append host-plist | |
67 | (list 'host host | |
68 | 'filter filter | |
69 | 'attributes attributes | |
70 | 'attrsonly attrsonly | |
71 | 'withdn withdn)))) | |
72 | (cdr (if ldap-ignore-attribute-codings | |
73 | result | |
74 | (mapcar (function | |
75 | (lambda (record) | |
76 | (mapcar 'ldap-decode-attribute record))) | |
77 | result))))))) | |
78 | ||
79 | (defun smime-ldap-search-internal (search-plist) | |
80 | "Perform a search on a LDAP server. | |
81 | SEARCH-PLIST is a property list describing the search request. | |
82 | Valid keys in that list are: | |
83 | `host' is a string naming one or more (blank-separated) LDAP servers to | |
84 | to try to connect to. Each host name may optionally be of the form HOST:PORT. | |
85 | `filter' is a filter string for the search as described in RFC 1558. | |
86 | `attributes' is a list of strings indicating which attributes to retrieve | |
87 | for each matching entry. If nil, return all available attributes. | |
88 | `attrsonly', if non-nil, indicates that only attributes are retrieved, | |
89 | not their associated values. | |
90 | `base' is the base for the search as described in RFC 1779. | |
91 | `scope' is one of the three symbols `sub', `base' or `one'. | |
92 | `binddn' is the distinguished name of the user to bind as (in RFC 1779 syntax). | |
93 | `passwd' is the password to use for simple authentication. | |
94 | `deref' is one of the symbols `never', `always', `search' or `find'. | |
95 | `timelimit' is the timeout limit for the connection in seconds. | |
96 | `sizelimit' is the maximum number of matches to return. | |
97 | `withdn' if non-nil each entry in the result will be prepended with | |
98 | its distinguished name DN. | |
99 | The function returns a list of matching entries. Each entry is itself | |
100 | an alist of attribute/value pairs." | |
101 | (let ((buf (get-buffer-create " *ldap-search*")) | |
102 | (bufval (get-buffer-create " *ldap-value*")) | |
103 | (host (or (plist-get search-plist 'host) | |
104 | ldap-default-host)) | |
105 | (filter (plist-get search-plist 'filter)) | |
106 | (attributes (plist-get search-plist 'attributes)) | |
107 | (attrsonly (plist-get search-plist 'attrsonly)) | |
108 | (base (or (plist-get search-plist 'base) | |
109 | ldap-default-base)) | |
110 | (scope (plist-get search-plist 'scope)) | |
111 | (binddn (plist-get search-plist 'binddn)) | |
112 | (passwd (plist-get search-plist 'passwd)) | |
113 | (deref (plist-get search-plist 'deref)) | |
114 | (timelimit (plist-get search-plist 'timelimit)) | |
115 | (sizelimit (plist-get search-plist 'sizelimit)) | |
116 | (withdn (plist-get search-plist 'withdn)) | |
117 | (numres 0) | |
118 | arglist dn name value record result) | |
119 | (if (or (null filter) | |
120 | (equal "" filter)) | |
121 | (error "No search filter")) | |
122 | (setq filter (cons filter attributes)) | |
123 | (save-excursion | |
124 | (set-buffer buf) | |
125 | (erase-buffer) | |
126 | (if (and host | |
127 | (not (equal "" host))) | |
128 | (setq arglist (nconc arglist (list (format "-h%s" host))))) | |
129 | (if (and attrsonly | |
130 | (not (equal "" attrsonly))) | |
131 | (setq arglist (nconc arglist (list "-A")))) | |
132 | (if (and base | |
133 | (not (equal "" base))) | |
134 | (setq arglist (nconc arglist (list (format "-b%s" base))))) | |
135 | (if (and scope | |
136 | (not (equal "" scope))) | |
137 | (setq arglist (nconc arglist (list (format "-s%s" scope))))) | |
138 | (if (and binddn | |
139 | (not (equal "" binddn))) | |
140 | (setq arglist (nconc arglist (list (format "-D%s" binddn))))) | |
141 | (if (and passwd | |
142 | (not (equal "" passwd))) | |
143 | (setq arglist (nconc arglist (list (format "-w%s" passwd))))) | |
144 | (if (and deref | |
145 | (not (equal "" deref))) | |
146 | (setq arglist (nconc arglist (list (format "-a%s" deref))))) | |
147 | (if (and timelimit | |
148 | (not (equal "" timelimit))) | |
149 | (setq arglist (nconc arglist (list (format "-l%s" timelimit))))) | |
150 | (if (and sizelimit | |
151 | (not (equal "" sizelimit))) | |
152 | (setq arglist (nconc arglist (list (format "-z%s" sizelimit))))) | |
153 | (eval `(call-process ldap-ldapsearch-prog | |
154 | nil | |
155 | buf | |
156 | nil | |
157 | ,@arglist | |
158 | "-tt" ; Write values to temp files | |
159 | "-x" | |
160 | "-LL" | |
161 | ; ,@ldap-ldapsearch-args | |
162 | ,@filter)) | |
163 | (insert "\n") | |
164 | (goto-char (point-min)) | |
165 | ||
166 | (while (re-search-forward "[\t\n\f]+ " nil t) | |
167 | (replace-match "" nil nil)) | |
168 | (goto-char (point-min)) | |
169 | ||
170 | (if (looking-at "usage") | |
171 | (error "Incorrect ldapsearch invocation") | |
172 | (message "Parsing results... ") | |
173 | (while (progn | |
174 | (skip-chars-forward " \t\n") | |
175 | (not (eobp))) | |
176 | (setq dn (buffer-substring (point) (save-excursion | |
177 | (end-of-line) | |
178 | (point)))) | |
179 | (forward-line 1) | |
180 | (while (looking-at (concat "^\\(\\w*\\)\\(;\\w*\\)?[=:\t ]+" | |
181 | "\\(<[\t ]*file://\\)?\\(.*\\)$")) | |
182 | (setq name (match-string 1) | |
183 | value (match-string 4)) | |
184 | (save-excursion | |
185 | (set-buffer bufval) | |
186 | (erase-buffer) | |
187 | (insert-file-contents-literally value) | |
188 | (delete-file value) | |
189 | (setq value (buffer-substring (point-min) (point-max)))) | |
190 | (setq record (cons (list name value) | |
191 | record)) | |
192 | (forward-line 1)) | |
193 | (setq result (cons (if withdn | |
194 | (cons dn (nreverse record)) | |
195 | (nreverse record)) result)) | |
196 | (setq record nil) | |
197 | (skip-chars-forward " \t\n") | |
198 | (message "Parsing results... %d" numres) | |
199 | (1+ numres)) | |
200 | (message "Parsing results... done") | |
201 | (nreverse result))))) | |
202 | ||
203 | (provide 'smime-ldap) | |
204 | ||
205 | ;; arch-tag: 87e6bc44-21fc-4e9b-a89b-f55f031f78f8 | |
206 | ;;; smime-ldap.el ends here |