(url-ldap): Add docstring. Fix call to `ldap-search-internal'.

author: Richard M. Stallman 2005-04-10 17:01:46 +0000
committer: Richard M. Stallman 2005-04-10 17:01:46 +0000
commit: d9cdf64b8d25c055838bf8d79e956c79b08f5646 (patch)
tree: 7650ed68d46b6acef089790d7cbff76fd3c7afc1
parent: 4a4cbd001dfcee3eea036b5b0b8a97d508816c98 (diff)
download: emacs-d9cdf64b8d25c055838bf8d79e956c79b08f5646.tar.gz
emacs-d9cdf64b8d25c055838bf8d79e956c79b08f5646.zip
1 files changed, 20 insertions, 17 deletions
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 24a3ade4922..55f36a4155f 100644
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,5 +1,5 @@
 ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
-;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.
+;; Copyright (c) 1998, 1999, 2004, 2005 Free Software Foundation, Inc.
 ;; Keywords: comm, data, processes
@@ -112,10 +112,16 @@
  (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
          (url-hexify-string (base64-encode-string data))))
-;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically
-;; calls of ldap-open, ldap-close, ldap-search-internal
 ;;;###autoload
 (defun url-ldap (url)
+  "Perform an LDAP search specified by URL.
+The return value is a buffer displaying the search results in HTML.
+URL can be a URL string, or a URL vector of the type returned by
+`url-generic-parse-url'."
+  (if (stringp url)
+      (setq url (url-generic-parse-url (url-unhex-string url)))
+    (if (not (vectorp url))
+        (error "Argument is not a valid URL")))
  (save-excursion
    (set-buffer (generate-new-buffer " *url-ldap*"))
    (setq url-current-object url)
@@ -142,10 +148,7 @@
             (scope nil)
             (filter nil)
             (extensions nil)
-             (connection nil)
+             (results nil))
-             (results nil)
-             (extract-dn (and (fboundp 'function-max-args)
-                              (= (function-max-args 'ldap-search-internal) 7))))
        ;; Get rid of leading /
        (if (string-match "^/" data)
@@ -163,7 +166,7 @@
              scope (intern (url-unhex-string (or scope "base")))
              filter (url-unhex-string (or filter "(objectClass=*)")))
-        (if (not (memq scope '(base one tree)))
+        (if (not (memq scope '(base one sub)))
            (error "Malformed LDAP URL: Unknown scope: %S" scope))
        ;; Convert to the internal LDAP support scoping names.
@@ -188,12 +191,14 @@
                                   (assoc "!bindname" extensions))))
    
        ;; Now, let's actually do something with it.
-        (setq connection (ldap-open host (if binddn (list 'binddn binddn)))
+        (setq results (cdr (ldap-search-internal
-              results (if extract-dn
+                       (list 'host (concat host ":" (number-to-string port))
-                          (ldap-search-internal connection filter base-object scope attributes nil t)
+                             'base base-object
-                        (ldap-search-internal connection filter base-object scope attributes nil)))
+                             'attributes attributes
-                      
+                             'scope scope
-        (ldap-close connection)
+                             'filter filter
+                             'binddn binddn))))
        (insert "<html>\n"
                " <head>\n"
                "  <title>LDAP Search Results</title>\n"
@@ -205,8 +210,6 @@
        (mapc (lambda (obj)
                (insert "  <hr>\n"
                        "  <table border=1>\n")
-                (if extract-dn
-                    (insert "   <tr><th colspan=2>" (car obj) "</th></tr>\n"))
                (mapc (lambda (attr)
                        (if (= (length (cdr attr)) 1)
                            ;; single match, easy
@@ -225,7 +228,7 @@
                                             "<br>\n")
                                  "</td>"
                                  "   </tr>\n")))
-                      (if extract-dn (cdr obj) obj))
+                      obj)
                (insert "  </table>\n"))
              results)
author	Richard M. Stallman	2005-04-10 17:01:46 +0000
committer	Richard M. Stallman	2005-04-10 17:01:46 +0000
commit	d9cdf64b8d25c055838bf8d79e956c79b08f5646 (patch)
tree	7650ed68d46b6acef089790d7cbff76fd3c7afc1
parent	4a4cbd001dfcee3eea036b5b0b8a97d508816c98 (diff)
download	emacs-d9cdf64b8d25c055838bf8d79e956c79b08f5646.tar.gz emacs-d9cdf64b8d25c055838bf8d79e956c79b08f5646.zip

diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index 24a3ade4922..55f36a4155f 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el
@@ -1,5 +1,5 @@
1	;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code	1	;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
2	;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.	2	;; Copyright (c) 1998, 1999, 2004, 2005 Free Software Foundation, Inc.
3		3
4	;; Keywords: comm, data, processes	4	;; Keywords: comm, data, processes
5		5
@@ -112,10 +112,16 @@
112	(format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"	112	(format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
113	(url-hexify-string (base64-encode-string data))))	113	(url-hexify-string (base64-encode-string data))))
114		114
115	;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically
116	;; calls of ldap-open, ldap-close, ldap-search-internal
117	;;;###autoload	115	;;;###autoload
118	(defun url-ldap (url)	116	(defun url-ldap (url)
		117	"Perform an LDAP search specified by URL.
		118	The return value is a buffer displaying the search results in HTML.
		119	URL can be a URL string, or a URL vector of the type returned by
		120	`url-generic-parse-url'."
		121	(if (stringp url)
		122	(setq url (url-generic-parse-url (url-unhex-string url)))
		123	(if (not (vectorp url))
		124	(error "Argument is not a valid URL")))
119	(save-excursion	125	(save-excursion
120	(set-buffer (generate-new-buffer " url-ldap"))	126	(set-buffer (generate-new-buffer " url-ldap"))
121	(setq url-current-object url)	127	(setq url-current-object url)
@@ -142,10 +148,7 @@
142	(scope nil)	148	(scope nil)
143	(filter nil)	149	(filter nil)
144	(extensions nil)	150	(extensions nil)
145	(connection nil)	151	(results nil))
146	(results nil)
147	(extract-dn (and (fboundp 'function-max-args)
148	(= (function-max-args 'ldap-search-internal) 7))))
149		152
150	;; Get rid of leading /	153	;; Get rid of leading /
151	(if (string-match "^/" data)	154	(if (string-match "^/" data)
@@ -163,7 +166,7 @@
163	scope (intern (url-unhex-string (or scope "base")))	166	scope (intern (url-unhex-string (or scope "base")))
164	filter (url-unhex-string (or filter "(objectClass=*)")))	167	filter (url-unhex-string (or filter "(objectClass=*)")))
165		168
166	(if (not (memq scope '(base one tree)))	169	(if (not (memq scope '(base one sub)))
167	(error "Malformed LDAP URL: Unknown scope: %S" scope))	170	(error "Malformed LDAP URL: Unknown scope: %S" scope))
168		171
169	;; Convert to the internal LDAP support scoping names.	172	;; Convert to the internal LDAP support scoping names.
@@ -188,12 +191,14 @@
188	(assoc "!bindname" extensions))))	191	(assoc "!bindname" extensions))))
189		192
190	;; Now, let's actually do something with it.	193	;; Now, let's actually do something with it.
191	(setq connection (ldap-open host (if binddn (list 'binddn binddn)))	194	(setq results (cdr (ldap-search-internal
192	results (if extract-dn	195	(list 'host (concat host ":" (number-to-string port))
193	(ldap-search-internal connection filter base-object scope attributes nil t)	196	'base base-object
194	(ldap-search-internal connection filter base-object scope attributes nil)))	197	'attributes attributes
195		198	'scope scope
196	(ldap-close connection)	199	'filter filter
		200	'binddn binddn))))
		201
197	(insert "<html>\n"	202	(insert "<html>\n"
198	" <head>\n"	203	" <head>\n"
199	" <title>LDAP Search Results</title>\n"	204	" <title>LDAP Search Results</title>\n"
@@ -205,8 +210,6 @@
205	(mapc (lambda (obj)	210	(mapc (lambda (obj)
206	(insert " <hr>\n"	211	(insert " <hr>\n"
207	" <table border=1>\n")	212	" <table border=1>\n")
208	(if extract-dn
209	(insert " <tr><th colspan=2>" (car obj) "</th></tr>\n"))
210	(mapc (lambda (attr)	213	(mapc (lambda (attr)
211	(if (= (length (cdr attr)) 1)	214	(if (= (length (cdr attr)) 1)
212	;; single match, easy	215	;; single match, easy
@@ -225,7 +228,7 @@
225	"<br>\n")	228	"<br>\n")
226	"</td>"	229	"</td>"
227	" </tr>\n")))	230	" </tr>\n")))
228	(if extract-dn (cdr obj) obj))	231	obj)
229	(insert " </table>\n"))	232	(insert " </table>\n"))
230	results)	233	results)
231		234