diff options
| author | Stefan Monnier | 2004-04-12 04:04:31 +0000 |
|---|---|---|
| committer | Stefan Monnier | 2004-04-12 04:04:31 +0000 |
| commit | bebcf94029005bd6538dde4b16eb7d0ed720f7f6 (patch) | |
| tree | 310ae244741c125c9b1c581e298e71a7bf3be535 | |
| parent | 39c541030ed5051e508f7f4d30ce9b180fb62e46 (diff) | |
| download | emacs-bebcf94029005bd6538dde4b16eb7d0ed720f7f6.tar.gz emacs-bebcf94029005bd6538dde4b16eb7d0ed720f7f6.zip | |
(ldap): Require.
(url-ldap): Fix `format' call.
(url-ldap-certificate-formatter): Avoid warning.
| -rw-r--r-- | lisp/url/url-ldap.el | 58 |
1 files changed, 32 insertions, 26 deletions
diff --git a/lisp/url/url-ldap.el b/lisp/url/url-ldap.el index a36ea05a490..27cbb8ad1e3 100644 --- a/lisp/url/url-ldap.el +++ b/lisp/url/url-ldap.el | |||
| @@ -1,30 +1,33 @@ | |||
| 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. | ||
| 3 | |||
| 2 | ;; Keywords: comm, data, processes | 4 | ;; Keywords: comm, data, processes |
| 3 | 5 | ||
| 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 6 | ;; This file is part of GNU Emacs. |
| 5 | ;;; Copyright (c) 1998 - 1999 Free Software Foundation, Inc. | 7 | ;; |
| 6 | ;;; | 8 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 7 | ;;; This file is part of GNU Emacs. | 9 | ;; it under the terms of the GNU General Public License as published by |
| 8 | ;;; | 10 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 9 | ;;; GNU Emacs is free software; you can redistribute it and/or modify | 11 | ;; any later version. |
| 10 | ;;; it under the terms of the GNU General Public License as published by | 12 | ;; |
| 11 | ;;; the Free Software Foundation; either version 2, or (at your option) | 13 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 12 | ;;; any later version. | 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 13 | ;;; | 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 14 | ;;; GNU Emacs is distributed in the hope that it will be useful, | 16 | ;; GNU General Public License for more details. |
| 15 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 17 | ;; |
| 16 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 18 | ;; You should have received a copy of the GNU General Public License |
| 17 | ;;; GNU General Public License for more details. | 19 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 18 | ;;; | 20 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 19 | ;;; You should have received a copy of the GNU General Public License | 21 | ;; Boston, MA 02111-1307, USA. |
| 20 | ;;; along with GNU Emacs; see the file COPYING. If not, write to the | 22 | |
| 21 | ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | 23 | ;;; Commentary: |
| 22 | ;;; Boston, MA 02111-1307, USA. | 24 | |
| 23 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 25 | ;;; Code: |
| 24 | 26 | ||
| 25 | (require 'url-vars) | 27 | (require 'url-vars) |
| 26 | (require 'url-parse) | 28 | (require 'url-parse) |
| 27 | (require 'url-util) | 29 | (require 'url-util) |
| 30 | (require 'ldap) | ||
| 28 | 31 | ||
| 29 | ;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997) | 32 | ;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997) |
| 30 | ;; | 33 | ;; |
| @@ -35,7 +38,7 @@ | |||
| 35 | ;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US | 38 | ;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US |
| 36 | ;; | 39 | ;; |
| 37 | ;; For simple queries, I have verified compatibility with Netscape | 40 | ;; For simple queries, I have verified compatibility with Netscape |
| 38 | ;; Communicator v4.5 under linux. | 41 | ;; Communicator v4.5 under GNU/Linux. |
| 39 | ;; | 42 | ;; |
| 40 | ;; For anything _useful_ though, like specifying the attributes, | 43 | ;; For anything _useful_ though, like specifying the attributes, |
| 41 | ;; scope, filter, or extensions, netscape claims the URL format is | 44 | ;; scope, filter, or extensions, netscape claims the URL format is |
| @@ -92,8 +95,8 @@ | |||
| 92 | (condition-case () | 95 | (condition-case () |
| 93 | (require 'ssl) | 96 | (require 'ssl) |
| 94 | (error nil)) | 97 | (error nil)) |
| 95 | (let ((vals (and (fboundp 'ssl-certificate-information) | 98 | (let ((vals (if (fboundp 'ssl-certificate-information) |
| 96 | (ssl-certificate-information data)))) | 99 | (ssl-certificate-information data)))) |
| 97 | (if (not vals) | 100 | (if (not vals) |
| 98 | "<b>Unable to parse certificate</b>" | 101 | "<b>Unable to parse certificate</b>" |
| 99 | (concat "<table border=0>\n" | 102 | (concat "<table border=0>\n" |
| @@ -104,9 +107,11 @@ | |||
| 104 | "</table>\n")))) | 107 | "</table>\n")))) |
| 105 | 108 | ||
| 106 | (defun url-ldap-image-formatter (data) | 109 | (defun url-ldap-image-formatter (data) |
| 107 | (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>" | 110 | (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>" |
| 108 | (url-hexify-string (base64-encode-string data)))) | 111 | (url-hexify-string (base64-encode-string data)))) |
| 109 | 112 | ||
| 113 | ;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically | ||
| 114 | ;; calls of ldap-open, ldap-close, ldap-search-internal | ||
| 110 | ;;;###autoload | 115 | ;;;###autoload |
| 111 | (defun url-ldap (url) | 116 | (defun url-ldap (url) |
| 112 | (save-excursion | 117 | (save-excursion |
| @@ -210,7 +215,7 @@ | |||
| 210 | "</td></tr>\n") | 215 | "</td></tr>\n") |
| 211 | ;; Multiple matches, slightly uglier | 216 | ;; Multiple matches, slightly uglier |
| 212 | (insert " <tr>\n" | 217 | (insert " <tr>\n" |
| 213 | (format " <td valign=top>" (length (cdr attr))) | 218 | (format " <td valign=top>") |
| 214 | (url-ldap-attribute-pretty-name (car attr)) "</td><td>" | 219 | (url-ldap-attribute-pretty-name (car attr)) "</td><td>" |
| 215 | (mapconcat (lambda (x) | 220 | (mapconcat (lambda (x) |
| 216 | (url-ldap-attribute-pretty-desc (car attr) x)) | 221 | (url-ldap-attribute-pretty-desc (car attr) x)) |
| @@ -229,4 +234,5 @@ | |||
| 229 | 234 | ||
| 230 | (provide 'url-ldap) | 235 | (provide 'url-ldap) |
| 231 | 236 | ||
| 232 | ;;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8 | 237 | ;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8 |
| 238 | ;;; url-ldap.el ends here | ||