/[emacs]/emacs/lisp/url/url-ldap.el
ViewVC logotype

Diff of /emacs/lisp/url/url-ldap.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by jas, Tue Oct 12 09:55:08 2004 UTC revision 1.6 by rms, Sun Apr 10 17:01:46 2005 UTC
# Line 1  Line 1 
1  ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code  ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
2  ;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.  ;; Copyright (c) 1998, 1999, 2004, 2005 Free Software Foundation, Inc.
3    
4  ;; Keywords: comm, data, processes  ;; Keywords: comm, data, processes
5    
# Line 112  Line 112 
112    (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"    (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
113            (url-hexify-string (base64-encode-string data))))            (url-hexify-string (base64-encode-string data))))
114    
 ;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically  
 ;; calls of ldap-open, ldap-close, ldap-search-internal  
115  ;;;###autoload  ;;;###autoload
116  (defun url-ldap (url)  (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")))
125    (save-excursion    (save-excursion
126      (set-buffer (generate-new-buffer " *url-ldap*"))      (set-buffer (generate-new-buffer " *url-ldap*"))
127      (setq url-current-object url)      (setq url-current-object url)
# Line 142  Line 148 
148               (scope nil)               (scope nil)
149               (filter nil)               (filter nil)
150               (extensions nil)               (extensions nil)
151               (connection nil)               (results nil))
              (results nil)  
              (extract-dn (and (fboundp 'function-max-args)  
                               (= (function-max-args 'ldap-search-internal) 7))))  
152    
153          ;; Get rid of leading /          ;; Get rid of leading /
154          (if (string-match "^/" data)          (if (string-match "^/" data)
# Line 163  Line 166 
166                scope (intern (url-unhex-string (or scope "base")))                scope (intern (url-unhex-string (or scope "base")))
167                filter (url-unhex-string (or filter "(objectClass=*)")))                filter (url-unhex-string (or filter "(objectClass=*)")))
168    
169          (if (not (memq scope '(base one tree)))          (if (not (memq scope '(base one sub)))
170              (error "Malformed LDAP URL: Unknown scope: %S" scope))              (error "Malformed LDAP URL: Unknown scope: %S" scope))
171    
172          ;; Convert to the internal LDAP support scoping names.          ;; Convert to the internal LDAP support scoping names.
# Line 188  Line 191 
191                                     (assoc "!bindname" extensions))))                                     (assoc "!bindname" extensions))))
192            
193          ;; Now, let's actually do something with it.          ;; Now, let's actually do something with it.
194          (setq connection (ldap-open host (if binddn (list 'binddn binddn)))          (setq results (cdr (ldap-search-internal
195                results (if extract-dn                         (list 'host (concat host ":" (number-to-string port))
196                            (ldap-search-internal connection filter base-object scope attributes nil t)                               'base base-object
197                          (ldap-search-internal connection filter base-object scope attributes nil)))                               'attributes attributes
198                                                       'scope scope
199          (ldap-close connection)                               'filter filter
200                                 'binddn binddn))))
201    
202          (insert "<html>\n"          (insert "<html>\n"
203                  " <head>\n"                  " <head>\n"
204                  "  <title>LDAP Search Results</title>\n"                  "  <title>LDAP Search Results</title>\n"
# Line 205  Line 210 
210          (mapc (lambda (obj)          (mapc (lambda (obj)
211                  (insert "  <hr>\n"                  (insert "  <hr>\n"
212                          "  <table border=1>\n")                          "  <table border=1>\n")
                 (if extract-dn  
                     (insert "   <tr><th colspan=2>" (car obj) "</th></tr>\n"))  
213                  (mapc (lambda (attr)                  (mapc (lambda (attr)
214                          (if (= (length (cdr attr)) 1)                          (if (= (length (cdr attr)) 1)
215                              ;; single match, easy                              ;; single match, easy
# Line 225  Line 228 
228                                               "<br>\n")                                               "<br>\n")
229                                    "</td>"                                    "</td>"
230                                    "   </tr>\n")))                                    "   </tr>\n")))
231                        (if extract-dn (cdr obj) obj))                        obj)
232                  (insert "  </table>\n"))                  (insert "  </table>\n"))
233                results)                results)
234    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26