annotate lisp/url/url-ldap.el @ 83219:e86fc76a45e4

Merged in changes from CVS trunk. Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-611 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-612 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-613 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-614 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-615 Merge from gnus--rel--5.10 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-46 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-47 Merge from emacs--cvs-trunk--0 * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-48 Update from CVS * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-49 Add {arch}/=commit-merge-make-log * miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-50 {arch}/=commit-merge-make-log: Don't die if there are no ChangeLog changes git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-259
author Karoly Lorentey <lorentey@elte.hu>
date Thu, 14 Oct 2004 14:42:03 +0000
parents eb7e8d483840 202c408c174b
children 9deb6323655c
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
1 ;;; url-ldap.el --- LDAP Uniform Resource Locator retrieval code
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
2 ;; Copyright (c) 1998 - 1999, 2004 Free Software Foundation, Inc.
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
3
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
4 ;; Keywords: comm, data, processes
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
5
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
6 ;; This file is part of GNU Emacs.
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
7 ;;
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
9 ;; it under the terms of the GNU General Public License as published by
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
10 ;; the Free Software Foundation; either version 2, or (at your option)
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
11 ;; any later version.
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
12 ;;
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
13 ;; GNU Emacs is distributed in the hope that it will be useful,
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
16 ;; GNU General Public License for more details.
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
17 ;;
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
18 ;; You should have received a copy of the GNU General Public License
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
19 ;; along with GNU Emacs; see the file COPYING. If not, write to the
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
21 ;; Boston, MA 02111-1307, USA.
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
22
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
23 ;;; Commentary:
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
24
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
25 ;;; Code:
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
26
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
27 (require 'url-vars)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
28 (require 'url-parse)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
29 (require 'url-util)
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
30 (require 'ldap)
57449
202c408c174b url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents: 54799
diff changeset
31 (autoload 'tls-certificate-information "tls")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
32
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
33 ;; This has been implemented from RFC2255 'The LDAP URL Format' (Dec 1997)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
34 ;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
35 ;; basic format is: ldap://host:port/dn?attributes?scope?filter?extensions
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
36 ;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
37 ;; Test URLs:
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
38 ;; ldap://ldap.itd.umich.edu/cn%3Dumbflabmanager%2C%20ou%3DUser%20Groups%2C%20ou%3DGroups%2C%20o%3DUniversity%20of%20Michigan%2C%20c%3DUS
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
39 ;; ldap://ldap.itd.umich.edu/o=University%20of%20Michigan,c=US
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
40 ;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
41 ;; For simple queries, I have verified compatibility with Netscape
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
42 ;; Communicator v4.5 under GNU/Linux.
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
43 ;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
44 ;; For anything _useful_ though, like specifying the attributes,
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
45 ;; scope, filter, or extensions, netscape claims the URL format is
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
46 ;; unrecognized. So I don't think it supports anything other than the
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
47 ;; defaults (scope=base,attributes=*,filter=(objectClass=*)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
48
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
49 (defconst url-ldap-default-port 389 "Default LDAP port.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
50 (defalias 'url-ldap-expand-file-name 'url-default-expander)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
51
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
52 (defvar url-ldap-pretty-names
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
53 '(("l" . "City")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
54 ("objectclass" . "Object Class")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
55 ("o" . "Organization")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
56 ("ou" . "Organizational Unit")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
57 ("cn" . "Name")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
58 ("sn" . "Last Name")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
59 ("givenname" . "First Name")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
60 ("mail" . "Email")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
61 ("title" . "Title")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
62 ("c" . "Country")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
63 ("postalcode" . "ZIP Code")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
64 ("telephonenumber" . "Phone Number")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
65 ("facsimiletelephonenumber" . "Fax")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
66 ("postaladdress" . "Mailing Address")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
67 ("description" . "Notes"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
68 "*An assoc list mapping LDAP attribute names to pretty descriptions of them.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
69
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
70 (defvar url-ldap-attribute-formatters
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
71 '(("mail" . (lambda (x) (format "<a href='mailto:%s'>%s</a>" x x)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
72 ("owner" . url-ldap-dn-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
73 ("creatorsname" . url-ldap-dn-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
74 ("jpegphoto" . url-ldap-image-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
75 ("usercertificate" . url-ldap-certificate-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
76 ("modifiersname" . url-ldap-dn-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
77 ("namingcontexts" . url-ldap-dn-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
78 ("defaultnamingcontext" . url-ldap-dn-formatter)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
79 ("member" . url-ldap-dn-formatter))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
80 "*An assoc list mapping LDAP attribute names to pretty formatters for them.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
81
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
82 (defsubst url-ldap-attribute-pretty-name (n)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
83 (or (cdr-safe (assoc (downcase n) url-ldap-pretty-names)) n))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
84
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
85 (defsubst url-ldap-attribute-pretty-desc (n v)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
86 (if (string-match "^\\([^;]+\\);" n)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
87 (setq n (match-string 1 n)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
88 (funcall (or (cdr-safe (assoc (downcase n) url-ldap-attribute-formatters)) 'identity) v))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
89
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
90 (defun url-ldap-dn-formatter (dn)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
91 (concat "<a href='/"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
92 (url-hexify-string dn)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
93 "'>" dn "</a>"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
94
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
95 (defun url-ldap-certificate-formatter (data)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
96 (condition-case ()
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
97 (require 'ssl)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
98 (error nil))
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
99 (let ((vals (if (fboundp 'ssl-certificate-information)
57449
202c408c174b url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents: 54799
diff changeset
100 (ssl-certificate-information data)
202c408c174b url-vars.el (url-gateway-method): Add new method `tls'.
Simon Josefsson <jas@extundo.com>
parents: 54799
diff changeset
101 (tls-certificate-information data))))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
102 (if (not vals)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
103 "<b>Unable to parse certificate</b>"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
104 (concat "<table border=0>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
105 (mapconcat
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
106 (lambda (ava)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
107 (format "<tr><td>%s</td><td>%s</td></tr>\n" (car ava) (cdr ava)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
108 vals "\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
109 "</table>\n"))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
110
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
111 (defun url-ldap-image-formatter (data)
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
112 (format "<img alt='JPEG Photo' src='data:image/jpeg;base64,%s'>"
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
113 (url-hexify-string (base64-encode-string data))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
114
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
115 ;; FIXME: This needs sorting out for the Emacs LDAP functions, specifically
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
116 ;; calls of ldap-open, ldap-close, ldap-search-internal
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
117 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
118 (defun url-ldap (url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
119 (save-excursion
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
120 (set-buffer (generate-new-buffer " *url-ldap*"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
121 (setq url-current-object url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
122 (insert "Content-type: text/html\r\n\r\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
123 (if (not (fboundp 'ldap-search-internal))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
124 (insert "<html>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
125 " <head>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
126 " <title>LDAP Not Supported</title>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
127 " <base href='" (url-recreate-url url) "'>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
128 " </head>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
129 " <body>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
130 " <h1>LDAP Not Supported</h1>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
131 " <p>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
132 " This version of Emacs does not support LDAP.\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
133 " </p>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
134 " </body>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
135 "</html>\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
136 (let* ((binddn nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
137 (data (url-filename url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
138 (host (url-host url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
139 (port (url-port url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
140 (base-object nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
141 (attributes nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
142 (scope nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
143 (filter nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
144 (extensions nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
145 (connection nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
146 (results nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
147 (extract-dn (and (fboundp 'function-max-args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
148 (= (function-max-args 'ldap-search-internal) 7))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
149
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
150 ;; Get rid of leading /
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
151 (if (string-match "^/" data)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
152 (setq data (substring data 1)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
153
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
154 (setq data (mapcar (lambda (x) (if (/= (length x) 0) x nil)) (split-string data "\\?"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
155 base-object (nth 0 data)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
156 attributes (nth 1 data)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
157 scope (nth 2 data)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
158 filter (nth 3 data)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
159 extensions (nth 4 data))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
160
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
161 ;; fill in the defaults
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
162 (setq base-object (url-unhex-string (or base-object ""))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
163 scope (intern (url-unhex-string (or scope "base")))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
164 filter (url-unhex-string (or filter "(objectClass=*)")))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
165
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
166 (if (not (memq scope '(base one tree)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
167 (error "Malformed LDAP URL: Unknown scope: %S" scope))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
168
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
169 ;; Convert to the internal LDAP support scoping names.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
170 (setq scope (cdr (assq scope '((base . base) (one . onelevel) (sub . subtree)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
171
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
172 (if attributes
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
173 (setq attributes (mapcar 'url-unhex-string (split-string attributes ","))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
174
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
175 ;; Parse out the exentions
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
176 (if extensions
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
177 (setq extensions (mapcar (lambda (ext)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
178 (if (string-match "\\([^=]*\\)=\\(.*\\)" ext)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
179 (cons (match-string 1 ext) (match-string 2 ext))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
180 (cons ext ext)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
181 (split-string extensions ","))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
182 extensions (mapcar (lambda (ext)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
183 (cons (url-unhex-string (car ext))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
184 (url-unhex-string (cdr ext))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
185 extensions)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
186
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
187 (setq binddn (cdr-safe (or (assoc "bindname" extensions)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
188 (assoc "!bindname" extensions))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
189
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
190 ;; Now, let's actually do something with it.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
191 (setq connection (ldap-open host (if binddn (list 'binddn binddn)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
192 results (if extract-dn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
193 (ldap-search-internal connection filter base-object scope attributes nil t)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
194 (ldap-search-internal connection filter base-object scope attributes nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
195
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
196 (ldap-close connection)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
197 (insert "<html>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
198 " <head>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
199 " <title>LDAP Search Results</title>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
200 " <base href='" (url-recreate-url url) "'>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
201 " </head>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
202 " <body>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
203 " <h1>" (int-to-string (length results)) " matches</h1>\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
204
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
205 (mapc (lambda (obj)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
206 (insert " <hr>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
207 " <table border=1>\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
208 (if extract-dn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
209 (insert " <tr><th colspan=2>" (car obj) "</th></tr>\n"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
210 (mapc (lambda (attr)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
211 (if (= (length (cdr attr)) 1)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
212 ;; single match, easy
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
213 (insert " <tr><td>"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
214 (url-ldap-attribute-pretty-name (car attr))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
215 "</td><td>"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
216 (url-ldap-attribute-pretty-desc (car attr) (car (cdr attr)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
217 "</td></tr>\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
218 ;; Multiple matches, slightly uglier
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
219 (insert " <tr>\n"
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
220 (format " <td valign=top>")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
221 (url-ldap-attribute-pretty-name (car attr)) "</td><td>"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
222 (mapconcat (lambda (x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
223 (url-ldap-attribute-pretty-desc (car attr) x))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
224 (cdr attr)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
225 "<br>\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
226 "</td>"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
227 " </tr>\n")))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
228 (if extract-dn (cdr obj) obj))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
229 (insert " </table>\n"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
230 results)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
231
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
232 (insert " <hr>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
233 " </body>\n"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
234 "</html>\n")))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
235 (current-buffer)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
236
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
237 (provide 'url-ldap)
54699
7784ae10206d Resolve CVS conflicts
Miles Bader <miles@gnu.org>
parents: 54695
diff changeset
238
54799
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
239 ;; arch-tag: 6230e21c-41ae-4174-bd83-82c835676fc8
e74e244a3cff (ldap): Require.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
240 ;;; url-ldap.el ends here