-
Notifications
You must be signed in to change notification settings - Fork 3
/
nadex.clj
150 lines (132 loc) · 6.42 KB
/
nadex.clj
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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
(ns com.eldrix.concierge.wales.nadex
"Integration with NHS Wales' active directory for authentication and user lookup."
(:require [clojure.string :as str]
[clojure.java.io :as io]
[clojure.tools.logging.readable :as log])
(:import (com.unboundid.ldap.sdk LDAPConnectionPool LDAPConnection LDAPBindException LDAPConnectionOptions
SearchRequest SearchScope Filter Attribute SearchResultEntry)
(com.unboundid.util.ssl TrustAllTrustManager SSLUtil)
(java.util Collection)))
;; Unfortunately, the CYMRU domain uses a self-signed certificate. Alternatives would be to
;; use a custom keystore or downgrade to using a non-encrypted channel of communication.
;; In the circumstances, a man-in-the-middle attack within an intranet environment is unlikely,
;; so we simply accept self-signed server certificates and at least encrypt our communications.
(defn ^LDAPConnection make-unauthenticated-connection
"Creates a secure but unauthenticated connection, trusting all server certificates."
[]
(LDAPConnection.
(.createSSLSocketFactory (SSLUtil. (TrustAllTrustManager.)))
(doto (LDAPConnectionOptions.)
(.setConnectTimeoutMillis 2000)
(.setFollowReferrals false))
"cymru.nhs.uk"
636))
(defn ^LDAPConnectionPool make-connection-pool
"Make a connection pool to the NHS Wales 'NADEX' user directory."
([] (make-connection-pool 5))
([size]
(LDAPConnectionPool. (make-unauthenticated-connection) size)))
(defn can-authenticate?
"Can the user 'username' authenticate using the 'password' specified?
Parameters:
- pool : a connection pool
- username : username
- password : password."
[^LDAPConnectionPool pool username password]
(with-open [c (.getConnection pool)]
(try (.bind c (str username "@cymru.nhs.uk") password)
true
(catch LDAPBindException e false))))
(def ^:private returning-attributes
["sAMAccountName" "displayNamePrintable"
"personalTitle" "sn" "givenName"
"department" "mail", "title" ; title=job title, not name prefix
"physicalDeliveryOfficeName"
"postalAddress" "streetAddress" "l", "st", "postalCode"
"telephoneNumber" "mobile" "company" "wWWHomePage" "postOfficeBox" "thumbnailPhoto"])
(def ^:private binary-attributes
"List of attributes that should be returned as byte arrays."
#{"thumbnailPhoto"})
(defn- parse-attr
"Parse an LDAP attribute into a tuple key/value pair"
[^Attribute attr]
(let [n (.getName attr)
v (if (contains? binary-attributes n)
(.getValueByteArray attr)
(let [v (.getValues attr)] (if (= 1 (count v)) (first v) v)))]
[(keyword n) v]))
(defn assoc-professional-registration
"Attempt to infer professional regulator and code from user data.
NHS Wales keeps the number in the postOfficeBox field of the national
directory. I am not sure this is documented anywhere, but this should fail
gracefully if this changes."
[{:keys [postOfficeBox] :as user}]
(if-let [[_ auth code] (re-matches #"^(\w+)\s*:\s*(\d+)$" (or postOfficeBox ""))]
(assoc user :professionalRegistration {:regulator auth :code code})
user))
(defn parse-entry [^SearchResultEntry result]
(into {} (map parse-attr (.getAttributes result))))
(defn by-username
"Create an LDAP filter to search by username."
[^String username]
(Filter/createEqualityFilter "sAMAccountName" username))
(defn by-name
"Create an LDAP filter to search by name of individual.
This searches both surname 'sn' and first name 'givenName' fields."
[^String names]
(Filter/createANDFilter ^Collection
(->> (str/split names #"\s+")
(map #(Filter/createORFilter [(Filter/createSubInitialFilter "sn" ^String %)
(Filter/createSubInitialFilter "givenName" ^String %)])))))
(defn by-job [^String name]
(Filter/createSubAnyFilter "title" (into-array String (str/split name #"\s+"))))
(defn by-params
"Create an LDAP filter to search for the specified arbitrary parameters."
[params]
(let [clauses (map (fn [[k v]] (Filter/createEqualityFilter ^String (name k) ^String v)) params)]
(if (= 1 (count clauses))
(first clauses)
(Filter/createANDFilter ^Collection clauses))))
(defn do-ldap-search
[^LDAPConnectionPool pool bind-username bind-password ^Filter search-filter]
{:pre [pool bind-username bind-password]}
(log/info "ldap bind with username " bind-username "filter:" (.toNormalizedString search-filter))
(with-open [c (.getConnection pool)]
(.bind c (str bind-username "@cymru.nhs.uk") bind-password)
(seq (.getSearchEntries (.search c (SearchRequest.
"DC=cymru,DC=nhs,DC=uk"
SearchScope/SUB
(Filter/createANDFilter [(Filter/createEqualityFilter "objectClass" "User") search-filter])
(into-array String returning-attributes)))))))
(defn search
"Search for users, either using their own credentials (and implicitly
searching for themselves, or using specific generic binding credentials
and the 'filter' specified."
([^LDAPConnectionPool pool bind-username bind-password]
(search pool bind-username bind-password (by-username bind-username)))
([^LDAPConnectionPool pool bind-username bind-password ^Filter search-filter]
{:pre [pool bind-username bind-password]}
(->> (do-ldap-search pool bind-username bind-password search-filter)
(map parse-entry)
(map assoc-professional-registration))))
(comment
(do
(require '[aero.core])
(def config (:wales.nhs/nadex (aero.core/read-config (io/resource "config.edn"))))
(def bind-username (:default-bind-username config))
(def bind-password (:default-bind-password config))
(def pool (make-connection-pool)))
bind-username
bind-password
(can-authenticate? pool bind-username bind-password)
(search pool bind-username bind-password (by-username "ma090906"))
bind-password
(def ortho (search pool bind-username bind-password (by-job "orthopaedic")))
(require '[clojure.data.csv :as csv])
(with-open [writer (io/writer "out-file.csv")]
(clojure.data.csv/write-csv writer ortho))
(def jc (search pool bind-username bind-password (by-name "Chess")))
jc
(type (:thumbnailPhoto (first jc)))
(with-open [o (io/output-stream "jc.jpg")]
(.write o (:thumbnailPhoto (first jc)))))