1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
|
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(declaim (optimize (speed 0) (safety 3) (debug 3)))
(in-package #:ldapadmin)
(defclass ldap ()
((ldap-host :initarg :ldap-host
:initform nil
:accessor ldap-host)
(sslflag :initarg :sslflag
:initform nil
:accessor sslflag)
(username :initarg :username
:initform nil
:accessor username)
(password :initarg :password
:initform nil
:accessor password)
(base-dn :initarg :base-dn
:initform nil
:accessor base-dn)
(debug-mode :initarg :debug-mode
:initform nil
:accessor debug-mode)
(config :initarg :config
:initform nil
:accessor config)
(connection :initarg :connection
:initform nil
:accessor connection))
(:documentation "Used to provide an object-oriented interface to the
LDAP options in the webapp config file."))
(defmethod initialize-instance :after ((ldap ldap) &key config)
"Parses the LDAP config from the options.lisp file into a new `ldap'
object."
(let ((conf (car config)))
(setf (ldap-host ldap) (getf conf :ldap-host))
(setf (sslflag ldap) (getf conf :sslflag))
(setf (username ldap) (getf conf :username))
(setf (password ldap) (getf conf :password))
(setf (base-dn ldap) (getf conf :base-dn))
(setf (debug-mode ldap) (getf conf :debug-mode))
(setf (config ldap) conf)
(setf (connection ldap) (apply #'ldap:new-ldap
`(:host ,(ldap-host ldap)
:sslflag ,(sslflag ldap)
:user ,(username ldap)
:pass ,(password ldap)
:base ,(base-dn ldap)
:reuse-connection ,'ldap:rebind
:debug ,(debug-mode ldap))))))
(defmethod disconnect ((ldap ldap))
(ldap:unbind (connection ldap)))
(defmacro with-ldap ((ldap-name) &body body)
"Convenience macro for instantiating an `ldap' instance and using it
in an `unwind-protect'."
`(let ((,ldap-name (make-instance 'ldap :config `(,(ldap *webapp*)))))
(unwind-protect
(progn
,@body)
(disconnect ,ldap-name))))
(defmacro with-ldap-iterate ((ldap-entry search-base) &body body)
"Runs an ldapsearch and executes `body' over each result. The
variable `ldap-entry' is bound to the iterator of the
`ldap:dosearch'. You may use it in your `body'."
`(progn
(ldap:bind (connection ldap))
(ldap:dosearch (,ldap-entry (ldap:search (connection ldap) ,search-base))
,@body)))
(defmethod get-ldap-users ((ldap ldap) search-base)
(let ((ldap-users ()))
(with-ldap-iterate (ldap-entry search-base)
(let ((ldap-user (populate-ldap-user ldap-entry)))
(push ldap-user ldap-users)))
(nreverse ldap-users)))
(defmethod search-ldap-users ((ldap ldap) search-terms)
(get-ldap-users ldap (format nil
"(&(objectclass=inetOrgPerson)(!(cn=Manager))(!(uid=root))(!(uid=nobody))~a)"
(build-search-base search-terms))))
(defmethod get-ldap-user ((ldap ldap) cn)
(car (search-ldap-users ldap `((:cn ,cn)))))
(defun check-ldap-password (config dn password)
"Uses ldapwhoami to check the userPassword of a given
binddn. Returns `t' if the password is valid, `nil' otherwise."
(= 0 (uffi:run-shell-command (format nil
"ldapwhoami -x -H ~a://~a -D 'cn=~a,~a' -w ~a"
(if (getf config :sslflag) "ldaps" "ldap")
(getf config :ldap-host)
dn
(getf config :base-dn)
password))))
(defun populate-ldap-user (ldap-entry)
"Copies the data from a single LDAP entry as produced by
`with-ldap-iterate' into a new `ldap-user' object."
(let* ((ldap-user (make-instance 'ldap-user))
(valid-attribute-names (intersect-slots ldap-user (mapcar (lambda (pair)
(car pair))
(ldap:attrs ldap-entry)))))
(loop for name-value in (ldap:attrs ldap-entry) do
(let ((name (intern (symbol-name (car name-value)) (find-package (string-upcase "ldapadmin"))))
(value (cadr name-value)))
(when (find name
valid-attribute-names
:test (lambda (x y)
(string-equal (symbol-name x) (symbol-name y))))
(setf (slot-value ldap-user name) value))))
ldap-user))
(defun build-search-base (search-terms)
"Converts a plist like `((:givenname \"Carlos\") (:sn
\"Konstanski\"))' to an LDAP search base fragment like
\"(givenname=Carlos)(sn=Konstanski)\". Any `nil' or empty-string
values are ignored."
(org-ckons-core::reduce-to-char-separated-string (mapcar (lambda (term)
(when (not (org-ckons-core::null-or-empty-p (cadr term)))
(format nil
"(~a=~a)"
(symbol-name (car term))
(cadr term))))
search-terms)
""))
|
