Function: ldap-search-internal

ldap-search-internal is a byte-compiled function defined in ldap.el.gz.

Signature

(ldap-search-internal SEARCH-PLIST)

Documentation

Perform a search on a LDAP server.

SEARCH-PLIST is a property list describing the search request. Valid keys in that list are:

  auth-source, if non-nil, will use auth-source-search and
will grab the :host, :secret, :base, and (:user or :binddn) tokens into the host, passwd, base, and binddn parameters respectively if they are not provided in SEARCH-PLIST. So for instance *each* of these netrc lines has the same effect if you ask for the host "ldapserver:2400":

  machine ldapserver:2400 login myDN secret myPassword base myBase
  machine ldapserver:2400 binddn myDN secret myPassword port ldap
  login myDN secret myPassword base myBase

but if you have more than one in your netrc file, only the first matching one will be used. Note the "port ldap" part is NOT required.

  host is a string naming one or more (blank-separated) LDAP servers
to try to connect to. Each host name may optionally be of the form HOST:PORT.
  filter is a filter string for the search as described in RFC 1558.
  attributes is a list of strings indicating which attributes to retrieve
for each matching entry. If nil, return all available attributes.
  attrsonly, if non-nil, indicates that only attributes are retrieved,
not their associated values.
  auth is one of the symbols simple, krbv41 or krbv42.
  base is the base for the search as described in RFC 1779.
  scope is one of the three symbols sub, base or one.
  binddn is the distinguished name of the user to bind as (in
RFC 1779 syntax).
  passwd is the password to use for simple authentication.
  deref is one of the symbols never, always, search or find.
  timelimit is the timeout limit for the connection in seconds.
  sizelimit is the maximum number of matches to return.
  withdn if non-nil each entry in the result will be prepended with
its distinguished name DN.

The function returns a list of matching entries. Each entry is itself a list ATTRS of (ATTR VALUE) pairs; dn attribute is not included. When withdn is non-nil the result is instead an alist with elements (DN . ATTRS), where DN is a string value and ATTRS is same as above.

Source Code

