├── CODEOWNERS ├── .clj-kondo └── config.edn ├── .gitignore ├── src ├── java │ └── com │ │ └── puppetlabs │ │ └── ldap │ │ └── Utils.java └── clojure │ └── clj_ldap │ └── client.clj ├── CHANGELOG.md ├── .github └── workflows │ ├── pr-testing.yaml │ ├── clojure-linting.yaml │ └── mend.yaml ├── project.clj ├── CONTRIBUTING.md ├── test └── clj_ldap │ └── test │ ├── server.clj │ └── client.clj ├── LICENSE └── README.md /CODEOWNERS: -------------------------------------------------------------------------------- 1 | # default to the dumpling team 2 | * @puppetlabs/dumpling 3 | -------------------------------------------------------------------------------- /.clj-kondo/config.edn: -------------------------------------------------------------------------------- 1 | {:linters {:refer-all {:exclude [clojure.test]}} 2 | :output {:linter-name true}} -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .classpath 2 | .project 3 | classes 4 | lib 5 | target 6 | .lein* 7 | #*# 8 | .#* 9 | .DS_Store 10 | .clj-kondo/.cache 11 | .eastwood 12 | 13 | -------------------------------------------------------------------------------- /src/java/com/puppetlabs/ldap/Utils.java: -------------------------------------------------------------------------------- 1 | package com.puppetlabs.ldap; 2 | 3 | import com.unboundid.util.ssl.SSLUtil; 4 | import com.unboundid.util.ssl.TrustStoreTrustManager; 5 | 6 | import javax.net.ssl.TrustManager; 7 | 8 | public class Utils { 9 | 10 | public static SSLUtil trustManagersToSSLUtil(final TrustManager[] tm) { 11 | return new SSLUtil(tm); 12 | } 13 | 14 | public static SSLUtil trustStoreToSSLUtil(String ts) { 15 | return new SSLUtil(new TrustStoreTrustManager(ts)); 16 | } 17 | 18 | public static SSLUtil trustManagerToSSLUtil(final TrustManager tm) { 19 | return new SSLUtil(tm); 20 | } 21 | } -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | ### 0.5.0 2 | * update unbound dependency to latest compatible version 3 | * update slf4j-simple to latest version 4 | * add in clj-kondo, and eastwood as code-quality linters 5 | * addresses clj-kondo and eastwood identified issues 6 | * add optional cipher suite as an accepted option to connect 7 | 8 | ### 0.4.0 9 | * update unboundid to 6.0.7 10 | 11 | ### 0.3.0 12 | * add trust-managers as an accepted option to connect 13 | * update clojure dependency to 1.10.1 14 | * update unboundid to 5.0.1 15 | ### 0.2.1 16 | * don't encode items that have been base-64 decoded 17 | * update unboundid to 4.0.11 18 | ### 0.2.0 19 | * update clojure dependency to 1.8.0 20 | * update unboundid to 4.0.7 21 | -------------------------------------------------------------------------------- /.github/workflows/pr-testing.yaml: -------------------------------------------------------------------------------- 1 | name: PR Testing 2 | 3 | on: 4 | workflow_dispatch: 5 | pull_request: 6 | types: [opened, reopened, edited, synchronize] 7 | paths: ['src/**','test/**','project.clj'] 8 | 9 | jobs: 10 | pr-testing: 11 | name: PR Testing 12 | strategy: 13 | fail-fast: false 14 | matrix: 15 | version: ['11', '17'] 16 | runs-on: ubuntu-latest 17 | steps: 18 | - name: checkout repo 19 | uses: actions/checkout@v4 20 | with: 21 | submodules: recursive 22 | - name: setup java 23 | uses: actions/setup-java@v3 24 | with: 25 | distribution: 'temurin' 26 | java-version: ${{ matrix.version }} 27 | - name: clojure tests 28 | run: lein test 29 | timeout-minutes: 30 -------------------------------------------------------------------------------- /.github/workflows/clojure-linting.yaml: -------------------------------------------------------------------------------- 1 | name: Clojure Linting 2 | 3 | on: 4 | pull_request: 5 | types: [opened, reopened, edited, synchronize] 6 | paths: ['src/**','test/**','.clj-kondo/config.edn','project.clj','.github/**'] 7 | 8 | jobs: 9 | clojure-linting: 10 | name: Clojure Linting 11 | runs-on: ubuntu-latest 12 | steps: 13 | - name: setup java 14 | uses: actions/setup-java@v3 15 | with: 16 | distribution: temurin 17 | java-version: 17 18 | - name: checkout repo 19 | uses: actions/checkout@v4 20 | - name: install clj-kondo (this is quite fast) 21 | run: | 22 | curl -sLO https://raw.githubusercontent.com/clj-kondo/clj-kondo/master/script/install-clj-kondo 23 | chmod +x install-clj-kondo 24 | ./install-clj-kondo --dir . 25 | - name: kondo lint 26 | run: ./clj-kondo --lint src test 27 | - name: eastwood lint 28 | run: | 29 | java -version 30 | lein eastwood -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject puppetlabs/clj-ldap "0.4.2-SNAPSHOT" 2 | :description "Clojure ldap client (Puppet Labs's fork)." 3 | :url "https://github.com/puppetlabs/clj-ldap" 4 | :dependencies [[org.clojure/clojure] 5 | [com.unboundid/unboundid-ldapsdk "6.0.10"] 6 | [org.clojure/tools.logging]] 7 | :parent-project {:coords [puppetlabs/clj-parent "7.2.7"] 8 | :inherit [:managed-dependencies]} 9 | :source-paths ["src/clojure"] 10 | :java-source-paths ["src/java"] 11 | :profiles {:dev {:dependencies [[org.apache.directory.server/apacheds-all "1.5.7" 12 | ;; This dependency causes the classpath to contain two copies of the schema, 13 | ;; which prevents the test Directory Service from starting 14 | :exclusions [org.apache.directory.shared/shared-ldap-schema]] 15 | [org.slf4j/slf4j-simple "1.5.10"]]}} 16 | 17 | :deploy-repositories [["releases" {:url "https://clojars.org/repo" 18 | :username :env/clojars_jenkins_username 19 | :password :env/clojars_jenkins_password 20 | :sign-releases false}]] 21 | :plugins [[jonase/eastwood "1.2.2" :exclusions [org.clojure/clojure]] 22 | [lein-parent "0.3.7"]] 23 | :license {:name "Eclipse Public License - v 1.0" 24 | :url "http://www.eclipse.org/legal/epl-v10.html" 25 | :distribution :repo 26 | :comments "same as Clojure"}) 27 | -------------------------------------------------------------------------------- /.github/workflows/mend.yaml: -------------------------------------------------------------------------------- 1 | name: mend_scan 2 | on: 3 | workflow_dispatch: 4 | push: 5 | branches: 6 | - main 7 | jobs: 8 | build: 9 | runs-on: ubuntu-latest 10 | steps: 11 | - name: connect_twingate 12 | uses: twingate/github-action@v1 13 | with: 14 | service-key: ${{ secrets.TWINGATE_PUBLIC_REPO_KEY }} 15 | - name: checkout repo content 16 | uses: actions/checkout@v4 # checkout the repository content to github runner. 17 | with: 18 | fetch-depth: 1 19 | # install java which is required for mend and clojure 20 | - name: setup java 21 | uses: actions/setup-java@v3 22 | with: 23 | distribution: temurin 24 | java-version: 17 25 | # install clojure tools 26 | - name: Install Clojure tools 27 | uses: DeLaGuardo/setup-clojure@10.1 28 | with: 29 | # Install just one or all simultaneously 30 | # The value must indicate a particular version of the tool, or use 'latest' 31 | # to always provision the latest version 32 | cli: latest # Clojure CLI based on tools.deps 33 | lein: latest # Leiningen 34 | boot: latest # Boot.clj 35 | bb: latest # Babashka 36 | clj-kondo: latest # Clj-kondo 37 | cljstyle: latest # cljstyle 38 | zprint: latest # zprint 39 | # run lein gen 40 | - name: create pom.xml 41 | run: lein pom 42 | # download mend 43 | - name: download_mend 44 | run: curl -o wss-unified-agent.jar https://unified-agent.s3.amazonaws.com/wss-unified-agent.jar 45 | - name: run mend 46 | run: env WS_INCLUDES=pom.xml java -jar wss-unified-agent.jar 47 | env: 48 | WS_APIKEY: ${{ secrets.MEND_API_KEY }} 49 | WS_WSS_URL: https://saas-eu.whitesourcesoftware.com/agent 50 | WS_USERKEY: ${{ secrets.MEND_TOKEN }} 51 | WS_PRODUCTNAME: Puppet Enterprise 52 | WS_PROJECTNAME: ${{ github.event.repository.name }} 53 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # How to contribute 2 | 3 | ## Getting Started 4 | 5 | * Make sure you have a [GitHub account](https://github.com/signup/free) 6 | * Submit an issue for your issue, assuming one does not already exist. 7 | * Clearly describe the issue including steps to reproduce when it is a bug. 8 | * Fork the repository on GitHub 9 | 10 | ## Making Changes 11 | 12 | * Create a topic branch from where you want to base your work. 13 | * This is usually the master branch. 14 | * Only target release branches if you are certain your fix must be on that 15 | branch. 16 | * To quickly create a topic branch based on master; `git checkout -b 17 | fix/master/my_contribution master`. Please avoid working directly on the 18 | `master` branch. 19 | * Make commits of logical units. 20 | * Check for unnecessary whitespace with `git diff --check` before committing. 21 | * Make sure your commit messages are in the proper format. 22 | 23 | ```` 24 | (PUP-1234) Make the example in CONTRIBUTING imperative and concrete 25 | 26 | Without this patch applied the example commit message in the CONTRIBUTING 27 | document is not a concrete example. This is a problem because the 28 | contributor is left to imagine what the commit message should look like 29 | based on a description rather than an example. This patch fixes the 30 | problem by making the example concrete and imperative. 31 | 32 | The first line is a real life imperative statement with a ticket number 33 | from our issue tracker. The body describes the behavior without the patch, 34 | why this is a problem, and how the patch fixes the problem when applied. 35 | ```` 36 | 37 | * Make sure you have added the necessary tests for your changes. 38 | * Run _all_ the tests to assure nothing else was accidentally broken. 39 | 40 | ## Making Trivial Changes 41 | 42 | ### Documentation 43 | 44 | For changes of a trivial nature to comments and documentation, it is not 45 | always necessary to create a new issue in Github. In this case, it is 46 | appropriate to start the first line of a commit with '(doc)' instead of 47 | a ticket number. 48 | 49 | ```` 50 | (doc) Add documentation commit example to CONTRIBUTING 51 | 52 | There is no example for contributing a documentation commit 53 | to the Puppet repository. This is a problem because the contributor 54 | is left to assume how a commit of this nature may appear. 55 | 56 | The first line is a real life imperative statement with '(doc)' in 57 | place of what would have been the ticket number in a 58 | non-documentation related commit. The body describes the nature of 59 | the new documentation or comments added. 60 | ```` 61 | 62 | ## Submitting Changes 63 | 64 | * Sign the [Contributor License Agreement](http://links.puppetlabs.com/cla). 65 | * Push your changes to a topic branch in your fork of the repository. 66 | * Submit a pull request to the repository in the puppetlabs organization, referencing the Github issue you opened. 67 | 68 | # Additional Resources 69 | 70 | * [Puppet Labs community guidelines](http://docs.puppetlabs.com/community/community_guidelines.html) 71 | * [Contributor License Agreement](http://links.puppetlabs.com/cla) 72 | * [General GitHub documentation](http://help.github.com/) 73 | * [GitHub pull request documentation](http://help.github.com/send-pull-requests/) 74 | * #puppet-dev IRC channel on freenode.org ([Archive](https://botbot.me/freenode/puppet-dev/)) 75 | * [puppet-dev mailing list](https://groups.google.com/forum/#!forum/puppet-dev) 76 | * [Community PR Triage notes](https://github.com/puppet-community/community-triage/tree/master/core/notes) 77 | -------------------------------------------------------------------------------- /test/clj_ldap/test/server.clj: -------------------------------------------------------------------------------- 1 | (ns clj-ldap.test.server 2 | "An embedded ldap server for unit testing" 3 | (:require [clj-ldap.client :as ldap]) 4 | (:import (java.io File) 5 | (java.nio.file Files) 6 | (java.nio.file.attribute FileAttribute) 7 | (java.util HashSet) 8 | (org.apache.directory.server.constants ServerDNConstants) 9 | (org.apache.directory.server.core DefaultDirectoryService DirectoryService) 10 | (org.apache.directory.server.core.partition.impl.btree.jdbm JdbmIndex JdbmPartition) 11 | (org.apache.directory.server.core.partition.ldif LdifPartition) 12 | (org.apache.directory.server.ldap LdapServer) 13 | (org.apache.directory.server.protocol.shared.transport TcpTransport) 14 | (org.apache.directory.shared.ldap.schema.ldif.extractor.impl DefaultSchemaLdifExtractor) 15 | (org.apache.directory.shared.ldap.schema.loader.ldif LdifSchemaLoader) 16 | (org.apache.directory.shared.ldap.schema.manager.impl DefaultSchemaManager))) 17 | 18 | (defonce server (atom nil)) 19 | 20 | (defn- override-java-version! 21 | "Override the java.version property as the ancient version of 22 | directory-server we use for tests seems not to understand the concept of a 23 | version number with multiple digits (ie. 11 or 14). This version isn't 24 | actually used anywhere, just parsed as a side effect of loading a SystemUtils 25 | class, so it only needs to appear valid." 26 | [] 27 | (System/setProperty "java.version" "0.0.0")) 28 | 29 | (defn- add-partition! 30 | "Adds a partition to the embedded directory service" 31 | [^DirectoryService service ^String id dn] 32 | (let [partition (doto (JdbmPartition.) 33 | (.setId id) 34 | (.setPartitionDir (File. (.getWorkingDirectory service) id)) 35 | (.setSuffix dn))] 36 | (.addPartition service partition) 37 | partition)) 38 | 39 | (defn- add-index! 40 | "Adds an index to the given partition on the given attributes" 41 | [^JdbmPartition partition & attrs] 42 | (let [indexed-attrs (HashSet.)] 43 | (doseq [attr attrs] 44 | (.add indexed-attrs (JdbmIndex. attr))) 45 | (.setIndexedAttributes partition indexed-attrs))) 46 | 47 | (defn start-ldap-server 48 | "Start an embedded ldap server" 49 | [port] 50 | (override-java-version!) 51 | (let [work-dir (Files/createTempDirectory "ldap" (into-array FileAttribute [])) 52 | _ (.deleteOnExit (.toFile work-dir)) 53 | schema-dir (.resolve work-dir "schema") 54 | _ (Files/createDirectory schema-dir (into-array FileAttribute [])) 55 | ;; Setup steps based on http://svn.apache.org/repos/asf/directory/documentation/samples/trunk/embedded-sample/src/main/java/org/apache/directory/seserver/EmbeddedADSVer157.java 56 | ^DirectoryService directory-service (doto (DefaultDirectoryService.) 57 | (.setShutdownHookEnabled true) 58 | (.setWorkingDirectory (.toFile work-dir))) 59 | schema-partition (.getSchemaPartition (.getSchemaService directory-service)) 60 | ldif-partition (doto (LdifPartition.) 61 | (.setWorkingDirectory (.toString schema-dir))) 62 | _extractor (doto (DefaultSchemaLdifExtractor. (.toFile work-dir)) 63 | (.extractOrCopy true)) 64 | _ (.setWrappedPartition schema-partition ldif-partition) 65 | schema-manager (DefaultSchemaManager. (LdifSchemaLoader. (.toFile schema-dir))) 66 | _ (.setSchemaManager directory-service schema-manager) 67 | _ (.loadAllEnabled schema-manager) 68 | _ (.setSchemaManager schema-partition schema-manager) 69 | ldap-transport (TcpTransport. port) 70 | ldap-server (doto (LdapServer.) 71 | (.setDirectoryService directory-service) 72 | (.setAllowAnonymousAccess true) 73 | (.setTransports 74 | (into-array [ldap-transport])))] 75 | (->> (add-partition! directory-service "system" (ServerDNConstants/SYSTEM_DN)) 76 | (.setSystemPartition directory-service)) 77 | (-> (add-partition! directory-service 78 | "clojure" "dc=alienscience,dc=org,dc=uk") 79 | (add-index! "objectClass" "ou" "uid")) 80 | (.startup directory-service) 81 | (.start ldap-server) 82 | [directory-service ldap-server])) 83 | 84 | (defn- add-toplevel-objects! 85 | "Adds top level objects, needed for testing, to the ldap server" 86 | [connection] 87 | (ldap/add connection "dc=alienscience,dc=org,dc=uk" 88 | {:objectClass ["top" "domain" "extensibleObject"] 89 | :dc "alienscience"}) 90 | (ldap/add connection "ou=people,dc=alienscience,dc=org,dc=uk" 91 | {:objectClass ["top" "organizationalUnit"] 92 | :ou "people"}) 93 | (ldap/add connection 94 | "cn=Saul Hazledine,ou=people,dc=alienscience,dc=org,dc=uk" 95 | {:objectClass ["top" "Person"] 96 | :cn "Saul Hazledine" 97 | :sn "Hazledine" 98 | :description "Creator of bugs"})) 99 | 100 | (defn stop! 101 | "Stops the embedded ldap server" 102 | [] 103 | (when @server 104 | (try 105 | (let [[^DirectoryService directory-service ldap-server] @server] 106 | (reset! server nil) 107 | (.stop ^LdapServer ldap-server) 108 | (.shutdown directory-service)) 109 | (catch Exception _e)))) 110 | 111 | (defn start! 112 | "Starts an embedded ldap server on the given port" 113 | [port] 114 | (stop!) 115 | (reset! server (start-ldap-server port)) 116 | (let [conn (ldap/connect {:host {:address "localhost" :port port}})] 117 | (add-toplevel-objects! conn))) 118 | -------------------------------------------------------------------------------- /test/clj_ldap/test/client.clj: -------------------------------------------------------------------------------- 1 | (ns clj-ldap.test.client 2 | "Automated tests for clj-ldap" 3 | (:require [clj-ldap.client :as ldap] 4 | [clj-ldap.test.server :as server] 5 | [clojure.test :refer :all]) 6 | (:import (com.unboundid.util.ssl SSLUtil))) 7 | 8 | ;; Tests are run over a variety of connection types 9 | (def port* 1389) 10 | (def ^:dynamic *connections* nil) 11 | (def ^:dynamic *conn* nil) 12 | 13 | ;; Tests concentrate on a single object class 14 | (def base* "ou=people,dc=alienscience,dc=org,dc=uk") 15 | (def dn* (str "cn=%s," base*)) 16 | (def object-class* #{"top" "person"}) 17 | 18 | ;; Variable to catch side effects 19 | (def ^:dynamic *side-effects* nil) 20 | 21 | ;; Result of a successful write 22 | (def success* {:code 0 :name "success"}) 23 | 24 | ;; People to test with 25 | (def person-a* 26 | {:dn (format dn* "testaü") 27 | :object {:objectClass object-class* 28 | :cn "testaü" 29 | :sn "a" 30 | :description "description a" 31 | :telephoneNumber "000000001" 32 | :userPassword "passa"}}) 33 | 34 | (def person-b* 35 | {:dn (format dn* "testb") 36 | :object {:objectClass object-class* 37 | :cn "testb" 38 | :sn "b" 39 | :description "description b" 40 | :telephoneNumber ["000000002" "00000003"] 41 | :userPassword "passb"}}) 42 | 43 | (def person-c* 44 | {:dn (format dn* "testc") 45 | :object {:objectClass object-class* 46 | :cn "testc" 47 | :sn "c" 48 | :description "description c" 49 | :telephoneNumber "000000004" 50 | :userPassword "passc"}}) 51 | 52 | (defn- connect-to-server 53 | "Opens a sequence of connection pools on the localhost server with the 54 | given ports" 55 | [port] 56 | [ 57 | (ldap/connect {:host {:port port}}) 58 | (ldap/connect {:host {:address "localhost" 59 | :port port} 60 | :num-connections 4}) 61 | (ldap/connect {:host (str "localhost:" port)}) 62 | (ldap/connect {:host {:port port} 63 | :connect-timeout 1000 64 | :timeout 5000})]) 65 | 66 | 67 | 68 | (defn- test-server 69 | "Setup server" 70 | [f] 71 | (server/start! port*) 72 | (binding [*connections* (connect-to-server port*)] 73 | (f)) 74 | (server/stop!)) 75 | 76 | (defn- test-data 77 | "Provide test data" 78 | [f] 79 | (doseq [connection *connections*] 80 | (binding [*conn* connection] 81 | (try 82 | (ldap/add *conn* (:dn person-a*) (:object person-a*)) 83 | (ldap/add *conn* (:dn person-b*) (:object person-b*)) 84 | (catch Exception _e)) 85 | (f) 86 | (try 87 | (ldap/delete *conn* (:dn person-a*)) 88 | (ldap/delete *conn* (:dn person-b*)) 89 | (catch Exception _e))))) 90 | 91 | (use-fixtures :each test-data) 92 | (use-fixtures :once test-server) 93 | 94 | (deftest test-get 95 | (is (= (ldap/get *conn* (:dn person-a*)) 96 | (assoc (:object person-a*) :dn (:dn person-a*)))) 97 | (is (= (ldap/get *conn* (:dn person-b*)) 98 | (assoc (:object person-b*) :dn (:dn person-b*)))) 99 | (is (= (ldap/get *conn* (:dn person-a*) [:cn :sn]) 100 | {:dn (:dn person-a*) 101 | :cn (-> person-a* :object :cn) 102 | :sn (-> person-a* :object :sn)}))) 103 | 104 | (deftest test-ssl-protocol-mapping 105 | (let [valid-list (list "TLSv1.2" "TLSv1.3") 106 | invalid-list (list "TLSv1.2" "TLSv1.3" "TaylorvSwift") 107 | valid-constants (list SSLUtil/SSL_PROTOCOL_TLS_1_2 SSLUtil/SSL_PROTOCOL_TLS_1_3)] 108 | (is (= valid-constants (ldap/ssl-protocol-mapping valid-list))) 109 | (is (= valid-constants (ldap/ssl-protocol-mapping invalid-list))))) 110 | 111 | (deftest test-add-delete 112 | (is (= (ldap/add *conn* (:dn person-c*) (:object person-c*)) 113 | success*)) 114 | (is (= (ldap/get *conn* (:dn person-c*)) 115 | (assoc (:object person-c*) :dn (:dn person-c*)))) 116 | (is (= (ldap/delete *conn* (:dn person-c*)) 117 | success*)) 118 | (is (nil? (ldap/get *conn* (:dn person-c*))))) 119 | 120 | (deftest test-modify-add 121 | (is (= (ldap/modify *conn* (:dn person-a*) 122 | {:add {:objectClass "residentialperson" 123 | :l "Hollywood"}}) 124 | success*)) 125 | (is (= (ldap/modify 126 | *conn* (:dn person-b*) 127 | {:add {:telephoneNumber ["0000000005" "0000000006"]}}) 128 | success*)) 129 | (let [new-a (ldap/get *conn* (:dn person-a*)) 130 | new-b (ldap/get *conn* (:dn person-b*)) 131 | obj-a (:object person-a*) 132 | obj-b (:object person-b*)] 133 | (is (= (:objectClass new-a) 134 | (conj (:objectClass obj-a) "residentialPerson"))) 135 | (is (= (:l new-a) "Hollywood")) 136 | (is (= (set (:telephoneNumber new-b)) 137 | (set (concat (:telephoneNumber obj-b) 138 | ["0000000005" "0000000006"])))))) 139 | 140 | (deftest test-modify-delete 141 | (let [b-phonenums (-> person-b* :object :telephoneNumber)] 142 | (is (= (ldap/modify *conn* (:dn person-a*) 143 | {:delete {:description :all}}) 144 | success*)) 145 | (is (= (ldap/modify *conn* (:dn person-b*) 146 | {:delete {:telephoneNumber (first b-phonenums)}}) 147 | success*)) 148 | (is (= (ldap/get *conn* (:dn person-a*)) 149 | (-> (:object person-a*) 150 | (dissoc :description) 151 | (assoc :dn (:dn person-a*))))) 152 | (is (= (ldap/get *conn* (:dn person-b*)) 153 | (-> (:object person-b*) 154 | (assoc :telephoneNumber (second b-phonenums)) 155 | (assoc :dn (:dn person-b*))))))) 156 | 157 | (deftest test-modify-replace 158 | (let [new-phonenums (-> person-b* :object :telephoneNumber)] 159 | (is (= (ldap/modify *conn* (:dn person-a*) 160 | {:replace {:telephoneNumber new-phonenums}}) 161 | success*)) 162 | (is (= (ldap/get *conn* (:dn person-a*)) 163 | (-> (:object person-a*) 164 | (assoc :telephoneNumber new-phonenums) 165 | (assoc :dn (:dn person-a*))))))) 166 | 167 | (deftest test-modify-all 168 | (let [b (:object person-b*) 169 | b-phonenums (:telephoneNumber b)] 170 | (is (= (ldap/modify *conn* (:dn person-b*) 171 | {:add {:telephoneNumber "0000000005"} 172 | :delete {:telephoneNumber (second b-phonenums)} 173 | :replace {:description "desc x"}}) 174 | success*)) 175 | (let [new-b (ldap/get *conn* (:dn person-b*))] 176 | (is (= (set (:telephoneNumber new-b)) 177 | (set [(first b-phonenums) "0000000005"]))) 178 | (is (= (:description new-b) "desc x"))))) 179 | 180 | 181 | (deftest test-search 182 | (is (= (set (map :cn 183 | (ldap/search *conn* base* {:attributes [:cn]}))) 184 | (set [nil "testaü" "testb" "Saul Hazledine"]))) 185 | (is (= (set (map :cn 186 | (ldap/search *conn* base* 187 | {:attributes [:cn] :filter "cn=test*"}))) 188 | (set ["testaü" "testb"]))) 189 | (binding [*side-effects* #{}] 190 | (ldap/search! *conn* base* {:attributes [:cn :sn] :filter "cn=test*"} 191 | (fn [x] 192 | (set! *side-effects* 193 | (conj *side-effects* (dissoc x :dn))))) 194 | (is (= *side-effects* 195 | (set [{:cn "testaü" :sn "a"} 196 | {:cn "testb" :sn "b"}]))))) 197 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | 2 | Eclipse Public License - v 1.0 3 | 4 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 5 | 6 | 1. DEFINITIONS 7 | 8 | "Contribution" means: 9 | 10 | a) in the case of the initial Contributor, the initial code and documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are distributed by that particular Contributor. A Contribution 'originates' from a Contributor if it was added to the Program by such Contributor itself or anyone acting on such Contributor's behalf. Contributions do not include additions to the Program which: (i) are separate modules of software distributed in conjunction with the Program under their own license agreement, and (ii) are not derivative works of the Program. 19 | 20 | "Contributor" means any person or entity that distributes the Program. 21 | 22 | "Licensed Patents" mean patent claims licensable by a Contributor which are necessarily infringed by the use or sale of its Contribution alone or when combined with the Program. 23 | 24 | "Program" means the Contributions distributed in accordance with this Agreement. 25 | 26 | "Recipient" means anyone who receives the Program under this Agreement, including all Contributors. 27 | 28 | 2. GRANT OF RIGHTS 29 | 30 | a) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free copyright license to reproduce, prepare derivative works of, publicly display, publicly perform, distribute and sublicense the Contribution of such Contributor, if any, and such derivative works, in source code and object code form. 31 | 32 | b) Subject to the terms of this Agreement, each Contributor hereby grants Recipient a non-exclusive, worldwide, royalty-free patent license under Licensed Patents to make, use, sell, offer to sell, import and otherwise transfer the Contribution of such Contributor, if any, in source code and object code form. This patent license shall apply to the combination of the Contribution and the Program if, at the time the Contribution is added by the Contributor, such addition of the Contribution causes such combination to be covered by the Licensed Patents. The patent license shall not apply to any other combinations which include the Contribution. No hardware per se is licensed hereunder. 33 | 34 | c) Recipient understands that although each Contributor grants the licenses to its Contributions set forth herein, no assurances are provided by any Contributor that the Program does not infringe the patent or other intellectual property rights of any other entity. Each Contributor disclaims any liability to Recipient for claims brought by any other entity based on infringement of intellectual property rights or otherwise. As a condition to exercising the rights and licenses granted hereunder, each Recipient hereby assumes sole responsibility to secure any other intellectual property rights needed, if any. For example, if a third party patent license is required to allow Recipient to distribute the Program, it is Recipient's responsibility to acquire that license before distributing the Program. 35 | 36 | d) Each Contributor represents that to its knowledge it has sufficient copyright rights in its Contribution, if any, to grant the copyright license set forth in this Agreement. 37 | 38 | 3. REQUIREMENTS 39 | 40 | A Contributor may choose to distribute the Program in object code form under its own license agreement, provided that: 41 | 42 | a) it complies with the terms and conditions of this Agreement; and 43 | 44 | b) its license agreement: 45 | 46 | i) effectively disclaims on behalf of all Contributors all warranties and conditions, express and implied, including warranties or conditions of title and non-infringement, and implied warranties or conditions of merchantability and fitness for a particular purpose; 47 | 48 | ii) effectively excludes on behalf of all Contributors all liability for damages, including direct, indirect, special, incidental and consequential damages, such as lost profits; 49 | 50 | iii) states that any provisions which differ from this Agreement are offered by that Contributor alone and not by any other party; and 51 | 52 | iv) states that source code for the Program is available from such Contributor, and informs licensees how to obtain it in a reasonable manner on or through a medium customarily used for software exchange. 53 | 54 | When the Program is made available in source code form: 55 | 56 | a) it must be made available under this Agreement; and 57 | 58 | b) a copy of this Agreement must be included with each copy of the Program. 59 | 60 | Contributors may not remove or alter any copyright notices contained within the Program. 61 | 62 | Each Contributor must identify itself as the originator of its Contribution, if any, in a manner that reasonably allows subsequent Recipients to identify the originator of the Contribution. 63 | 64 | 4. COMMERCIAL DISTRIBUTION 65 | 66 | Commercial distributors of software may accept certain responsibilities with respect to end users, business partners and the like. While this license is intended to facilitate the commercial use of the Program, the Contributor who includes the Program in a commercial product offering should do so in a manner which does not create potential liability for other Contributors. Therefore, if a Contributor includes the Program in a commercial product offering, such Contributor ("Commercial Contributor") hereby agrees to defend and indemnify every other Contributor ("Indemnified Contributor") against any losses, damages and costs (collectively "Losses") arising from claims, lawsuits and other legal actions brought by a third party against the Indemnified Contributor to the extent caused by the acts or omissions of such Commercial Contributor in connection with its distribution of the Program in a commercial product offering. The obligations in this section do not apply to any claims or Losses relating to any actual or alleged intellectual property infringement. In order to qualify, an Indemnified Contributor must: a) promptly notify the Commercial Contributor in writing of such claim, and b) allow the Commercial Contributor to control, and cooperate with the Commercial Contributor in, the defense and any related settlement negotiations. The Indemnified Contributor may participate in any such claim at its own expense. 67 | 68 | For example, a Contributor might include the Program in a commercial product offering, Product X. That Contributor is then a Commercial Contributor. If that Commercial Contributor then makes performance claims, or offers warranties related to Product X, those performance claims and warranties are such Commercial Contributor's responsibility alone. Under this section, the Commercial Contributor would have to defend claims against the other Contributors related to those performance claims and warranties, and if a court requires any other Contributor to pay any damages as a result, the Commercial Contributor must pay those damages. 69 | 70 | 5. NO WARRANTY 71 | 72 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the appropriateness of using and distributing the Program and assumes all risks associated with its exercise of rights under this Agreement , including but not limited to the risks and costs of program errors, compliance with applicable laws, damage to or loss of data, programs or equipment, and unavailability or interruption of operations. 73 | 74 | 6. DISCLAIMER OF LIABILITY 75 | 76 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 77 | 78 | 7. GENERAL 79 | 80 | If any provision of this Agreement is invalid or unenforceable under applicable law, it shall not affect the validity or enforceability of the remainder of the terms of this Agreement, and without further action by the parties hereto, such provision shall be reformed to the minimum extent necessary to make such provision valid and enforceable. 81 | 82 | If Recipient institutes patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Program itself (excluding combinations of the Program with other software or hardware) infringes such Recipient's patent(s), then such Recipient's rights granted under Section 2(b) shall terminate as of the date such litigation is filed. 83 | 84 | All Recipient's rights under this Agreement shall terminate if it fails to comply with any of the material terms or conditions of this Agreement and does not cure such failure in a reasonable period of time after becoming aware of such noncompliance. If all Recipient's rights under this Agreement terminate, Recipient agrees to cease use and distribution of the Program as soon as reasonably practicable. However, Recipient's obligations under this Agreement and any licenses granted by Recipient relating to the Program shall continue and survive. 85 | 86 | Everyone is permitted to copy and distribute copies of this Agreement, but in order to avoid inconsistency the Agreement is copyrighted and may only be modified in the following manner. The Agreement Steward reserves the right to publish new versions (including revisions) of this Agreement from time to time. No one other than the Agreement Steward has the right to modify this Agreement. The Eclipse Foundation is the initial Agreement Steward. The Eclipse Foundation may assign the responsibility to serve as the Agreement Steward to a suitable separate entity. Each new version of the Agreement will be given a distinguishing version number. The Program (including Contributions) may always be distributed subject to the version of the Agreement under which it was received. In addition, after a new version of the Agreement is published, Contributor may elect to distribute the Program (including its Contributions) under the new version. Except as expressly stated in Sections 2(a) and 2(b) above, Recipient receives no rights or licenses to the intellectual property of any Contributor under this Agreement, whether expressly, by implication, estoppel or otherwise. All rights in the Program not expressly granted under this Agreement are reserved. 87 | 88 | This Agreement is governed by the laws of the State of New York and the intellectual property laws of the United States of America. No party to this Agreement will bring a legal action under this Agreement more than one year after the cause of action arose. Each party waives its rights to a jury trial in any resulting litigation. 89 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # Introduction 3 | 4 | clj-ldap is a thin layer on the [unboundid sdk](http://www.unboundid.com/products/ldap-sdk/) and allows clojure programs to talk to ldap servers. This library is available on [clojars.org](http://clojars.org/search?q=clj-ldap) 5 | 6 | :dependencies [[puppetlabs/clj-ldap "0.3.0"]] 7 | 8 | # Example 9 | 10 | (ns example 11 | (:require [clj-ldap.client :as ldap])) 12 | 13 | (def ldap-server (ldap/connect {:host "ldap.example.com"})) 14 | 15 | (ldap/get ldap-server "cn=dude,ou=people,dc=example,dc=com") 16 | 17 | ;; Returns a map such as 18 | {:gidNumber "2000" 19 | :loginShell "/bin/bash" 20 | :objectClass #{"inetOrgPerson" "posixAccount" "shadowAccount"} 21 | :mail "dude@example.com" 22 | :sn "Dudeness" 23 | :cn "dude" 24 | :uid "dude" 25 | :homeDirectory "/home/dude"} 26 | 27 | # API 28 | 29 | ## connect [options] 30 | 31 | Connects to an ldap server and returns a, thread safe, [LDAPConnectionPool](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPConnectionPool.html). 32 | Options is a map with the following entries: 33 | 34 | :host Either a string in the form "address:port" 35 | OR a map containing the keys, 36 | :address defaults to localhost 37 | :port defaults to 389 (or 636 for ldaps), 38 | OR a collection containing multiple hosts used for load 39 | balancing and failover. This entry is optional. 40 | :bind-dn The DN to bind as, optional 41 | :password The password to bind with, optional 42 | :num-connections The number of connections in the pool, defaults to 1 43 | :ssl? Boolean, connect over SSL (ldaps), defaults to false 44 | :cipher-suites An optional set of strings corresponding to SSL 45 | cipher suites, defaults to nil 46 | :ssl-protocols An optional set of strings corresponding to SSL 47 | protocols. `TLSv1.3`, `TLSv1.2`, `TLSv1.1`, & `TLSv1` are 48 | supported options, defaults to nil 49 | :start-tls? Boolean, use startTLS to initiate TLS on an otherwise 50 | unsecured connection, defaults to false. 51 | :trust-store Only trust SSL certificates that are in this 52 | JKS format file, optional, defaults to trusting all 53 | certificates 54 | :trust-managers An optional TrustManager array to be used in place of 55 | a temporary keystore to create an SSLSocketFactory. 56 | :verify-host? Verifies the hostname of the specified certificate, 57 | false by default. 58 | :wildcard-host? Allows wildcard in certificate hostname verification, 59 | false by default. 60 | :connect-timeout The timeout for making connections (milliseconds), 61 | :timeout The timeout when waiting for a response from the server 62 | (milliseconds), defaults to 5 minutes 63 | 64 | Throws an [LDAPException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPException.html) if an error occurs establishing the connection pool or authenticating to any of the servers. 65 | 66 | An example: 67 | (ldap/connect conn {:host "ldap.example.com" :num-connections 10}) 68 | 69 | (ldap/connect conn {:host [{:address "ldap1.example.com" :port 8000} 70 | {:address "ldap3.example.com"} 71 | "ldap2.example.com:8001"] 72 | :ssl? true 73 | :num-connections 9}) 74 | 75 | (ldap/connect conn {:host {:port 8000}}) 76 | 77 | 78 | ## bind? [connection bind-dn password] [connection-pool bind-dn password] 79 | 80 | Usage: 81 | (ldap/bind? conn "cn=dude,ou=people,dc=example,dc=com" "somepass") 82 | 83 | Performs a bind operation using the provided connection, bindDN and 84 | password. Returns true if successful. 85 | 86 | When an LDAP connection object is used as the connection argument the 87 | bind? function will attempt to change the identity of that connection 88 | to that of the provided DN. Subsequent operations on that connection 89 | will be done using the bound identity. 90 | 91 | If an LDAP connection pool object is passed as the connection argument 92 | the bind attempt will have no side-effects, leaving the state of the 93 | underlying connections unchanged. 94 | 95 | ## get [connection dn] [connection dn attributes] 96 | 97 | If successful, returns a map containing the entry for the given DN. 98 | Returns nil if the entry doesn't exist. 99 | 100 | (ldap/get conn "cn=dude,ou=people,dc=example,dc=com") 101 | 102 | Takes an optional collection that specifies which attributes will be returned from the server. 103 | 104 | (ldap/get conn "cn=dude,ou=people,dc=example,dc=com" [:cn :sn]) 105 | 106 | Throws a [LDAPException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPException.html) on error. 107 | 108 | ## add [connection dn entry] 109 | 110 | Adds an entry to the connected ldap server. The entry is map of keywords to values which can be strings, sets or vectors. 111 | 112 | 113 | (ldap/add conn "cn=dude,ou=people,dc=example,dc=com" 114 | {:objectClass #{"top" "person"} 115 | :cn "dude" 116 | :sn "a" 117 | :description "His dudeness" 118 | :telephoneNumber ["1919191910" "4323324566"]}) 119 | 120 | Throws a [LDAPException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPException.html) if there is an error with the request or the add failed. 121 | 122 | ## modify [connection dn modifications] 123 | 124 | Modifies an entry in the connected ldap server. The modifications are 125 | a map in the form: 126 | {:add 127 | {:attribute-a some-value 128 | :attribute-b [value1 value2]} 129 | :delete 130 | {:attribute-c :all 131 | :attribute-d some-value 132 | :attribute-e [value1 value2]} 133 | :replace 134 | {:attibute-d value 135 | :attribute-e [value1 value2]} 136 | :increment 137 | {:attribute-f value} 138 | :pre-read 139 | #{:attribute-a :attribute-b} 140 | :post-read 141 | #{:attribute-c :attribute-d}} 142 | 143 | Where :add adds an attribute value, :delete deletes an attribute value and :replace replaces the set of values for the attribute with the ones specified. The entries :pre-read and :post-read specify attributes that have be read and returned either before or after the modifications have taken place. 144 | 145 | All the keys in the map are optional e.g: 146 | 147 | (ldap/modify conn "cn=dude,ou=people,dc=example,dc=com" 148 | {:add {:telephoneNumber "232546265"}}) 149 | 150 | The values in the map can also be set to :all when doing a delete e.g: 151 | 152 | (ldap/modify conn "cn=dude,ou=people,dc=example,dc=com" 153 | {:delete {:telephoneNumber :all}}) 154 | 155 | The values of the attributes given in :pre-read and :post-read are available in the returned map and are part of an atomic ldap operation e.g 156 | 157 | (ldap/modify conn "uid=maxuid,ou=people,dc=example,dc=com" 158 | {:increment {:uidNumber 1} 159 | :post-read #{:uidNumber}}) 160 | 161 | returns> 162 | {:code 0 163 | :name "success" 164 | :post-read {:uidNumber "2002"}} 165 | 166 | The above technique can be used to maintain counters for unique ids as described by [rfc4525](http://tools.ietf.org/html/rfc4525). 167 | 168 | Throws a [LDAPException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPException.html) on error. 169 | 170 | ## search [connection base] [connection base options] 171 | 172 | Runs a search on the connected ldap server, reads all the results into 173 | memory and returns the results as a sequence of maps. An introduction 174 | to ldap searching can be found in this [article](http://www.enterprisenetworkingplanet.com/netsysm/article.php/3317551/Unmasking-the-LDAP-Search-Filter.htm). 175 | 176 | Options is a map with the following optional entries: 177 | :scope The search scope, can be :base :one or :sub, 178 | defaults to :sub 179 | :filter A string describing the search filter, 180 | defaults to "(objectclass=*)" 181 | :attributes A collection of the attributes to return, 182 | defaults to all user attributes 183 | e.g 184 | (ldap/search conn "ou=people,dc=example,dc=com") 185 | 186 | (ldap/search conn "ou=people,dc=example,dc=com" {:attributes [:cn]}) 187 | 188 | Throws a [LDAPSearchException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPSearchException.html) on error. 189 | 190 | ## search! [connection base f] [connection base options f] 191 | 192 | Runs a search on the connected ldap server and executes the given 193 | function (for side effects) on each result. Does not read all the 194 | results into memory. 195 | 196 | Options is a map with the following optional entries: 197 | :scope The search scope, can be :base :one or :sub, 198 | defaults to :sub 199 | :filter A string describing the search filter, 200 | defaults to "(objectclass=*)" 201 | :attributes A collection of the attributes to return, 202 | defaults to all user attributes 203 | :queue-size The size of the internal queue used to store results before 204 | they are passed to the function, the default is 100 205 | 206 | e.g 207 | (ldap/search! conn "ou=people,dc=example,dc=com" println) 208 | 209 | (ldap/search! conn "ou=people,dc=example,dc=com" 210 | {:filter "sn=dud*"} 211 | (fn [x] 212 | (println "Hello " (:cn x)))) 213 | 214 | Throws a [LDAPSearchException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPSearchException.html) if an error occurs during search. Throws an [EntrySourceException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/EntrySourceException.html) if there is an eror obtaining search results. 215 | 216 | ## delete [connection dn] [connection dn options] 217 | 218 | Deletes the given entry in the connected ldap server. Optionally takes a map that can contain the entry :pre-read to indicate the attributes that should be read before deletion. 219 | 220 | (ldap/delete conn "cn=dude,ou=people,dc=example,dc=com") 221 | 222 | (ldap/delete conn "cn=dude,ou=people,dc=example,dc=com" 223 | {:pre-read #{"telephoneNumber"}}) 224 | 225 | Throws a [LDAPException](http://www.unboundid.com/products/ldap-sdk/docs/javadoc/com/unboundid/ldap/sdk/LDAPException.html) if the object does not exist or an error occurs. 226 | 227 | ## Support 228 | 229 | To file a bug, please open a Jira ticket against this project. Bugs and PRs are 230 | addressed on a best-effort basis. Puppet Inc does not guarantee support for 231 | this project. 232 | 233 | ## Maintenance 234 | Maintainers: Jonathan Newman 235 | Tickets: [Puppet Enterprise](https://tickets.puppetlabs.com/browse/ENTERPRISE/). Make sure to set component to "clj-ldap". 236 | 237 | 238 | ## License 239 | 240 | Eclipse Public License, v 1.0 241 | -------------------------------------------------------------------------------- /src/clojure/clj_ldap/client.clj: -------------------------------------------------------------------------------- 1 | (ns clj-ldap.client 2 | "LDAP client" 3 | (:refer-clojure :exclude [get]) 4 | (:require [clojure.string :as string] 5 | [clojure.tools.logging :as log]) 6 | (:import (com.unboundid.asn1 ASN1OctetString) 7 | (com.unboundid.ldap.sdk 8 | BindRequest Control LDAPConnectionOptions 9 | LDAPConnection 10 | LDAPResult ReadOnlyEntry ResultCode 11 | LDAPConnectionPool 12 | LDAPException 13 | Attribute 14 | Entry 15 | ModificationType 16 | ModifyRequest 17 | ModifyDNRequest 18 | Modification 19 | DeleteRequest 20 | SimpleBindRequest 21 | RoundRobinServerSet 22 | SearchRequest 23 | LDAPEntrySource 24 | EntrySourceException 25 | SearchScope UpdatableLDAPRequest) 26 | (com.unboundid.ldap.sdk.extensions 27 | PasswordModifyExtendedRequest 28 | StartTLSExtendedRequest) 29 | (com.unboundid.ldap.sdk.controls 30 | PreReadRequestControl 31 | PostReadRequestControl 32 | PreReadResponseControl 33 | PostReadResponseControl 34 | SimplePagedResultsControl) 35 | (com.unboundid.util.ssl 36 | SSLUtil TrustAllTrustManager 37 | HostNameSSLSocketVerifier) 38 | (com.puppetlabs.ldap Utils) 39 | (javax.net.ssl SSLSocketFactory))) 40 | 41 | ;;======== Helper functions ==================================================== 42 | 43 | (def not-nil? (complement nil?)) 44 | 45 | (defn encode ^String [^Attribute attr] 46 | (.getValue attr)) 47 | 48 | (defn ssl-protocol-mapping 49 | "Converts user protocol settings into valid string constants" 50 | [ssl-protocols] 51 | (let [valid-protocols #{"TLSv1.3" "TLSv1.2" "TLSv1.1" "TLSv1"} 52 | valid-ssl-protocols (filter #(contains? valid-protocols %) ssl-protocols) 53 | invalid-ssl-protocols (remove #(contains? valid-protocols %) ssl-protocols)] 54 | (when (not-nil? invalid-ssl-protocols) 55 | (log/infof "Unsuported value %s passed into SSL protocol" invalid-ssl-protocols) 56 | (log/infof "Removing %s from ssl-protocol" invalid-ssl-protocols)) 57 | (replace 58 | {"TLSv1.3" SSLUtil/SSL_PROTOCOL_TLS_1_3 59 | "TLSv1.2" SSLUtil/SSL_PROTOCOL_TLS_1_2 60 | "TLSv1.1" SSLUtil/SSL_PROTOCOL_TLS_1_1, 61 | "TLSv1" SSLUtil/SSL_PROTOCOL_TLS_1} valid-ssl-protocols))) 62 | 63 | (defn- extract-attribute 64 | "Extracts [:name value] from the given attribute object. Converts 65 | the objectClass attribute to a set." 66 | [^Attribute attr] 67 | (let [k (keyword (.getName attr))] 68 | (cond 69 | (= :objectClass k) [k (set (vec (.getValues attr)))] 70 | (> (.size attr) 1) [k (vec (.getValues attr))] 71 | :else [k (encode attr)]))) 72 | 73 | (defn- entry-as-map 74 | "Converts an Entry object into a map optionally adding the DN" 75 | ([^ReadOnlyEntry entry] 76 | (entry-as-map entry true)) 77 | ([^ReadOnlyEntry entry dn?] 78 | (let [attrs (seq (.getAttributes entry))] 79 | (if dn? 80 | (apply hash-map :dn (.getDN entry) 81 | (mapcat extract-attribute attrs)) 82 | (apply hash-map 83 | (mapcat extract-attribute attrs)))))) 84 | 85 | (defn- add-response-control 86 | "Adds the values contained in given response control to the given map" 87 | [m control] 88 | (condp instance? control 89 | PreReadResponseControl 90 | (update-in m [:pre-read] merge (entry-as-map (.getEntry ^PreReadResponseControl control) false)) 91 | PostReadResponseControl 92 | (update-in m [:post-read] merge (entry-as-map (.getEntry ^PostReadResponseControl control) false)) 93 | m)) 94 | 95 | (defn- add-response-controls 96 | "Adds the values contained in the given response controls to the given map" 97 | [controls m] 98 | (reduce add-response-control m (seq controls))) 99 | 100 | (defn- ldap-result 101 | "Converts an LDAPResult object into a map" 102 | [^LDAPResult obj] 103 | (let [res (.getResultCode obj) 104 | controls (.getResponseControls obj)] 105 | (add-response-controls 106 | controls 107 | {:code (.intValue res) 108 | :name (.getName res)}))) 109 | 110 | (defn- connection-options 111 | "Returns a LDAPConnectionOptions object" 112 | ^LDAPConnectionOptions [{:keys [connect-timeout timeout verify-host? wildcard-host?]}] 113 | (let [opt (LDAPConnectionOptions.)] 114 | (when connect-timeout (.setConnectTimeoutMillis opt connect-timeout)) 115 | (when timeout (.setResponseTimeoutMillis opt timeout)) 116 | (when (true? verify-host?) (.setSSLSocketVerifier opt (HostNameSSLSocketVerifier. (true? wildcard-host?)))) 117 | opt)) 118 | 119 | (defn- create-ssl-util 120 | "If the trust-manager is truthy, returns a SSLUtil created with 121 | it; otherwise, if trust-store is truthy, returns a SSLUtil created with 122 | it. If both are falsy, returns a SSLUtil created with a TrustAllTrustManager." 123 | [trust-managers trust-store] 124 | (if trust-managers 125 | (Utils/trustManagersToSSLUtil trust-managers) 126 | (if trust-store 127 | (Utils/trustStoreToSSLUtil trust-store) 128 | (Utils/trustManagerToSSLUtil 129 | (TrustAllTrustManager.))))) 130 | 131 | (defn- create-ssl-factory 132 | "Returns a SSLSocketFactory object" 133 | ^SSLSocketFactory [{:keys [trust-managers trust-store cipher-suites ssl-protocols]}] 134 | (let [^SSLUtil ssl-util (create-ssl-util trust-managers trust-store)] 135 | (when (not-nil? cipher-suites) 136 | (SSLUtil/setEnabledSSLCipherSuites cipher-suites)) 137 | (when (not-nil? ssl-protocols) 138 | (SSLUtil/setEnabledSSLProtocols (ssl-protocol-mapping ssl-protocols))) 139 | (.createSSLSocketFactory ssl-util))) 140 | 141 | (defn- host-as-map 142 | "Returns a single host as a map containing an :address and an optional 143 | :port" 144 | [host] 145 | (cond 146 | (nil? host) {:address "localhost" :port 389} 147 | (string? host) (let [[address port] (string/split host #":")] 148 | {:address (if (= address "") 149 | "localhost" 150 | address) 151 | :port (when port 152 | (if (string? port) 153 | (int (Integer/parseInt port)) 154 | port))}) 155 | (map? host) (merge {:address "localhost"} host) 156 | :else (throw 157 | (IllegalArgumentException. 158 | (str "Invalid host for an ldap connection : " 159 | host))))) 160 | 161 | (defn- create-connection 162 | "Create an LDAPConnection object" 163 | ^LDAPConnection [{:keys [host ssl? start-tls?] :as options}] 164 | (let [h (host-as-map host) 165 | ^LDAPConnectionOptions opt (connection-options options) 166 | ^String address (:address h) 167 | ^int effective-port (or (:port h) 389) 168 | ^int effective-ssl-port (or (:port h) 636)] 169 | (cond 170 | (and ssl? start-tls?) 171 | (throw (IllegalArgumentException. "Can't have both SSL and startTLS")) 172 | 173 | ssl? 174 | (LDAPConnection. ^SSLSocketFactory (create-ssl-factory options) opt address effective-ssl-port) 175 | 176 | start-tls? 177 | (let [start-tls-req (StartTLSExtendedRequest. (create-ssl-factory options))] 178 | (doto (LDAPConnection. opt address effective-port) 179 | (.processExtendedOperation start-tls-req))) 180 | 181 | :else 182 | (LDAPConnection. opt address effective-port)))) 183 | 184 | (defn- bind-request 185 | "Returns a BindRequest object" 186 | ^BindRequest [{:keys [bind-dn password]}] 187 | (if bind-dn 188 | (SimpleBindRequest. ^String bind-dn ^String password) 189 | (SimpleBindRequest.))) 190 | 191 | (defn- connect-to-host 192 | "Connect to a single host" 193 | [options] 194 | (let [{:keys [num-connections]} options 195 | connection (create-connection options) 196 | bind-result (.bind connection (bind-request options))] 197 | (if (= ResultCode/SUCCESS (.getResultCode bind-result)) 198 | (LDAPConnectionPool. connection (or num-connections 1)) 199 | (throw (LDAPException. bind-result))))) 200 | 201 | (defn- create-server-set 202 | "Returns a RoundRobinServerSet" 203 | ^RoundRobinServerSet [{:keys [host ssl?] :as options}] 204 | (let [hosts (map host-as-map host) 205 | ^"[Ljava.lang.String;" addresses (into-array String (map :address hosts)) 206 | ^LDAPConnectionOptions opt (connection-options options)] 207 | (if ssl? 208 | (let [ssl (create-ssl-factory options) 209 | ^"[I" ports (int-array (map #(or (:port %) (int 636)) hosts))] 210 | (RoundRobinServerSet. addresses ports ssl opt)) 211 | (let [^"[I" ports (int-array (map #(or (:port %) (int 389)) hosts))] 212 | (RoundRobinServerSet. addresses ports opt))))) 213 | 214 | (defn- connect-to-hosts 215 | "Connects to multiple hosts" 216 | [options] 217 | (let [{:keys [num-connections]} options 218 | ^RoundRobinServerSet server-set (create-server-set options) 219 | ^BindRequest bind-request (bind-request options) 220 | ^int connections (or num-connections 1)] 221 | (LDAPConnectionPool. server-set bind-request connections))) 222 | 223 | (defn- set-entry-kv! 224 | "Sets the given key/value pair in the given entry object" 225 | [^Entry entry-obj k v] 226 | (let [name-str (name k)] 227 | (.addAttribute entry-obj 228 | (if (coll? v) 229 | (let [^"[Ljava.lang.String;" values (into-array String v)] 230 | (Attribute. name-str values)) 231 | (Attribute. name-str (str v)))))) 232 | 233 | (defn- set-entry-map! 234 | "Sets the attributes in the given entry object using the given map" 235 | [entry-obj m] 236 | (doseq [[k v] m] 237 | (set-entry-kv! entry-obj k v))) 238 | 239 | (defn- create-modification 240 | "Creates a modification object" 241 | [^ModificationType modify-op ^String attribute values] 242 | (cond 243 | (coll? values) (if (string? (first values)) 244 | (let [^"[Ljava.lang.String;" string-values (into-array String values)] 245 | (Modification. modify-op attribute string-values)) 246 | (let [^"[Lcom.unboundid.asn1.ASN1OctetString;" octet-values (into-array ASN1OctetString values)] 247 | (Modification. modify-op attribute octet-values))) 248 | (bytes? values) (Modification. modify-op attribute ^"[B" values) 249 | (= :all values) (Modification. modify-op attribute) 250 | :else (Modification. modify-op attribute (str values)))) 251 | 252 | (defn- modify-ops 253 | "Returns a sequence of Modification objects to do the given operation 254 | using the contents of the given map." 255 | [^ModificationType modify-op modify-map] 256 | (for [[k v] modify-map] 257 | (create-modification modify-op (name k) v))) 258 | 259 | (defn- add-request-controls 260 | "Adds LDAP controls to the given request" 261 | [^UpdatableLDAPRequest request options] 262 | (when (contains? options :pre-read) 263 | (let [attributes (map name (options :pre-read)) 264 | pre-read-control (PreReadRequestControl. ^"[Ljava.lang.String;" (into-array String attributes))] 265 | (.addControl request pre-read-control))) 266 | (when (contains? options :post-read) 267 | (let [attributes (map name (options :post-read)) 268 | pre-read-control (PostReadRequestControl. ^"[Ljava.lang.String;" (into-array String attributes))] 269 | (.addControl request pre-read-control)))) 270 | 271 | 272 | (defn- get-modify-request 273 | "Sets up a ModifyRequest object using the contents of the given map" 274 | ^ModifyRequest [^String dn modifications] 275 | (let [adds (modify-ops ModificationType/ADD (modifications :add)) 276 | deletes (modify-ops ModificationType/DELETE (modifications :delete)) 277 | replacements (modify-ops ModificationType/REPLACE 278 | (modifications :replace)) 279 | increments (modify-ops ModificationType/INCREMENT 280 | (modifications :increment)) 281 | all (concat adds deletes replacements increments) 282 | ^"[Lcom.unboundid.ldap.sdk.Modification;" as-array (into-array Modification all)] 283 | (doto (ModifyRequest. dn as-array) 284 | (add-request-controls modifications)))) 285 | 286 | (defn- entry-seq 287 | "Returns a lazy sequence of entries from an LDAPEntrySource object" 288 | [^LDAPEntrySource source] 289 | (when-let [n (.nextEntry source)] 290 | (cons n (lazy-seq (entry-seq source))))) 291 | 292 | ;; Extended version of search-results function using a 293 | ;; SearchRequest that uses a SimplePagedResultsControl. 294 | ;; Allows us to read arbitrarily large result sets. 295 | ;; TODO make this lazy 296 | (defn- search-all-results 297 | "Returns a sequence of search results via paging so we don't run into 298 | size limits with the number of results." 299 | [^LDAPConnectionPool connection criteria] 300 | (let [sizeLimit 500 301 | ^String base (:base criteria) 302 | ^SearchScope scope (:scope criteria) 303 | ^String filter (:filter criteria) 304 | ^"[Ljava.lang.String;" attributes (:attributes criteria) 305 | ^SearchRequest req (SearchRequest. base scope filter attributes)] 306 | (loop [results [] 307 | cookie nil] 308 | (let [^"[Lcom.unboundid.ldap.sdk.Control;" page-results-array (make-array Control (SimplePagedResultsControl. sizeLimit cookie))] 309 | (.setControls req page-results-array)) 310 | (let [res (.search connection req) 311 | control (SimplePagedResultsControl/get res) 312 | newres (->> (.getSearchEntries res) 313 | (map entry-as-map) 314 | (remove empty?) 315 | (into results))] 316 | (if (and 317 | (not-nil? control) 318 | (> (.getValueLength (.getCookie control)) 0)) 319 | (recur newres (.getCookie control)) 320 | (seq newres)))))) 321 | 322 | (defn- search-results 323 | "Returns a sequence of search results for the given search criteria." 324 | [^LDAPConnectionPool connection criteria] 325 | (let [^String base (:base criteria) 326 | ^SearchScope scope (:scope criteria) 327 | ^String filter (:filter criteria) 328 | ^"[Ljava.lang.String;" attributes (:attributes criteria) 329 | res (.search connection base scope filter attributes)] 330 | (when (> (.getEntryCount res) 0) 331 | (remove empty? 332 | (map entry-as-map (.getSearchEntries res)))))) 333 | 334 | (defn- search-results! 335 | "Call the given function with the results of the search using 336 | the given search criteria" 337 | [^LDAPConnectionPool pool criteria _queue-size f] 338 | (let [^String base (:base criteria) 339 | ^SearchScope scope (:scope criteria) 340 | ^String filter (:filter criteria) 341 | ^"[Ljava.lang.String;" attributes (:attributes criteria) 342 | request (SearchRequest. base scope filter attributes) 343 | conn (.getConnection pool)] 344 | (try 345 | (with-open [source (LDAPEntrySource. conn request false)] 346 | (doseq [i (remove empty? 347 | (map entry-as-map (entry-seq source)))] 348 | (f i))) 349 | (.releaseConnection pool conn) 350 | (catch EntrySourceException e 351 | (.releaseDefunctConnection pool conn) 352 | (throw e))))) 353 | 354 | 355 | (defn- get-scope 356 | "Converts a keyword into a SearchScope object" 357 | [k] 358 | (condp = k 359 | :base SearchScope/BASE 360 | :one SearchScope/ONE 361 | SearchScope/SUB)) 362 | 363 | (defn- get-attributes 364 | "Converts a collection of attributes into an array" 365 | [attrs] 366 | (cond 367 | (or (nil? attrs) 368 | (empty? attrs)) (into-array String 369 | [SearchRequest/ALL_USER_ATTRIBUTES]) 370 | :else (into-array String 371 | (map name attrs)))) 372 | 373 | (defn- search-criteria 374 | "Returns a map of search criteria from the given base and options" 375 | [base options] 376 | (let [scope (get-scope (:scope options)) 377 | filter (or (:filter options) "(objectclass=*)") 378 | attributes (get-attributes (:attributes options))] 379 | {:base base 380 | :scope scope 381 | :filter filter 382 | :attributes attributes})) 383 | 384 | ;;=========== API ============================================================== 385 | 386 | (defn connect 387 | "Connects to an ldap server and returns a thread-safe LDAPConnectionPool. 388 | Options is a map with the following entries: 389 | :host Either a string in the form \"address:port\" 390 | OR a map containing the keys, 391 | :address defaults to localhost 392 | :port defaults to 389 (or 636 for ldaps), 393 | OR a collection containing multiple hosts used for load 394 | balancing and failover. This entry is optional. 395 | :bind-dn The DN to bind as, optional 396 | :password The password to bind with, optional 397 | :num-connections The number of connections in the pool, defaults to 1 398 | :ssl? Boolean, connect over SSL (ldaps), defaults to false 399 | :cipher-suites An optional set of strings corresponding to SSL 400 | cipher suites, defaults to nil 401 | :ssl-protocols An optional set of strings corresponding to SSL 402 | protocols. TLSv1.3, TLSv1.2, TLSv1.1, & TLSv1 are 403 | supported options, defaults to nil 404 | :start-tls? Boolean, use startTLS to initiate TLS on an otherwise 405 | unsecured connection, defaults to false. 406 | :trust-store Only trust SSL certificates that are in this 407 | JKS format file, optional, defaults to trusting all 408 | certificates 409 | :trust-managers An optional TrustManager array to be used in place of 410 | a temporary keystore to create an SSLSocketFactory. 411 | :verify-host? Verifies the hostname of the specified certificate, 412 | false by default. 413 | :wildcard-host? Allows wildcard in certificate hostname verification, 414 | false by default. 415 | :connect-timeout The timeout for making connections (milliseconds), 416 | defaults to 1 minute 417 | :timeout The timeout when waiting for a response from the server 418 | (milliseconds), defaults to 5 minutes 419 | " 420 | [options] 421 | (let [host (options :host)] 422 | (if (and (coll? host) 423 | (not (map? host))) 424 | (connect-to-hosts options) 425 | (connect-to-host options)))) 426 | 427 | (defn bind? 428 | "Performs a bind operation using the provided connection, bindDN and 429 | password. Returns true if successful. 430 | 431 | When an LDAP connection object is used as the connection argument the 432 | bind? function will attempt to change the identity of that connection 433 | to that of the provided DN. Subsequent operations on that connection 434 | will be done using the bound identity. 435 | 436 | If an LDAP connection pool object is passed as the connection argument 437 | the bind attempt will have no side-effects, leaving the state of the 438 | underlying connections unchanged." 439 | [connection bind-dn password] 440 | (try 441 | (let [bind-result (.bind ^LDAPConnectionPool connection bind-dn password)] 442 | (if (= ResultCode/SUCCESS (.getResultCode bind-result)) true false)) 443 | (catch Exception _ false))) 444 | 445 | (defn get 446 | "If successful, returns a map containing the entry for the given DN. 447 | Returns nil if the entry doesn't exist or cannot be read. Takes an 448 | optional collection that specifies which attributes will be returned 449 | from the server." 450 | ([connection dn] 451 | (get connection dn nil)) 452 | ([^LDAPConnectionPool connection dn attributes] 453 | (when-let [result (if attributes 454 | (.getEntry connection dn 455 | (into-array String 456 | (map name attributes))) 457 | (.getEntry connection dn))] 458 | (entry-as-map result)))) 459 | 460 | (defn add 461 | "Adds an entry to the connected ldap server. The entry is assumed to be 462 | a map." 463 | [^LDAPConnectionPool connection ^String dn entry] 464 | (let [entry-obj (Entry. dn)] 465 | (set-entry-map! entry-obj entry) 466 | (ldap-result 467 | (.add connection entry-obj)))) 468 | 469 | (defn modify 470 | "Modifies an entry in the connected ldap server. The modifications are 471 | a map in the form: 472 | {:add 473 | {:attribute-a some-value 474 | :attribute-b [value1 value2]} 475 | :delete 476 | {:attribute-c :all 477 | :attribute-d some-value 478 | :attribute-e [value1 value2]} 479 | :replace 480 | {:attibute-d value 481 | :attribute-e [value1 value2]} 482 | :increment 483 | {:attribute-f value} 484 | :pre-read 485 | #{:attribute-a :attribute-b} 486 | :post-read 487 | #{:attribute-c :attribute-d}} 488 | 489 | Where :add adds an attribute value, :delete deletes an attribute value and 490 | :replace replaces the set of values for the attribute with the ones specified. 491 | The entries :pre-read and :post-read specify attributes that have be read and 492 | returned either before or after the modifications have taken place." 493 | [^LDAPConnectionPool connection dn modifications] 494 | (let [modify-obj (get-modify-request dn modifications)] 495 | (ldap-result 496 | (.modify connection modify-obj)))) 497 | 498 | (defn modify-password 499 | "Creates a new password modify extended request that will attempt to change 500 | the password of the currently-authenticated user, or another user if their 501 | DN is provided and the caller has the required authorisation." 502 | ([^LDAPConnectionPool connection ^String new] 503 | (let [request (PasswordModifyExtendedRequest. new)] 504 | (.processExtendedOperation connection request))) 505 | 506 | ([^LDAPConnectionPool connection ^String old ^String new] 507 | (let [request (PasswordModifyExtendedRequest. old new)] 508 | (.processExtendedOperation connection request))) 509 | 510 | ([^LDAPConnectionPool connection ^String old ^String new ^String dn] 511 | (let [request (PasswordModifyExtendedRequest. dn old new)] 512 | (.processExtendedOperation connection request)))) 513 | 514 | (defn modify-rdn 515 | "Modifies the RDN (Relative Distinguished Name) of an entry in the connected 516 | ldap server. 517 | 518 | The new-rdn has the form cn=foo or ou=foo. Using just foo is not sufficient. 519 | The delete-old-rdn boolean option indicates whether to delete the current 520 | RDN value from the target entry." 521 | [^LDAPConnectionPool connection ^String dn ^String new-rdn ^Boolean delete-old-rdn] 522 | (let [request (ModifyDNRequest. dn new-rdn delete-old-rdn)] 523 | (ldap-result 524 | (.modifyDN connection request)))) 525 | 526 | (defn delete 527 | "Deletes the given entry in the connected ldap server. Optionally takes 528 | a map that can contain the entry :pre-read to indicate the attributes 529 | that should be read before deletion." 530 | ([^LDAPConnectionPool connection ^String dn] 531 | (delete connection dn nil)) 532 | ([^LDAPConnectionPool connection ^String dn options] 533 | (let [delete-obj (DeleteRequest. dn)] 534 | (when options 535 | (add-request-controls delete-obj options)) 536 | (ldap-result 537 | (.delete connection delete-obj))))) 538 | 539 | (defn search-all 540 | "Runs a search on the connected ldap server, reads all the results into 541 | memory and returns the results as a sequence of maps. 542 | 543 | Options is a map with the following optional entries: 544 | :scope The search scope, can be :base :one or :sub, 545 | defaults to :sub 546 | :filter A string describing the search filter, 547 | defaults to \"(objectclass=*)\" 548 | :attributes A collection of the attributes to return, 549 | defaults to all user attributes" 550 | ([connection base] 551 | (search-all connection base nil)) 552 | ([connection base options] 553 | (search-all-results connection (search-criteria base options)))) 554 | 555 | (defn search 556 | "Runs a search on the connected ldap server, reads all the results into 557 | memory and returns the results as a sequence of maps. 558 | 559 | Options is a map with the following optional entries: 560 | :scope The search scope, can be :base :one or :sub, 561 | defaults to :sub 562 | :filter A string describing the search filter, 563 | defaults to \"(objectclass=*)\" 564 | :attributes A collection of the attributes to return, 565 | defaults to all user attributes" 566 | ([connection base] 567 | (search connection base nil)) 568 | ([connection base options] 569 | (search-results connection (search-criteria base options)))) 570 | 571 | (defn search! 572 | "Runs a search on the connected ldap server and executes the given 573 | function (for side effects) on each result. Does not read all the 574 | results into memory. 575 | 576 | Options is a map with the following optional entries: 577 | :scope The search scope, can be :base :one or :sub, 578 | defaults to :sub 579 | :filter A string describing the search filter, 580 | defaults to \"(objectclass=*)\" 581 | :attributes A collection of the attributes to return, 582 | defaults to all user attributes 583 | :queue-size The size of the internal queue used to store results before 584 | they are passed to the function, the default is 100" 585 | ([connection base f] 586 | (search! connection base nil f)) 587 | ([connection base options f] 588 | (let [queue-size (or (:queue-size options) 100)] 589 | (search-results! connection 590 | (search-criteria base options) 591 | queue-size 592 | f)))) 593 | 594 | --------------------------------------------------------------------------------