Mercurial > hg > xemacs-beta
annotate lisp/ldap.el @ 5043:d0c14ea98592
various frame-geometry fixes
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-15 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameResize):
* console-msw-impl.h:
* console-msw-impl.h (struct mswindows_frame):
* console-msw-impl.h (FRAME_MSWINDOWS_TARGET_RECT):
* device-tty.c:
* device-tty.c (tty_asynch_device_change):
* event-msw.c:
* event-msw.c (mswindows_wnd_proc):
* faces.c (Fface_list):
* faces.h:
* frame-gtk.c:
* frame-gtk.c (gtk_set_initial_frame_size):
* frame-gtk.c (gtk_set_frame_size):
* frame-msw.c:
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_set_frame_size):
* frame-msw.c (mswindows_size_frame_internal):
* frame-msw.c (msprinter_init_frame_3):
* frame.c:
* frame.c (enum):
* frame.c (Fmake_frame):
* frame.c (adjust_frame_size):
* frame.c (store_minibuf_frame_prop):
* frame.c (Fframe_property):
* frame.c (Fframe_properties):
* frame.c (Fframe_displayable_pixel_height):
* frame.c (Fframe_displayable_pixel_width):
* frame.c (internal_set_frame_size):
* frame.c (Fset_frame_height):
* frame.c (Fset_frame_pixel_height):
* frame.c (Fset_frame_displayable_pixel_height):
* frame.c (Fset_frame_width):
* frame.c (Fset_frame_pixel_width):
* frame.c (Fset_frame_displayable_pixel_width):
* frame.c (Fset_frame_size):
* frame.c (Fset_frame_pixel_size):
* frame.c (Fset_frame_displayable_pixel_size):
* frame.c (frame_conversion_internal_1):
* frame.c (get_frame_displayable_pixel_size):
* frame.c (change_frame_size_1):
* frame.c (change_frame_size):
* frame.c (generate_title_string):
* frame.h:
* gtk-xemacs.c:
* gtk-xemacs.c (gtk_xemacs_size_request):
* gtk-xemacs.c (gtk_xemacs_size_allocate):
* gtk-xemacs.c (gtk_xemacs_paint):
* gutter.c:
* gutter.c (update_gutter_geometry):
* redisplay.c (end_hold_frame_size_changes):
* redisplay.c (redisplay_frame):
* toolbar.c:
* toolbar.c (update_frame_toolbars_geometry):
* window.c:
* window.c (frame_pixsize_valid_p):
* window.c (check_frame_size):
Various fixes to frame geometry to make it a bit easier to understand
and fix some bugs.
1. IMPORTANT: Some renamings. Will need to be applied carefully to
the carbon repository, in the following order:
-- pixel_to_char_size -> pixel_to_frame_unit_size
-- char_to_pixel_size -> frame_unit_to_pixel_size
-- pixel_to_real_char_size -> pixel_to_char_size
-- char_to_real_pixel_size -> char_to_pixel_size
-- Reverse second and third arguments of change_frame_size() and
change_frame_size_1() to try to make functions consistent in
putting width before height.
-- Eliminate old round_size_to_char, because it didn't really
do anything differently from round_size_to_real_char()
-- round_size_to_real_char -> round_size_to_char; any places that
called the old round_size_to_char should just call the new one.
2. IMPORTANT FOR CARBON: The set_frame_size() method is now passed
sizes in "frame units", like all other frame-sizing functions,
rather than some hacked-up combination of char-cell units and
total pixel size. This only affects window systems that use
"pixelated geometry", and I'm not sure if Carbon is one of them.
MS Windows is pixelated, X and GTK are not. For pixelated-geometry
systems, the size in set_frame_size() is in displayable pixels
rather than total pixels and needs to be converted appropriately;
take a look at the changes made to mswindows_set_frame_size()
method if necessary.
3. Add a big long comment in frame.c describing how frame geometry
works.
4. Remove MS Windows-specific character height and width fields,
duplicative and unused.
5. frame-displayable-pixel-* and set-frame-displayable-pixel-*
didn't use to work on MS Windows, but they do now.
6. In general, clean up the handling of "pixelated geometry" so
that fewer functions have to worry about this. This is really
an abomination that should be removed entirely but that will
have to happen later. Fix some buggy code in
frame_conversion_internal() that happened to "work" because it
was countered by oppositely buggy code in change_frame_size().
7. Clean up some frame-size code in toolbar.c and use functions
already provided in frame.c instead of rolling its own.
8. Fix check_frame_size() in window.c, which formerly didn't take
pixelated geometry into account.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 15 Feb 2010 22:14:11 -0600 |
| parents | e29fcfd8df5f |
| children | f00192e1cd49 91b3aa59f49b |
| rev | line source |
|---|---|
| 428 | 1 ;;; ldap.el --- LDAP support for Emacs |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 4 | |
| 5 ;; Author: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> | |
| 6 ;; Maintainer: Oscar Figueiredo <Oscar.Figueiredo@di.epfl.ch> | |
| 7 ;; Created: Jan 1998 | |
| 502 | 8 ;; Version: $Revision: 1.12 $ |
| 428 | 9 ;; Keywords: help comm |
| 10 | |
| 11 ;; This file is part of XEmacs | |
| 12 | |
| 13 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 14 ;; under the terms of the GNU General Public License as published by | |
| 15 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 16 ;; any later version. | |
| 17 | |
| 18 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 21 ;; General Public License for more details. | |
| 22 | |
| 23 ;; You should have received a copy of the GNU General Public License | |
| 444 | 24 ;; along with XEmacs; see the file COPYING. If not, write to |
| 428 | 25 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 26 ;; Boston, MA 02111-1307, USA. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 ;; This file provides mid-level and user-level functions to access directory | |
| 444 | 30 ;; servers using the LDAP protocol (RFC 1777). |
| 428 | 31 |
| 32 ;;; Installation: | |
| 33 ;; LDAP support must have been built into XEmacs. | |
| 34 | |
| 35 | |
| 36 ;;; Code: | |
| 37 | |
| 502 | 38 (globally-declare-fboundp '(ldapp ldap-open ldap-close ldap-add ldap-modify |
| 39 ldap-delete)) | |
| 40 | |
| 442 | 41 (eval-when '(load) |
| 42 (if (not (fboundp 'ldap-open)) | |
| 43 (error "No LDAP support compiled in this XEmacs"))) | |
| 44 | |
| 428 | 45 (defgroup ldap nil |
| 46 "Lightweight Directory Access Protocol" | |
| 47 :group 'comm) | |
| 48 | |
| 49 (defcustom ldap-default-host nil | |
| 50 "*Default LDAP server hostname. | |
| 444 | 51 A TCP port number can be appended to that name using a colon as |
| 428 | 52 a separator." |
| 53 :type '(choice (string :tag "Host name") | |
| 54 (const :tag "Use library default" nil)) | |
| 55 :group 'ldap) | |
| 56 | |
| 57 (defcustom ldap-default-port nil | |
| 58 "*Default TCP port for LDAP connections. | |
| 59 Initialized from the LDAP library at build time. Default value is 389." | |
| 60 :type '(choice (const :tag "Use library default" nil) | |
| 61 (integer :tag "Port number")) | |
| 62 :group 'ldap) | |
| 63 | |
| 64 (defcustom ldap-default-base nil | |
| 65 "*Default base for LDAP searches. | |
| 66 This is a string using the syntax of RFC 1779. | |
| 67 For instance, \"o=ACME, c=US\" limits the search to the | |
| 68 Acme organization in the United States." | |
| 69 :type '(choice (const :tag "Use library default" nil) | |
| 70 (string :tag "Search base")) | |
| 71 :group 'ldap) | |
| 72 | |
| 73 | |
| 74 (defcustom ldap-host-parameters-alist nil | |
| 75 "*Alist of host-specific options for LDAP transactions. | |
| 76 The format of each list element is: | |
| 77 \(HOST PROP1 VAL1 PROP2 VAL2 ...) | |
| 78 HOST is the hostname of an LDAP server (with an optional TCP port number | |
| 444 | 79 appended to it using a colon as a separator). |
| 428 | 80 PROPn and VALn are property/value pairs describing parameters for the server. |
| 81 Valid properties include: | |
| 444 | 82 `binddn' is the distinguished name of the user to bind as |
| 428 | 83 (in RFC 1779 syntax). |
| 84 `passwd' is the password to use for simple authentication. | |
| 444 | 85 `auth' is the authentication method to use. |
| 428 | 86 Possible values are: `simple', `krbv41' and `krbv42'. |
| 87 `base' is the base for the search as described in RFC 1779. | |
| 88 `scope' is one of the three symbols `subtree', `base' or `onelevel'. | |
| 89 `deref' is one of the symbols `never', `always', `search' or `find'. | |
| 90 `timelimit' is the timeout limit for the connection in seconds. | |
| 91 `sizelimit' is the maximum number of matches to return." | |
| 92 :type '(repeat :menu-tag "Host parameters" | |
| 93 :tag "Host parameters" | |
| 94 (list :menu-tag "Host parameters" | |
| 95 :tag "Host parameters" | |
| 96 :value nil | |
| 97 (string :tag "Host name") | |
| 98 (checklist :inline t | |
| 99 :greedy t | |
| 100 (list | |
| 444 | 101 :tag "Search Base" |
| 428 | 102 :inline t |
| 103 (const :tag "Search Base" base) | |
| 104 string) | |
| 105 (list | |
| 106 :tag "Binding DN" | |
| 107 :inline t | |
| 108 (const :tag "Binding DN" binddn) | |
| 109 string) | |
| 110 (list | |
| 111 :tag "Password" | |
| 112 :inline t | |
| 113 (const :tag "Password" passwd) | |
| 114 string) | |
| 115 (list | |
| 116 :tag "Authentication Method" | |
| 117 :inline t | |
| 118 (const :tag "Authentication Method" auth) | |
| 119 (choice | |
| 120 (const :menu-tag "None" :tag "None" nil) | |
| 121 (const :menu-tag "Simple" :tag "Simple" simple) | |
| 122 (const :menu-tag "Kerberos 4.1" :tag "Kerberos 4.1" krbv41) | |
| 123 (const :menu-tag "Kerberos 4.2" :tag "Kerberos 4.2" krbv42))) | |
| 124 (list | |
| 444 | 125 :tag "Search Scope" |
| 428 | 126 :inline t |
| 127 (const :tag "Search Scope" scope) | |
| 128 (choice | |
| 129 (const :menu-tag "Default" :tag "Default" nil) | |
| 130 (const :menu-tag "Subtree" :tag "Subtree" subtree) | |
| 131 (const :menu-tag "Base" :tag "Base" base) | |
| 132 (const :menu-tag "One Level" :tag "One Level" onelevel))) | |
| 133 (list | |
| 134 :tag "Dereferencing" | |
| 135 :inline t | |
| 136 (const :tag "Dereferencing" deref) | |
| 137 (choice | |
| 138 (const :menu-tag "Default" :tag "Default" nil) | |
| 139 (const :menu-tag "Never" :tag "Never" never) | |
| 140 (const :menu-tag "Always" :tag "Always" always) | |
| 141 (const :menu-tag "When searching" :tag "When searching" search) | |
| 142 (const :menu-tag "When locating base" :tag "When locating base" find))) | |
| 143 (list | |
| 144 :tag "Time Limit" | |
| 145 :inline t | |
| 146 (const :tag "Time Limit" timelimit) | |
| 147 (integer :tag "(in seconds)")) | |
| 148 (list | |
| 149 :tag "Size Limit" | |
| 150 :inline t | |
| 151 (const :tag "Size Limit" sizelimit) | |
| 152 (integer :tag "(number of records)"))))) | |
| 153 :group 'ldap) | |
| 154 | |
| 442 | 155 (defcustom ldap-verbose nil |
| 156 "*If non-nil, LDAP operations echo progress messages." | |
| 157 :type 'boolean | |
| 158 :group 'ldap) | |
| 159 | |
| 428 | 160 (defcustom ldap-ignore-attribute-codings nil |
| 161 "*If non-nil, do not perform any encoding/decoding on LDAP attribute values." | |
| 162 :type 'boolean | |
| 163 :group 'ldap) | |
| 164 | |
| 165 (defcustom ldap-default-attribute-decoder nil | |
| 166 "*Decoder function to use for attributes whose syntax is unknown." | |
| 167 :type 'symbol | |
| 168 :group 'ldap) | |
| 169 | |
| 170 (defcustom ldap-coding-system nil | |
| 171 "*Coding system of LDAP string values. | |
| 444 | 172 LDAP v3 specifies the coding system of strings to be UTF-8. |
| 428 | 173 Mule support is needed for this." |
| 174 :type 'symbol | |
| 175 :group 'ldap) | |
| 176 | |
| 177 (defvar ldap-attribute-syntax-encoders | |
| 444 | 178 [nil ; 1 ACI Item N |
| 179 nil ; 2 Access Point Y | |
| 180 nil ; 3 Attribute Type Description Y | |
| 181 nil ; 4 Audio N | |
| 182 nil ; 5 Binary N | |
| 183 nil ; 6 Bit String Y | |
| 184 ldap-encode-boolean ; 7 Boolean Y | |
| 185 nil ; 8 Certificate N | |
| 186 nil ; 9 Certificate List N | |
| 187 nil ; 10 Certificate Pair N | |
| 188 ldap-encode-country-string ; 11 Country String Y | |
| 189 ldap-encode-string ; 12 DN Y | |
| 190 nil ; 13 Data Quality Syntax Y | |
| 191 nil ; 14 Delivery Method Y | |
| 192 ldap-encode-string ; 15 Directory String Y | |
| 193 nil ; 16 DIT Content Rule Description Y | |
| 194 nil ; 17 DIT Structure Rule Description Y | |
| 195 nil ; 18 DL Submit Permission Y | |
| 196 nil ; 19 DSA Quality Syntax Y | |
| 197 nil ; 20 DSE Type Y | |
| 198 nil ; 21 Enhanced Guide Y | |
| 199 nil ; 22 Facsimile Telephone Number Y | |
| 200 nil ; 23 Fax N | |
| 201 nil ; 24 Generalized Time Y | |
| 202 nil ; 25 Guide Y | |
| 203 nil ; 26 IA5 String Y | |
| 204 number-to-string ; 27 INTEGER Y | |
| 205 nil ; 28 JPEG N | |
| 206 nil ; 29 Master And Shadow Access Points Y | |
| 207 nil ; 30 Matching Rule Description Y | |
| 208 nil ; 31 Matching Rule Use Description Y | |
| 209 nil ; 32 Mail Preference Y | |
| 210 nil ; 33 MHS OR Address Y | |
| 211 nil ; 34 Name And Optional UID Y | |
| 212 nil ; 35 Name Form Description Y | |
| 213 nil ; 36 Numeric String Y | |
| 214 nil ; 37 Object Class Description Y | |
| 215 nil ; 38 OID Y | |
| 216 nil ; 39 Other Mailbox Y | |
| 217 nil ; 40 Octet String Y | |
| 218 ldap-encode-address ; 41 Postal Address Y | |
| 219 nil ; 42 Protocol Information Y | |
| 220 nil ; 43 Presentation Address Y | |
| 221 ldap-encode-string ; 44 Printable String Y | |
| 222 nil ; 45 Subtree Specification Y | |
| 223 nil ; 46 Supplier Information Y | |
| 224 nil ; 47 Supplier Or Consumer Y | |
| 225 nil ; 48 Supplier And Consumer Y | |
| 226 nil ; 49 Supported Algorithm N | |
| 227 nil ; 50 Telephone Number Y | |
| 228 nil ; 51 Teletex Terminal Identifier Y | |
| 229 nil ; 52 Telex Number Y | |
| 230 nil ; 53 UTC Time Y | |
| 231 nil ; 54 LDAP Syntax Description Y | |
| 232 nil ; 55 Modify Rights Y | |
| 233 nil ; 56 LDAP Schema Definition Y | |
| 234 nil ; 57 LDAP Schema Description Y | |
| 235 nil ; 58 Substring Assertion Y | |
| 236 ] | |
| 428 | 237 "A vector of functions used to encode LDAP attribute values. |
| 238 The sequence of functions corresponds to the sequence of LDAP attribute syntax | |
| 444 | 239 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in |
| 428 | 240 RFC2252 section 4.3.2") |
| 241 | |
| 242 (defvar ldap-attribute-syntax-decoders | |
| 444 | 243 [nil ; 1 ACI Item N |
| 244 nil ; 2 Access Point Y | |
| 245 nil ; 3 Attribute Type Description Y | |
| 246 nil ; 4 Audio N | |
| 247 nil ; 5 Binary N | |
| 248 nil ; 6 Bit String Y | |
| 249 ldap-decode-boolean ; 7 Boolean Y | |
| 250 nil ; 8 Certificate N | |
| 251 nil ; 9 Certificate List N | |
| 252 nil ; 10 Certificate Pair N | |
| 253 ldap-decode-string ; 11 Country String Y | |
| 254 ldap-decode-string ; 12 DN Y | |
| 255 nil ; 13 Data Quality Syntax Y | |
| 256 nil ; 14 Delivery Method Y | |
| 257 ldap-decode-string ; 15 Directory String Y | |
| 258 nil ; 16 DIT Content Rule Description Y | |
| 259 nil ; 17 DIT Structure Rule Description Y | |
| 260 nil ; 18 DL Submit Permission Y | |
| 261 nil ; 19 DSA Quality Syntax Y | |
| 262 nil ; 20 DSE Type Y | |
| 263 nil ; 21 Enhanced Guide Y | |
| 264 nil ; 22 Facsimile Telephone Number Y | |
| 265 nil ; 23 Fax N | |
| 266 nil ; 24 Generalized Time Y | |
| 267 nil ; 25 Guide Y | |
| 268 nil ; 26 IA5 String Y | |
| 269 string-to-number ; 27 INTEGER Y | |
| 270 nil ; 28 JPEG N | |
| 271 nil ; 29 Master And Shadow Access Points Y | |
| 272 nil ; 30 Matching Rule Description Y | |
| 273 nil ; 31 Matching Rule Use Description Y | |
| 274 nil ; 32 Mail Preference Y | |
| 275 nil ; 33 MHS OR Address Y | |
| 276 nil ; 34 Name And Optional UID Y | |
| 277 nil ; 35 Name Form Description Y | |
| 278 nil ; 36 Numeric String Y | |
| 279 nil ; 37 Object Class Description Y | |
| 280 nil ; 38 OID Y | |
| 281 nil ; 39 Other Mailbox Y | |
| 282 nil ; 40 Octet String Y | |
| 283 ldap-decode-address ; 41 Postal Address Y | |
| 284 nil ; 42 Protocol Information Y | |
| 285 nil ; 43 Presentation Address Y | |
| 286 ldap-decode-string ; 44 Printable String Y | |
| 287 nil ; 45 Subtree Specification Y | |
| 288 nil ; 46 Supplier Information Y | |
| 289 nil ; 47 Supplier Or Consumer Y | |
| 290 nil ; 48 Supplier And Consumer Y | |
| 291 nil ; 49 Supported Algorithm N | |
| 292 nil ; 50 Telephone Number Y | |
| 293 nil ; 51 Teletex Terminal Identifier Y | |
| 294 nil ; 52 Telex Number Y | |
| 295 nil ; 53 UTC Time Y | |
| 296 nil ; 54 LDAP Syntax Description Y | |
| 297 nil ; 55 Modify Rights Y | |
| 298 nil ; 56 LDAP Schema Definition Y | |
| 299 nil ; 57 LDAP Schema Description Y | |
| 300 nil ; 58 Substring Assertion Y | |
| 301 ] | |
| 428 | 302 "A vector of functions used to decode LDAP attribute values. |
| 303 The sequence of functions corresponds to the sequence of LDAP attribute syntax | |
| 444 | 304 object identifiers of the form 1.3.6.1.4.1.1466.1115.121.1.* as defined in |
| 428 | 305 RFC2252 section 4.3.2") |
| 306 | |
| 307 | |
| 308 (defvar ldap-attribute-syntaxes-alist | |
| 309 '((createtimestamp . 24) | |
| 310 (modifytimestamp . 24) | |
| 311 (creatorsname . 12) | |
| 312 (modifiersname . 12) | |
| 313 (subschemasubentry . 12) | |
| 314 (attributetypes . 3) | |
| 315 (objectclasses . 37) | |
| 316 (matchingrules . 30) | |
| 317 (matchingruleuse . 31) | |
| 318 (namingcontexts . 12) | |
| 319 (altserver . 26) | |
| 320 (supportedextension . 38) | |
| 321 (supportedcontrol . 38) | |
| 322 (supportedsaslmechanisms . 15) | |
| 323 (supportedldapversion . 27) | |
| 324 (ldapsyntaxes . 16) | |
| 325 (ditstructurerules . 17) | |
| 326 (nameforms . 35) | |
| 327 (ditcontentrules . 16) | |
| 328 (objectclass . 38) | |
| 329 (aliasedobjectname . 12) | |
| 330 (cn . 15) | |
| 331 (sn . 15) | |
| 332 (serialnumber . 44) | |
| 333 (c . 15) | |
| 334 (l . 15) | |
| 335 (st . 15) | |
| 336 (street . 15) | |
| 337 (o . 15) | |
| 338 (ou . 15) | |
| 339 (title . 15) | |
| 340 (description . 15) | |
| 341 (searchguide . 25) | |
| 342 (businesscategory . 15) | |
| 343 (postaladdress . 41) | |
| 344 (postalcode . 15) | |
| 345 (postofficebox . 15) | |
| 346 (physicaldeliveryofficename . 15) | |
| 347 (telephonenumber . 50) | |
| 348 (telexnumber . 52) | |
| 349 (telexterminalidentifier . 51) | |
| 350 (facsimiletelephonenumber . 22) | |
| 351 (x121address . 36) | |
| 352 (internationalisdnnumber . 36) | |
| 353 (registeredaddress . 41) | |
| 354 (destinationindicator . 44) | |
| 355 (preferreddeliverymethod . 14) | |
| 356 (presentationaddress . 43) | |
| 357 (supportedapplicationcontext . 38) | |
| 358 (member . 12) | |
| 359 (owner . 12) | |
| 360 (roleoccupant . 12) | |
| 361 (seealso . 12) | |
| 362 (userpassword . 40) | |
| 363 (usercertificate . 8) | |
| 364 (cacertificate . 8) | |
| 365 (authorityrevocationlist . 9) | |
| 366 (certificaterevocationlist . 9) | |
| 367 (crosscertificatepair . 10) | |
| 368 (name . 15) | |
| 369 (givenname . 15) | |
| 370 (initials . 15) | |
| 371 (generationqualifier . 15) | |
| 372 (x500uniqueidentifier . 6) | |
| 373 (dnqualifier . 44) | |
| 374 (enhancedsearchguide . 21) | |
| 375 (protocolinformation . 42) | |
| 376 (distinguishedname . 12) | |
| 377 (uniquemember . 34) | |
| 378 (houseidentifier . 15) | |
| 379 (supportedalgorithms . 49) | |
| 380 (deltarevocationlist . 9) | |
| 381 (dmdname . 15)) | |
| 382 "A map of LDAP attribute names to their type object id minor number. | |
| 383 This table is built from RFC2252 Section 5 and RFC2256 Section 5") | |
| 384 | |
| 385 | |
| 386 ;; Coding/decoding functions | |
| 387 | |
| 388 (defun ldap-encode-boolean (bool) | |
| 389 (if bool | |
| 390 "TRUE" | |
| 391 "FALSE")) | |
| 392 | |
| 393 (defun ldap-decode-boolean (str) | |
| 394 (cond | |
| 395 ((string-equal str "TRUE") | |
| 396 t) | |
| 397 ((string-equal str "FALSE") | |
| 398 nil) | |
| 399 (t | |
| 400 (error "Wrong LDAP boolean string: %s" str)))) | |
| 444 | 401 |
| 428 | 402 (defun ldap-encode-country-string (str) |
| 403 ;; We should do something useful here... | |
| 404 (if (not (= 2 (length str))) | |
| 405 (error "Invalid country string: %s" str))) | |
| 406 | |
| 407 (defun ldap-decode-string (str) | |
| 408 (if (fboundp 'decode-coding-string) | |
| 409 (decode-coding-string str ldap-coding-system))) | |
| 410 | |
| 411 (defun ldap-encode-string (str) | |
| 412 (if (fboundp 'encode-coding-string) | |
| 413 (encode-coding-string str ldap-coding-system))) | |
| 414 | |
| 415 (defun ldap-decode-address (str) | |
| 416 (mapconcat 'ldap-decode-string | |
| 417 (split-string str "\\$") | |
| 418 "\n")) | |
| 419 | |
| 420 (defun ldap-encode-address (str) | |
| 421 (mapconcat 'ldap-encode-string | |
| 422 (split-string str "\n") | |
| 423 "$")) | |
| 424 | |
| 425 | |
| 426 ;; LDAP protocol functions | |
| 444 | 427 |
| 428 | 428 (defun ldap-get-host-parameter (host parameter) |
| 429 "Get the value of PARAMETER for HOST in `ldap-host-parameters-alist'." | |
| 430 (plist-get (cdr (assoc host ldap-host-parameters-alist)) | |
| 431 parameter)) | |
| 444 | 432 |
| 428 | 433 (defun ldap-decode-attribute (attr) |
| 434 "Decode the attribute/value pair ATTR according to LDAP rules. | |
| 444 | 435 The attribute name is looked up in `ldap-attribute-syntaxes-alist' |
| 436 and the corresponding decoder is then retrieved from | |
| 428 | 437 `ldap-attribute-syntax-decoders' and applied on the value(s)." |
| 438 (let* ((name (car attr)) | |
| 439 (values (cdr attr)) | |
| 440 (syntax-id (cdr (assq (intern (downcase name)) | |
| 441 ldap-attribute-syntaxes-alist))) | |
| 442 decoder) | |
| 443 (if syntax-id | |
| 444 (setq decoder (aref ldap-attribute-syntax-decoders | |
| 445 (1- syntax-id))) | |
| 446 (setq decoder ldap-default-attribute-decoder)) | |
| 447 (if decoder | |
| 448 (cons name (mapcar decoder values)) | |
| 449 attr))) | |
| 450 | |
| 442 | 451 (defun ldap-decode-entry (entry) |
| 452 "Decode the attributes of ENTRY according to LDAP rules." | |
| 453 (let (dn decoded) | |
| 454 (setq dn (car entry)) | |
| 455 (if (stringp dn) | |
| 456 (setq entry (cdr entry)) | |
| 457 (setq dn nil)) | |
| 458 (setq decoded (mapcar 'ldap-decode-attribute entry)) | |
| 459 (if dn | |
| 460 (cons dn decoded) | |
| 461 decoded))) | |
| 462 | |
| 463 (defun ldap-search (arg1 &rest args) | |
| 444 | 464 "Perform an LDAP search." |
| 442 | 465 (apply (if (ldapp arg1) |
| 466 'ldap-search-basic | |
| 467 'ldap-search-entries) arg1 args)) | |
| 468 | |
| 444 | 469 (make-obsolete 'ldap-search |
| 470 "Use `ldap-search-entries' instead or | |
| 442 | 471 `ldap-search-basic' for the low-level search API.") |
| 472 | |
| 473 (defun ldap-search-entries (filter &optional host attributes attrsonly withdn) | |
| 428 | 474 "Perform an LDAP search. |
| 475 FILTER is the search filter in RFC1558 syntax, i.e., something that | |
| 476 looks like \"(cn=John Smith)\". | |
| 477 HOST is the LDAP host on which to perform the search. | |
| 478 ATTRIBUTES is a list of attributes to retrieve; nil means retrieve all. | |
| 479 If ATTRSONLY is non nil, the attributes will be retrieved without | |
| 480 the associated values. | |
| 481 If WITHDN is non-nil each entry in the result will be prepennded with | |
| 482 its distinguished name DN. | |
| 444 | 483 Additional search parameters can be specified through |
| 428 | 484 `ldap-host-parameters-alist' which see. |
| 485 The function returns a list of matching entries. Each entry is itself | |
| 486 an alist of attribute/value pairs optionally preceded by the DN of the | |
| 487 entry according to the value of WITHDN." | |
| 488 (interactive "sFilter:") | |
| 489 (or host | |
| 490 (setq host ldap-default-host) | |
| 491 (error "No LDAP host specified")) | |
| 492 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 493 ldap | |
| 494 result) | |
| 442 | 495 (if ldap-verbose |
| 496 (message "Opening LDAP connection to %s..." host)) | |
| 428 | 497 (setq ldap (ldap-open host host-plist)) |
| 442 | 498 (if ldap-verbose |
| 499 (message "Searching with LDAP on %s..." host)) | |
| 444 | 500 (setq result (ldap-search ldap filter |
| 442 | 501 (plist-get host-plist 'base) |
| 502 (plist-get host-plist 'scope) | |
| 503 attributes attrsonly withdn | |
| 504 ldap-verbose)) | |
| 428 | 505 (ldap-close ldap) |
| 506 (if ldap-ignore-attribute-codings | |
| 507 result | |
| 442 | 508 (mapcar 'ldap-decode-entry result)))) |
| 509 | |
| 510 (defun ldap-add-entries (entries &optional host binddn passwd) | |
| 511 "Add entries to an LDAP directory. | |
| 444 | 512 ENTRIES is a list of entry specifications of |
| 442 | 513 the form (DN (ATTR . VALUE) (ATTR . VALUE) ...) where |
| 514 DN is the distinguished name of an entry to add, the following | |
| 515 are cons cells containing attribute/value string pairs. | |
| 444 | 516 HOST is the LDAP host, defaulting to `ldap-default-host'. |
| 517 BINDDN is the DN to bind as to the server. | |
| 518 PASSWD is the corresponding password." | |
| 442 | 519 (or host |
| 520 (setq host ldap-default-host) | |
| 521 (error "No LDAP host specified")) | |
| 522 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 523 ldap | |
| 524 (i 1)) | |
| 525 (if (or binddn passwd) | |
| 526 (setq host-plist (copy-seq host-plist))) | |
| 527 (if binddn | |
| 528 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
| 529 (if passwd | |
| 530 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
| 531 (if ldap-verbose | |
| 532 (message "Opening LDAP connection to %s..." host)) | |
| 533 (setq ldap (ldap-open host host-plist)) | |
| 534 (if ldap-verbose | |
| 535 (message "Adding LDAP entries...")) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
536 (mapc (function |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
537 (lambda (thisentry) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
538 (ldap-add ldap (car thisentry) (cdr thisentry)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
539 (if ldap-verbose |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
540 (message "%d added" i)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
541 (setq i (1+ i)))) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
542 entries) |
| 442 | 543 (ldap-close ldap))) |
| 544 | |
| 545 | |
| 546 (defun ldap-modify-entries (entry-mods &optional host binddn passwd) | |
| 547 "Modify entries of an LDAP directory. | |
| 444 | 548 ENTRY_MODS is a list of entry modifications of the form |
| 549 (DN MOD-SPEC1 MOD-SPEC2 ...) where DN is the distinguished name of | |
| 550 the entry to modify, the following are modification specifications. | |
| 551 A modification specification is itself a list of the form | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
552 \(MOD-OP ATTR VALUE1 VALUE2 ...) MOD-OP and ATTR are mandatory, |
| 442 | 553 VALUEs are optional depending on MOD-OP. |
| 554 MOD-OP is the type of modification, one of the symbols `add', `delete' | |
| 555 or `replace'. ATTR is the LDAP attribute type to modify. | |
| 444 | 556 HOST is the LDAP host, defaulting to `ldap-default-host'. |
| 557 BINDDN is the DN to bind as to the server. | |
| 558 PASSWD is the corresponding password." | |
| 442 | 559 (or host |
| 560 (setq host ldap-default-host) | |
| 561 (error "No LDAP host specified")) | |
| 562 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 563 ldap | |
| 564 (i 1)) | |
| 565 (if (or binddn passwd) | |
| 566 (setq host-plist (copy-seq host-plist))) | |
| 567 (if binddn | |
| 568 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
| 569 (if passwd | |
| 570 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
| 571 (if ldap-verbose | |
| 572 (message "Opening LDAP connection to %s..." host)) | |
| 573 (setq ldap (ldap-open host host-plist)) | |
| 574 (if ldap-verbose | |
| 575 (message "Modifying LDAP entries...")) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
576 (mapc (function |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
577 (lambda (thisentry) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
578 (ldap-modify ldap (car thisentry) (cdr thisentry)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
579 (if ldap-verbose |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
580 (message "%d modified" i)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
581 (setq i (1+ i)))) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
582 entry-mods) |
| 442 | 583 (ldap-close ldap))) |
| 584 | |
| 585 | |
| 586 (defun ldap-delete-entries (dn &optional host binddn passwd) | |
| 587 "Delete an entry from an LDAP directory. | |
| 444 | 588 DN is the distinguished name of an entry to delete or |
| 442 | 589 a list of those. |
| 444 | 590 HOST is the LDAP host, defaulting to `ldap-default-host'. |
| 591 BINDDN is the DN to bind as to the server. | |
| 442 | 592 PASSWD is the corresponding password." |
| 593 (or host | |
| 594 (setq host ldap-default-host) | |
| 595 (error "No LDAP host specified")) | |
| 596 (let ((host-plist (cdr (assoc host ldap-host-parameters-alist))) | |
| 597 ldap) | |
| 598 (if (or binddn passwd) | |
| 599 (setq host-plist (copy-seq host-plist))) | |
| 600 (if binddn | |
| 601 (setq host-plist (plist-put host-plist 'binddn binddn))) | |
| 602 (if passwd | |
| 603 (setq host-plist (plist-put host-plist 'passwd passwd))) | |
| 604 (if ldap-verbose | |
| 605 (message "Opening LDAP connection to %s..." host)) | |
| 606 (setq ldap (ldap-open host host-plist)) | |
| 607 (if (consp dn) | |
| 608 (let ((i 1)) | |
| 609 (if ldap-verbose | |
| 610 (message "Deleting LDAP entries...")) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
611 (mapc (function |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
612 (lambda (thisdn) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
613 (ldap-delete ldap thisdn) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
614 (if ldap-verbose |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
615 (message "%d deleted" i)) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
616 (setq i (1+ i)))) |
|
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
502
diff
changeset
|
617 dn)) |
| 442 | 618 (if ldap-verbose |
| 619 (message "Deleting LDAP entry...")) | |
| 620 (ldap-delete ldap dn)) | |
| 621 (ldap-close ldap))) | |
| 622 | |
| 428 | 623 |
| 624 (provide 'ldap) | |
| 444 | 625 |
| 428 | 626 ;;; ldap.el ends here |