Convert consecutive FSF copyright years to ranges.

[bpt/emacs.git] / lisp / url / url-ldap.el

diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el
index 27cbb8a..bb937a4 100644 (file)
--- a/lisp/url/url-ldap.el
+++ b/lisp/url/url-ldap.el
@@ -1,24 +1,23 @@
 ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
-;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.
+
+;; Copyright (C) 1998-1999, 2004-2011 Free Software Foundation, Inc.
 
 ;; Keywords: comm, data, processes
 
 ;; This file is part of GNU Emacs.
 ;;
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
 ;; GNU Emacs 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.  See the
 ;; GNU General Public License for more details.
-;;
+
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -28,6 +27,7 @@
 (require 'url-parse)
 (require 'url-util)
 (require 'ldap)
+(autoload 'tls-certificate-information "tls")
 
 ;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997)
 ;;
@@ -96,7 +96,8 @@
       (require 'ssl)
     (error nil))
   (let ((vals (if (fboundp 'ssl-certificate-information)
-                 (ssl-certificate-information data))))
+                 (ssl-certificate-information data)
+               (tls-certificate-information data))))
     (if (not vals)
        "<b>Unable to parse certificate</b>"
       (concat "<table border=0>\n"
@@ -110,12 +111,17 @@
   (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)
-  (save-excursion
-    (set-buffer (generate-new-buffer " *url-ldap*"))
+  "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")))
+  (with-current-buffer (generate-new-buffer " *url-ldap*")
     (setq url-current-object url)
     (insert "Content-type: text/html\r\n\r\n")
     (if (not (fboundp 'ldap-search-internal))
@@ -140,10 +146,7 @@
             (scope nil)
             (filter nil)
             (extensions nil)
-            (connection nil)
-            (results nil)
-            (extract-dn (and (fboundp 'function-max-args)
-                             (= (function-max-args 'ldap-search-internal) 7))))
+            (results nil))
 
        ;; Get rid of leading /
        (if (string-match "^/" data)
@@ -161,7 +164,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.
@@ -184,14 +187,16 @@
 
        (setq binddn (cdr-safe (or (assoc "bindname" extensions)
                                   (assoc "!bindname" extensions))))
-    
+
        ;; Now, let's actually do something with it.
-       (setq connection (ldap-open host (if binddn (list 'binddn binddn)))
-             results (if extract-dn
-                         (ldap-search-internal connection filter base-object scope attributes nil t)
-                       (ldap-search-internal connection filter base-object scope attributes nil)))
-                     
-       (ldap-close connection)
+       (setq results (cdr (ldap-search-internal
+                      (list 'host (concat host ":" (number-to-string port))
+                            'base base-object
+                            'attributes attributes
+                            'scope scope
+                            'filter filter
+                            'binddn binddn))))
+
        (insert "<html>\n"
                " <head>\n"
                "  <title>LDAP Search Results</title>\n"
@@ -203,8 +208,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
@@ -223,7 +226,7 @@
                                             "<br>\n")
                                  "</td>"
                                  "   </tr>\n")))
-                     (if extract-dn (cdr obj) obj))
+                      obj)
                (insert "  </table>\n"))
              results)
 
@@ -234,5 +237,4 @@
 
 (provide 'url-ldap)
 
-;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8
 ;;; url-ldap.el ends here