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