Fetch LDAP entry by UID

config/sys.config

@@ -0,0 +1,4 @@
+[
+  {'elmdap', [{web_ip, "0.0.0.0"},
+                {web_port, 8080}]}
+].

config/vm.args

@@ -0,0 +1,6 @@
+-name elmdap
+
+-setcookie elmdap_cookie
+
++K true
++A30

priv/dispatch.conf

@@ -0,0 +1,3 @@
+%% -*- mode: erlang -*-
+
+{["uid", uid], 'elmdap-uid', []}.

rebar.config

@@ -2,7 +2,8 @@
 {lfe_first_files, []}.
 
 {deps, [
-    {lfe, {git, "git://github.com/rvirding/lfe", {tag, "1.0"}}}
+    {lfe, {git, "git://github.com/rvirding/lfe", {tag, "1.0"}}},
+    {webmachine, ".*", {git, "git://github.com/basho/webmachine.git", {branch, "master"}}}
 ]}.
 
 {plugins, [
@@ -13,6 +14,19 @@
   {pre, [{compile, {lfe, compile}}]}
 ]}.
 
+{relx, [{release, {'elmdap', "0.1.0"},
+         ['elmdap',
+          sasl]},
+
+        {sys_config, "./config/sys.config"},
+        {vm_args, "./config/vm.args"},
+
+        {dev_mode, true},
+        {include_erts, false},
+
+        {extended_start_script, true}]
+}.
+
 {profiles, [
   {dev, [
     {plugins, [
@@ -28,5 +42,12 @@
       ]},
     {deps, [
       {ltest, ".*", {git, "git://github.com/lfex/ltest.git", {tag, "0.8.0"}}}]}
+      ]},
+
+  {prod, [
+    {relx, [
+      {dev_mode, false},
+      {include_erts, true}
+      ]}
     ]}
   ]}.

src/elmdap-sup.lfe

@@ -25,6 +25,19 @@
 ;;; Supervisor callbacks
 
 (defun init (_args)
-  `#(ok #(#(one_for_one 0 1) ())))
+  (let* ((ip (os:getenv "WEBMACHINE_IP" "0.0.0.0"))
+         (port (os:getenv "WEBMACHINE_PORT" "8080"))
+         (`#(ok ,app) (application:get_application 'elmdap-sup))
+         (`#(ok ,dispatch) (file:consult (filename:join `(,(code:priv_dir app)
+                                                          "dispatch.conf"))))
+         (web_config `(#(ip ,ip)
+                       #(port ,port)
+                       #(log_dir "priv/log")
+                       #(dispatch ,dispatch)))
+         (web `#(webmachine_mochiweb
+                 #(webmachine_mochiweb start (,web_config))
+                 permanent 5000 worker (mochiweb_socket_server)))
+         (processes `(,web)))
+    `#(ok #(#(one_for_one 10 10) ,processes))))
 
 ;;; Internal functions

src/elmdap-uid.lfe

@@ -0,0 +1,56 @@
+(defmodule elmdap-uid
+  (export (init 1)
+          (service_available 2)
+          (resource_exists 2)
+          (is_authorized 2)
+          (content_types_provided 2)
+          (to_json 2)))
+
+(include-lib "webmachine/include/webmachine.hrl")
+
+(defrecord state
+  connection
+  entry)
+
+(defun init (args)
+  `#(ok ,(make-state)))
+
+(defun service_available (req-data state)
+  (case (elmdap:open)
+    (`#(ok ,connection) `#(true ,req-data ,(set-state state connection connection)))
+    (_ `#(false ,req-data ,state))))
+
+(defun resource_exists (req-data state)
+  (let ((`[#(uid ,uid)] (wrq:path_info req-data)))
+    (case (elmdap:from-uid uid)
+      (`#(ok ,entry)
+       `#(true ,req-data ,(set-state state entry entry)))
+      (_ `#(false ,req-data ,state)))))
+
+(defun is_authorized (req-data state)
+  (let ((auth-header "Basic realm=Elmdap"))
+    (case (elmdap:basic-auth-credentials req-data)
+      (`#(ok ,uid ,password)
+       (case (elmdap:from-uid uid)
+         (`#(ok ,entry)
+          (case (eldap:simple_bind (state-connection state)
+                                   (elmdap:entry-dn entry)
+                                   password)
+            ('ok `#(true ,req-data ,state))
+            (_ `#(,auth-header ,req-data ,state))))
+         (_ `#(,auth-header ,req-data ,state))))
+      (_ `#(,auth-header ,req-data ,state)))))
+
+(defun content_types_provided (req-data state)
+  `#((#("application/json" to_json)) ,req-data ,state))
+
+(defun to_json (req-data state)
+  (let* ((entry (state-entry state)))
+    (tuple (mochijson:encode
+            `#(struct [#(dn ,(elmdap:entry-dn entry))
+                       #(attributes
+                         #(struct ,(lists:map
+                                    (match-lambda ((`#(,k ,v)) `#(,k #(array ,v))))
+                                    (elmdap:entry-attributes entry))))]))
+           req-data
+           state)))

src/elmdap.app.src

@@ -4,7 +4,11 @@
   {registered, []},
   {applications,
    [kernel,
-    stdlib
+    stdlib,
+    inets,
+    crypto,
+    mochiweb,
+    webmachine
    ]},
   {mod, {'elmdap-app', []}},
   {env, []},

src/elmdap.lfe

@@ -2,3 +2,46 @@
   (export all))
 
 ;; Public API
+
+(defun entry-dn
+  ((`#(eldap_entry ,dn ,_))
+   dn))
+
+(defun entry-attributes
+  ((`#(eldap_entry ,_ ,attributes))
+   attributes))
+
+(defun from-uid (uid)
+  (let* ((`#(ok ,connection) (open))
+         (base "ou=people,dc=coredial,dc=com")
+         (filter (eldap:equalityMatch "uid" uid))
+         (`#(ok #(eldap_search_result ,results ,_))
+          (eldap:search connection
+                        `[#(base ,base)
+                          #(filter ,filter)]))
+         )
+    (eldap:close connection)
+    (case results
+      ((cons (= entry `#(eldap_entry ,dn ,attributes)) _) `#(ok ,entry))
+      (_ #(error not_found)))))
+
+(defun open ()
+  (let ((hosts `[,(os:getenv "LDAP_HOST" "localhost")])
+        (options `[#(port ,(list_to_integer (os:getenv "LDAP_PORT" "389")))]))
+    (eldap:open hosts options)))
+
+(defun basic-auth-credentials (req-data)
+  (case (wrq:get_req_header "Authorization" req-data)
+    ('undefined #(error undefined))
+    (header (case (list_to_binary header)
+              ((binary "Basic " (base64 binary))
+               (case (string:tokens (base64:mime_decode_to_string base64) ":")
+                 ((list uid password)
+                  `#(ok ,uid ,password))
+                 (_ #(error bad_data))))
+              (_ #(error bad_method))))))
+
+(defun valid-auth? (connection dn password)
+  (case (eldap:simple_bind connection dn password)
+    ('ok 'true)
+    (_ 'false)))