From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Filipp Gunbin Newsgroups: gmane.emacs.devel Subject: Fix eudc-get-attribute-list: please review Date: Wed, 13 Apr 2022 23:14:55 +0300 Message-ID: Mime-Version: 1.0 Content-Type: text/plain Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="40862"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/29.0.50 (darwin) Cc: emacs-devel@gnu.org To: fitzsim@fitzsim.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Wed Apr 13 22:16:12 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1nejPN-000AJ5-LR for ged-emacs-devel@m.gmane-mx.org; Wed, 13 Apr 2022 22:16:11 +0200 Original-Received: from localhost ([::1]:54188 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nejPM-0000I0-KF for ged-emacs-devel@m.gmane-mx.org; Wed, 13 Apr 2022 16:16:08 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:56632) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nejOM-0007xV-Sh for emacs-devel@gnu.org; Wed, 13 Apr 2022 16:15:06 -0400 Original-Received: from wout4-smtp.messagingengine.com ([64.147.123.20]:40015) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nejOK-0004p4-Kj for emacs-devel@gnu.org; Wed, 13 Apr 2022 16:15:06 -0400 Original-Received: from compute1.internal (compute1.nyi.internal [10.202.2.41]) by mailout.west.internal (Postfix) with ESMTP id E53463201F82; Wed, 13 Apr 2022 16:15:00 -0400 (EDT) Original-Received: from mailfrontend1 ([10.202.2.162]) by compute1.internal (MEProxy); Wed, 13 Apr 2022 16:15:01 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=fastmail.fm; h= cc:cc:content-type:date:date:from:from:in-reply-to:message-id :mime-version:reply-to:sender:subject:subject:to:to; s=fm1; t= 1649880900; x=1649967300; bh=cCJo4SpwOy2mhPswTTiHCGnUxboLketzSbs +rVQUQqU=; b=FBZz/MAqp7RGiHIOaqyBlRTWK9tmXyiV/bdPU6HhG4/bmXgqD6M oySHgtNzB5PFpIlugfoReZ3uPfiFSsH/HxiPLGiYKokzlI/7FKQs2WUpv3KJOAt8 EtNqPC5Jjd/q+JHdt7uidbUsZpINiYRZNUrgzQC4+V4q1QRnQmkOloYzjQJ1Cl2h ecMk6+ldz9NXfD0AeoGdyzjv0VWbPl1xWXGqXOreNPUkFmZ7FvJR/tGOkWLl7gmO kFsrKgwCHHo7m9BVK0EJucHQiIzdabSjk2/YqesW+SNqIE4McRkEyCdcqPhGUzXh ptnrWuqAXLNqqzrRLLYBhNz4TUX9C/eYQ3w== DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d= messagingengine.com; h=cc:cc:content-type:date:date:from:from :in-reply-to:message-id:mime-version:reply-to:sender:subject :subject:to:to:x-me-proxy:x-me-proxy:x-me-sender:x-me-sender :x-sasl-enc; s=fm1; t=1649880900; x=1649967300; bh=cCJo4SpwOy2mh PswTTiHCGnUxboLketzSbs+rVQUQqU=; b=vmwRlHGbc1ZR7q1MyruJbLU6UE/yz Ab9JJnDcak0t9vaCmt/3oLq+A7LcFgBrjKUu7y2WttyXF3xpMQYeMCj4AW2Puub2 gIjZfFf0pSNG+WAcLhghdHFmCNj51dWUlwkyAcsTMddGZOMh3D8DE64Tbg9AtqnD c1hTnmU1ap6qozUxve4spY5cPi5+EW9EIofV6hpFxlSzPCFNaHeQZx011kpLU/XC XFN57WFG4FzbfgXUcMTsE12eypmVPvjnrCOkIdfWqXAb44uaL7+VeVWxHf2IcSEv JHWQDZy80wUmP1kCaYAinQtXWrz72Zt/K+Evdel8jnNzOj/4ZPU1BDxJw== X-ME-Sender: X-ME-Received: X-ME-Proxy-Cause: gggruggvucftvghtrhhoucdtuddrgedvvddrudeluddguddulecutefuodetggdotefrod ftvfcurfhrohhfihhlvgemucfhrghsthforghilhdpqfgfvfdpuffrtefokffrpgfnqfgh necuuegrihhlohhuthemuceftddtnecunecujfgurhephffvufgffffkgggtsehttdertd dtredtnecuhfhrohhmpefhihhlihhpphcuifhunhgsihhnuceofhhguhhnsghinhesfhgr shhtmhgrihhlrdhfmheqnecuggftrfgrthhtvghrnhepteekgffgjedujeekveehudetff duffejuedtveevfeeuvefgieeiueeuleekuddunecuvehluhhsthgvrhfuihiivgeptden ucfrrghrrghmpehmrghilhhfrhhomhepfhhguhhnsghinhesfhgrshhtmhgrihhlrdhfmh X-ME-Proxy: Original-Received: by mail.messagingengine.com (Postfix) with ESMTPA; Wed, 13 Apr 2022 16:14:59 -0400 (EDT) Mail-Followup-To: fitzsim@fitzsim.org, emacs-devel@gnu.org Received-SPF: pass client-ip=64.147.123.20; envelope-from=fgunbin@fastmail.fm; helo=wout4-smtp.messagingengine.com X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.io gmane.emacs.devel:288373 Archived-At: Hi, Here's the patch which fixes several bugs preventing eudc-get-attribute-list from working, please review. TIA, Filipp commit 17c59e12adca5386ffe7d107dc6e3fa2dcf8b8d6 Author: Filipp Gunbin Date: Wed Apr 13 23:10:35 2022 +0300 Fix eudc-get-attribute-list * lisp/net/eudc-vars.el (eudc-ldap-no-wildcard-attributes): New defcustom. * doc/misc/eudc.texi (LDAP Configuration): Mention it. * lisp/net/eudcb-ldap.el (eudc-ldap-format-query-as-rfc1558): Use it. (eudc-ldap-get-field-list): Set scope and sizelimit, instead of overriding the whole ldap-host-parameters-alist. * lisp/net/ldap.el (ldap-search-internal): Allow "size limit exceeded" exit code. Allow empty attribute values. diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 71e3e6b9ed..d2850282fe 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -254,7 +254,9 @@ LDAP Configuration @noindent will return all LDAP entries with surnames that begin with @code{Smith}. In every LDAP query it makes, EUDC implicitly appends -the wildcard character to the end of the last word. +the wildcard character to the end of the last word, except if the word +corresponds to an attribute which is a member of +`eudc-ldap-no-wildcard-attributes'. @menu * Emacs-only Configuration:: Configure with @file{.emacs} diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index d58fab896e..90d89e87fb 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -425,6 +425,15 @@ eudc-ldap-bbdb-conversion-alist (symbol :tag "BBDB Field") (sexp :tag "Conversion Spec")))) +(defcustom eudc-ldap-no-wildcard-attributes + '(objectclass objectcategory) + "LDAP attributes which are always searched for without wildcard character. +This is the list of special dictionary-valued attributes, where +wildcarded search may fail. For example, it fails with +objectclass in Active Directory servers." + :type '(repeat (symbol :tag "Directory attribute"))) + + ;;}}} ;;{{{ BBDB Custom Group diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 365dace961..1201c84f2d 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -151,16 +151,20 @@ eudc-ldap-get-field-list (interactive) (or eudc-server (call-interactively 'eudc-set-server)) - (let ((ldap-host-parameters-alist - (list (cons eudc-server - '(scope subtree sizelimit 1))))) - (mapcar #'eudc-ldap-cleanup-record-filtering-addresses - (ldap-search - (eudc-ldap-format-query-as-rfc1558 - (list (cons "objectclass" - (or objectclass - "person")))) - eudc-server nil t)))) + (let ((plist (copy-sequence + (alist-get eudc-server ldap-host-parameters-alist + nil nil #'equal)))) + (plist-put plist 'scope 'subtree) + (plist-put plist 'sizelimit '1) + (let ((ldap-host-parameters-alist + (list (cons eudc-server plist)))) + (mapcar #'eudc-ldap-cleanup-record-filtering-addresses + (ldap-search + (eudc-ldap-format-query-as-rfc1558 + (list (cons 'objectclass + (or objectclass + "person")))) + eudc-server nil t))))) (defun eudc-ldap-escape-query-special-chars (string) "Value is STRING with characters forbidden in LDAP queries escaped." @@ -178,12 +182,17 @@ eudc-ldap-escape-query-special-chars (defun eudc-ldap-format-query-as-rfc1558 (query) "Format the EUDC QUERY list as a RFC1558 LDAP search filter." - (let ((formatter (lambda (item &optional wildcard) - (format "(%s=%s)" - (car item) - (concat - (eudc-ldap-escape-query-special-chars - (cdr item)) (if wildcard "*" "")))))) + (let ((formatter + (lambda (item &optional wildcard) + (format "(%s=%s)" + (car item) + (concat + (eudc-ldap-escape-query-special-chars + (cdr item)) + (if (and wildcard + (not (memq (car item) + eudc-ldap-no-wildcard-attributes))) + "*" "")))))) (format "(&%s)" (concat (mapconcat formatter (butlast query) "") diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index ce6c270e0b..9463282135 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -663,7 +663,7 @@ ldap-search-internal (while (not (memq (process-status proc) '(exit signal))) (sit-for 0.1)) (let ((status (process-exit-status proc))) - (when (not (eq status 0)) + (when (not (memql status '(0 4))) ; 4 = Size limit exceeded ;; Handle invalid credentials exit status specially ;; for ldap-password-read. (if (eq status 49) @@ -699,7 +699,7 @@ ldap-search-internal (forward-line 1) (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\ \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\ -\\(<[\t ]*file://\\)\\(.*\\)$") +\\(<[\t ]*file://\\)?\\(.*\\)$") (setq name (match-string 1) value (match-string 4)) ;; Need to handle file:///D:/... as generated by OpenLDAP