;; Defined in /usr/src/emacs/lisp/net/ldap.el.gz
(defun ldap-search-internal (search-plist)
  "Perform a search on a LDAP server.
SEARCH-PLIST is a property list describing the search request.
Valid keys in that list are:

  `auth-source', if non-nil, will use `auth-source-search' and
will grab the :host, :secret, :base, and (:user or :binddn)
tokens into the `host', `passwd', `base', and `binddn' parameters
respectively if they are not provided in SEARCH-PLIST.  So for
instance *each* of these netrc lines has the same effect if you
ask for the host \"ldapserver:2400\":

  machine ldapserver:2400 login myDN secret myPassword base myBase
  machine ldapserver:2400 binddn myDN secret myPassword port ldap
  login myDN secret myPassword base myBase

but if you have more than one in your netrc file, only the first
matching one will be used.  Note the \"port ldap\" part is NOT
required.

  `host' is a string naming one or more (blank-separated) LDAP servers
to try to connect to.  Each host name may optionally be of the form HOST:PORT.
  `filter' is a filter string for the search as described in RFC 1558.
  `attributes' is a list of strings indicating which attributes to retrieve
for each matching entry. If nil, return all available attributes.
  `attrsonly', if non-nil, indicates that only attributes are retrieved,
not their associated values.
  `auth' is one of the symbols `simple', `krbv41' or `krbv42'.
  `base' is the base for the search as described in RFC 1779.
  `scope' is one of the three symbols `sub', `base' or `one'.
  `binddn' is the distinguished name of the user to bind as (in
RFC 1779 syntax).
  `passwd' is the password to use for simple authentication.
  `deref' is one of the symbols `never', `always', `search' or `find'.
  `timelimit' is the timeout limit for the connection in seconds.
  `sizelimit' is the maximum number of matches to return.
  `withdn' if non-nil each entry in the result will be prepended with
its distinguished name DN.

The function returns a list of matching entries.  Each entry is
itself a list ATTRS of (ATTR VALUE) pairs; `dn' attribute is not
included.
When `withdn' is non-nil the result is instead an alist with
elements (DN . ATTRS), where DN is a string value and ATTRS is
same as above."
  (let* ((buf (get-buffer-create " *ldap-search*"))
	(bufval (get-buffer-create " *ldap-value*"))
	(host (or (plist-get search-plist 'host)
		  ldap-default-host))
         ;; find entries with port "ldap" that match the requested host if any
         (asfound (when (plist-get search-plist 'auth-source)
                    (nth 0 (auth-source-search :host (or host t)
                                               :create t))))
         ;; if no host was requested, get it from the auth-source entry
         (host (or host (plist-get asfound :host)))
         ;; get the password from the auth-source
         (passwd (or (plist-get search-plist 'passwd)
                     (plist-get asfound :secret)))
         ;; convert the password from a function call if needed
         (passwd (if (functionp passwd)
		     (if (eq passwd 'ldap-password-read)
			 (funcall passwd host)
		       (funcall passwd))
		   passwd))
         ;; get the binddn from the search-list or from the
         ;; auth-source user or binddn tokens
         (binddn (or (plist-get search-plist 'binddn)
                     (plist-get asfound :user)
                     (plist-get asfound :binddn)))
         (base (or (plist-get search-plist 'base)
                   (plist-get asfound :base)
                   ldap-default-base))
	(filter (plist-get search-plist 'filter))
	(attributes (plist-get search-plist 'attributes))
	(attrsonly (plist-get search-plist 'attrsonly))
	(scope (plist-get search-plist 'scope))
        (auth (plist-get search-plist 'auth))
	(deref (plist-get search-plist 'deref))
	(timelimit (plist-get search-plist 'timelimit))
	(sizelimit (plist-get search-plist 'sizelimit))
	(withdn (plist-get search-plist 'withdn))
	(numres 0)
        (arglist (list "-LLL" "-tt"))
	dn name value record result)
    (if (or (null filter)
	    (equal "" filter))
	(error "No search filter"))
    (setq filter (cons filter attributes))
    (with-current-buffer buf
      (erase-buffer)
      (if (and host
	       (not (equal "" host)))
	  (setq arglist (nconc arglist
			       (list (format
				      ;; Use -H if host is a new-style LDAP URI.
				      (if (string-match "^[a-zA-Z]+://" host)
					  "-H%s"
					"-h%s")
				      host)))))
      (if (and attrsonly
	       (not (equal "" attrsonly)))
	  (setq arglist (nconc arglist (list "-A"))))
      (if (and base
	       (not (equal "" base)))
	  (setq arglist (nconc arglist (list (format "-b%s" base)))))
      (if (and scope
	       (not (equal "" scope)))
	  (setq arglist (nconc arglist (list (format "-s%s" scope)))))
      (if (and binddn
	       (not (equal "" binddn)))
	  (setq arglist (nconc arglist (list (format "-D%s" binddn)))))
      (if (and auth
	       (equal 'simple auth))
	  (setq arglist (nconc arglist (list "-x"))))
      ;; Allow passwd to be set to "", representing a blank password.
      (if passwd
	  (setq arglist (nconc arglist (list "-W"))))
      (if (and deref
	       (not (equal "" deref)))
	  (setq arglist (nconc arglist (list (format "-a%s" deref)))))
      (if (and timelimit
	       (not (equal "" timelimit)))
	  (setq arglist (nconc arglist (list (format "-l%s" timelimit)))))
      (if (and sizelimit
	       (not (equal "" sizelimit)))
	  (setq arglist (nconc arglist (list (format "-z%s" sizelimit)))))
      (if passwd
	  ;; Leave process-connection-type at its default value.  See
	  ;; discussion in Bug#33050.
	  (let* ((proc-args (append arglist ldap-ldapsearch-args
				    filter))
		 (proc (apply #'start-process "ldapsearch" buf
			      ldap-ldapsearch-prog
			      proc-args)))
	    (while (null (progn
			   (goto-char (point-min))
			   (re-search-forward
			    ldap-ldapsearch-password-prompt-regexp
			    (point-max) t)))
	      (accept-process-output proc 1))
	    (process-send-string proc passwd)
	    (process-send-string proc "\n")
	    (while (not (memq (process-status proc) '(exit signal)))
	      (sit-for 0.1))
	    (let ((status (process-exit-status proc)))
	      (when (not (memql status '(0 4))) ; 4 = Size limit exceeded
		;; Handle invalid credentials exit status specially
		;; for ldap-password-read.
		(if (eq status 49)
		    (error (concat "Incorrect LDAP password or"
				   " bind distinguished name (binddn)"))
		  (error "Failed ldapsearch invocation: %s \"%s\""
			 ldap-ldapsearch-prog
			 (mapconcat #'identity proc-args "\" \""))))))
	(apply #'call-process ldap-ldapsearch-prog
	       ;; Ignore stderr, which can corrupt results
	       nil (list buf nil) nil
	       (append arglist ldap-ldapsearch-args filter)))
      (insert "\n")
      (goto-char (point-min))

      (while (re-search-forward (concat "[\t\n\f]+ \\|"
					ldap-ldapsearch-password-prompt-regexp)
				nil t)
	(replace-match ""))
      (goto-char (point-min))

      (if (looking-at "usage")
	  (error "Incorrect ldapsearch invocation")
	(message "Parsing results... ")
	;; Skip error message when retrieving attribute list
	(if (looking-at "Size limit exceeded")
	    (forward-line 1))
	(while (progn
		 (skip-chars-forward " \t\n")
		 (not (eobp)))
          (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\
\\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\
\\(<[\t ]*file://\\)?\\(.*\\)$")
	    (setq name (match-string 1)
		  value (match-string 4))
            (when (memq system-type '(windows-nt ms-dos))
              ;; Need to handle file:///D:/... as generated by
              ;; OpenLDAP on DOS/Windows as local files.
              (save-match-data
                (when (eq (string-match "/\\(.:.*\\)$" value) 0)
                  (setq value (match-string 1 value)))))
            (cond ((match-string 3)     ;normal value written to a file
                   (with-current-buffer bufval
		     (erase-buffer)
		     (set-buffer-multibyte nil)
		     (insert-file-contents-literally value)
		     (delete-file value)
		     (setq value (buffer-string))))
                  (;; dn is output inline
                   (string-equal-ignore-case name "dn")
                   (setq dn value
                         name nil
                         value nil))
                  (t (setq value " ")))
            (and name value
                 (setq record (cons (list name value)
                                    record)))
	    (forward-line 1))
          (when dn
	    (cond (withdn
		   (push (cons dn (nreverse record))
                         result))
		  (record
		   (push (nreverse record) result))))
	  (setq record nil
                dn nil)
	  (message "Parsing results... %d" numres)
	  (setq numres (1+ numres)))
	(message "Parsing results... done")
	(nreverse result)))))