moved everything under lisp/

30 files changed, 1645 insertions, 0 deletions

diff --git a/lisp/condition/condition.lisp b/lisp/condition/condition.lisp
new file mode 100644
index 0000000..9fb353a
--- /dev/null
+++ b/lisp/condition/condition.lisp
@@ -0,0 +1,7 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(define-condition handled-error (error)
+  ((text :initarg :text :reader text)))
diff --git a/lisp/core/core.lisp b/lisp/core/core.lisp
new file mode 100644
index 0000000..e42b1d2
--- /dev/null
+++ b/lisp/core/core.lisp
@@ -0,0 +1,8 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(defpackage :ldapadmin
+  (:use :cl :cl-log :hunchentoot)
+  (:export :ldapadmin))
+
+(in-package :ldapadmin)
diff --git a/lisp/entity/entity.lisp b/lisp/entity/entity.lisp
new file mode 100644
index 0000000..ea665e2
--- /dev/null
+++ b/lisp/entity/entity.lisp
@@ -0,0 +1,44 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass entity ()
+  ()
+  (:documentation "Superclass for all entity objects. An entity object
+is one that represents a single tuple from a data source, like a SQL
+table or LDAP record. In this case we're dealing with LDAP records."))
+
+(defmacro with-entity-slots-to-list ((entity slot) &body body)
+  "Iterates over all the slots of `entity' and builds an alist based
+on those slots. `slot' is the iterator."
+  `(remove-if #'null (mapcar (lambda (slot)
+                               (when (slot-is-field-p slot)
+                                 ,@body))
+                             (org-ckons-core::map-slot-names ,entity))))
+
+(defmethod attribute-value-list ((entity entity) &optional (keep-nulls nil))
+  (with-entity-slots-to-list (entity slot)
+    (when (or keep-nulls
+              (and (not keep-nulls)
+                   (not (org-ckons-core::null-or-empty-p (slot-value entity slot)))))
+      `(,slot . ,(slot-value entity slot)))))
+
+(defmethod get-slots-regex ((entity entity) regex)
+  (sort (remove-if-not (lambda (x) (org-ckons-core::match-it regex (symbol-name x)))
+                       (org-ckons-core::map-slot-names entity))
+        (lambda (x y) (string< (symbol-name x) (symbol-name y)))))
+
+(defmethod intersect-slots ((entity entity) slots)
+  (let ((intersect-slots ()))
+    (loop for class-slot in (org-ckons-core::map-slot-names entity) do
+         (let ((class-slot-string (org-ckons-core::parse-symbol class-slot)))
+           (loop for arg-slot in slots do
+                (let ((arg-slot-string (org-ckons-core::parse-symbol arg-slot)))
+                  (when (string-equal class-slot-string arg-slot-string)
+                    (push class-slot intersect-slots))))))
+    (nreverse intersect-slots)))
+
+(defun slot-is-field-p (slot)
+  (let ((name (symbol-name slot)))
+    (and (equal name (ppcre:regex-replace "^\\*" name "")))))
diff --git a/lisp/entity/generics.lisp b/lisp/entity/generics.lisp
new file mode 100644
index 0000000..510c7db
--- /dev/null
+++ b/lisp/entity/generics.lisp
@@ -0,0 +1,35 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defgeneric attribute-value-list (entity &optional keep-nulls)
+  (:documentation "Builds an alist of attribute/value pairs."))
+
+(defgeneric get-slots-regex (entity regex)
+  (:documentation "Gets an alphabetically sorted list of `entity'
+slots whose names match `regex'."))
+
+(defgeneric intersect-slots (entity slots)
+  (:documentation "Since the built-in `intersect' function does not
+take package name prefixes into account, and since
+`org-ckons-core::map-slot-names' returns slot names prefixed with the
+package name, this method was written to intersect lists ignoring
+package prefixes."))
+
+(defgeneric get-cn (ldap-user)
+  (:documentation "Generates the CN of an `ldap-user'. `trivial-ldap'
+does not fetch `cn' so we have to assemble it ourselves."))
+
+(defgeneric get-user-dn (ldap-user ldap)
+  (:documentation "Generates the full DN of an `ldap-user'."))
+
+(defgeneric modify-ldap-user (ldap-user ldap)
+  (:documentation "Writes the data in `ldap-user' to the LDAP
+server."))
+
+(defgeneric delete-ldap-user (ldap-user ldap)
+  (:documentation "Deletes an `ldap-user' from LDAP."))
+
+(defgeneric add-ldap-user (ldap-user ldap)
+  (:documentation "Adds an `ldap-user' to LDAP."))
diff --git a/lisp/entity/ldap-user.lisp b/lisp/entity/ldap-user.lisp
new file mode 100644
index 0000000..282592b
--- /dev/null
+++ b/lisp/entity/ldap-user.lisp
@@ -0,0 +1,75 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass ldap-user (entity)
+  ((givenname :initarg :givenname
+              :initform nil
+              :accessor givenname)
+   (sn :initarg :sn
+       :initform nil
+       :accessor sn)
+   (mail :initarg :mail
+         :initform nil
+         :accessor mail)
+   (postaladdress :initarg :postaladdress
+                  :initform nil
+                  :accessor postaladdress)
+   (postalcode :initarg :postalcode
+               :initform nil
+               :accessor postalcode)
+   (st :initarg :st
+       :initform nil
+       :accessor st)
+   (l :initarg :l
+      :initform nil
+      :accessor l)
+   (telephonenumber :initarg :telephonenumber
+                    :initform nil
+                    :accessor telephonenumber)
+   (mobile :initarg :mobile
+           :initform nil
+           :accessor mobile)
+   (businesscategory :initarg :businesscategory
+                     :initform nil
+                     :accessor businesscategory))
+  (:documentation "A single inetOrgPerson entry from LDAP."))
+
+(defmethod get-cn ((ldap-user ldap-user))
+  (format nil "~a ~a" (givenname ldap-user) (sn ldap-user)))
+
+(defmethod get-user-dn ((ldap-user ldap-user) (ldap ldap))
+  (format nil "cn=~a ~a,ou=people,~a" (givenname ldap-user) (sn ldap-user) (base-dn ldap)))
+
+(defmethod modify-ldap-user ((ldap-user ldap-user) (ldap ldap))
+  (let* ((existing-user (get-ldap-user ldap (get-cn ldap-user)))
+         (existing-attrs (attribute-value-list existing-user t))
+         (new-attrs (attribute-value-list ldap-user))
+         (ldap-entry (ldap:new-entry (get-user-dn ldap-user ldap) :attrs existing-attrs))
+         (change-attrs (remove-if #'null
+                                  (mapcar (lambda (attr)
+                                            (let ((new-attr (assoc (car attr) new-attrs)))
+                                              (cond ((and (org-ckons-core::null-or-empty-p (cdr attr))
+                                                          (not (org-ckons-core::null-or-empty-p (cdr new-attr))))
+                                                     `(ldap:add ,(car attr) ,(cdr new-attr)))
+                                                    ((and (not (org-ckons-core::null-or-empty-p (cdr attr)))
+                                                          (org-ckons-core::null-or-empty-p (cdr new-attr)))
+                                                     `(ldap:delete ,(car attr) ,(cdr attr)))
+                                                    ((and (not (org-ckons-core::null-or-empty-p (cdr attr)))
+                                                          (not (org-ckons-core::null-or-empty-p (cdr new-attr)))
+                                                          (not (string= (cdr attr) (cdr new-attr))))
+                                                     `(ldap:replace ,(car attr) ,(cdr new-attr))))))
+                                          existing-attrs))))
+    (ldap:modify (connection ldap) (get-user-dn ldap-user ldap) change-attrs)))
+
+(defmethod delete-ldap-user ((ldap-user ldap-user) (ldap ldap))
+  (let* ((existing-user (get-ldap-user ldap (get-cn ldap-user)))
+         (existing-attrs (attribute-value-list existing-user))
+         (ldap-entry (ldap:new-entry (get-user-dn ldap-user ldap) :attrs existing-attrs)))
+    (ldap:delete ldap-entry (connection ldap))))
+
+(defmethod add-ldap-user ((ldap-user ldap-user) (ldap ldap))
+  (let* ((new-attrs (attribute-value-list ldap-user))
+         (new-entry (ldap:new-entry (get-user-dn ldap-user ldap) :attrs (org-ckons-core::add-to-list new-attrs '((objectclass . (inetorgperson)))))))
+    (ldap:add new-entry (connection ldap))))
diff --git a/lisp/ldap/generics.lisp b/lisp/ldap/generics.lisp
new file mode 100644
index 0000000..ed8a839
--- /dev/null
+++ b/lisp/ldap/generics.lisp
@@ -0,0 +1,18 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defgeneric disconnect (ldap)
+  (:documentation ""))
+
+(defgeneric get-ldap-users (ldap search-base)
+  (:documentation "Calls `with-ldap-iterate' to iterate over all LDAP
+users returned with the search `search-base', wrapping each entry in
+an `ldap-user' object. Returns a list of these objects. `ldap' is a
+free variable that must be present for `with-ldap-iterate'."))
+
+(defgeneric get-ldap-user (ldap cn)
+  (:documentation "Calls `with-ldap-users' with a search filter and
+returns the first entry."))
+
diff --git a/lisp/ldap/ldap.lisp b/lisp/ldap/ldap.lisp
new file mode 100644
index 0000000..b7ec502
--- /dev/null
+++ b/lisp/ldap/ldap.lisp
@@ -0,0 +1,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)
+                                   ""))
diff --git a/lisp/ldapadmin.asd b/lisp/ldapadmin.asd
new file mode 100644
index 0000000..08f3210
--- /dev/null
+++ b/lisp/ldapadmin.asd
@@ -0,0 +1,67 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :cl)
+
+(defpackage :ldapadmin-system (:use :cl :asdf))
+(in-package :ldapadmin-system)
+
+(defmacro do-defsystem (&key name version maintainer author description long-description depends-on components)
+  `(defsystem ,name
+       :name ,name
+       :version ,version
+       :maintainer ,maintainer
+       :author ,author
+       :description ,description
+       :long-description ,long-description
+       :depends-on ,(eval depends-on)
+       :components ,components))
+
+(defparameter *quicklisp-packages* '(net-telent-date cl-ppcre uffi hunchentoot cl-log ironclad trivial-ldap))
+(defparameter *asdf-packages* '(org-ckons-core org-ckons-http org-ckons-json))
+(defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*))
+
+(loop for pkg in *quicklisp-packages* do
+     (ql:quickload (symbol-name pkg)))
+
+(do-defsystem :name "ldapadmin"
+              :version "2"
+              :maintainer "Carlos Konstanski <me@ckons.org>"
+              :author "Carlos Konstanski <me@ckons.org>"
+              :description "ldapadmin"
+              :long-description "ldapadmin is a web application written in Common Lisp, based on the Hunchentoot web server. It is a web UI frontend for LDAP."
+              :depends-on *all-packages*
+              :components ((:module core
+                            :components ((:file "core")))
+                           (:module condition
+                            :depends-on (core)
+                            :components ((:file "condition")))
+                           (:module ldap
+                            :depends-on (condition)
+                            :components ((:file "generics")
+                                         (:file "ldap" :depends-on ("generics"))))
+                           (:module entity
+                            :depends-on (ldap)
+                            :components ((:file "generics")
+                                         (:file "entity" :depends-on ("generics"))
+                                         (:file "ldap-user" :depends-on ("entity"))))
+                           (:module service
+                            :depends-on (entity)
+                            :components ((:file "base-service")
+                                         (:file "rest-service" :depends-on ("base-service"))
+                                         (:file "auth-service" :depends-on ("rest-service"))
+                                         (:file "generic-form" :depends-on ("rest-service"))
+                                         (:file "menu-service" :depends-on ("base-service"))
+                                         (:file "home-service" :depends-on ("rest-service"))
+                                         (:file "login-service" :depends-on ("generic-form"))
+                                         (:file "logout-service" :depends-on ("rest-service"))
+                                         (:file "inetorg-view-service" :depends-on ("auth-service" "generic-form"))
+                                         (:file "inetorg-modify-service" :depends-on ("auth-service" "generic-form"))
+                                         (:file "inetorg-delete-service" :depends-on ("auth-service" "generic-form"))
+                                         (:file "inetorg-add-service" :depends-on ("auth-service" "generic-form"))))
+                           (:module webapps
+                            :depends-on (service)
+                            :components ((:file "webapp-loader")
+                                         (:module ldapadmin
+                                          :depends-on ("webapp-loader")
+                                          :components ((:file "site")))))))
diff --git a/lisp/service/auth-service.lisp b/lisp/service/auth-service.lisp
new file mode 100644
index 0000000..0a84264
--- /dev/null
+++ b/lisp/service/auth-service.lisp
@@ -0,0 +1,30 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass auth-service (rest-service)
+  ()
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((auth-service auth-service) &key)
+  (when (not (string= (session-value :permissions) "admin"))
+    (setf (location auth-service) "/home")
+    (setf (errormsg auth-service) "You are not authorized to access this resource.")))
+
+(defmacro with-auth ((instance auth-service) &body body)
+  `(let ((,instance (make-instance ',auth-service)))
+     (when (string= (session-value :permissions) "admin")
+       ,@body)
+     (when (location-p ,instance)
+       (setf (session-value :message) nil)
+       (setf (session-value :errormsg) nil))
+     (org-ckons-json::objects-to-json `(,,instance))))
+
+(defmacro with-noauth ((instance rest-service) &body body)
+  `(let ((,instance (make-instance ',rest-service)))
+     ,@body
+     (when (location-p ,instance)
+       (setf (session-value :message) nil)
+       (setf (session-value :errormsg) nil))
+     (org-ckons-json::objects-to-json `(,,instance))))
diff --git a/lisp/service/base-service.lisp b/lisp/service/base-service.lisp
new file mode 100644
index 0000000..7eb8fb3
--- /dev/null
+++ b/lisp/service/base-service.lisp
@@ -0,0 +1,8 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass base-service ()
+  ()
+  (:documentation ""))
diff --git a/lisp/service/generic-form.lisp b/lisp/service/generic-form.lisp
new file mode 100644
index 0000000..6e0c821
--- /dev/null
+++ b/lisp/service/generic-form.lisp
@@ -0,0 +1,87 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass generic-form (base-service)
+  ((name :initarg :name
+         :initform nil
+         :accessor name)
+   (http-method :initarg :http-method
+                :initform "POST"
+                :accessor http-method)
+   (action :initarg :action
+           :initform nil
+           :accessor action)
+   (required-p :initarg :required-p
+               :initform nil
+               :accessor required-p)
+   (form-fields :initarg :form-fields
+                :initform nil
+                :accessor form-fields))
+  (:documentation ""))
+
+(defclass form-field (base-service)
+  ((name :initarg :name
+         :initform nil
+         :accessor name)
+   (label :initarg :label
+          :initform nil
+          :accessor label)
+   (value :initarg :value
+          :initform nil
+          :accessor value)
+   (checked :initarg :checked
+            :initform nil
+            :accessor checked)
+   (field-type :initarg :field-type
+               :initform nil
+               :accessor field-type)
+   (required :initarg :required
+             :initform nil
+             :accessor required)
+   (dismiss :initarg :dismiss
+            :initform nil
+            :accessor dismiss)
+   (options :initarg :options
+            :initform nil
+            :accessor options)
+   (onclick :initarg :onclick
+            :initform nil
+            :accessor onclick)
+   (onchange :initarg :onchange
+             :initform nil
+             :accessor onchange))
+  (:documentation ""))
+
+(defclass option (base-service)
+  ((label :initarg :label
+          :initform nil
+          :accessor label)
+   (value :initarg :value
+          :initform nil
+          :accessor value))
+  (:documentation ""))
+
+(defun make-form (name action required-p fields)
+  (make-instance 'generic-form
+                 :name name
+                 :action action
+                 :required-p required-p
+                 :form-fields (mapcar (lambda (field)
+                                        (make-instance 'form-field
+                                                       :name (getf field :name)
+                                                       :label (getf field :label)
+                                                       :value (getf field :value)
+                                                       :checked (getf field :checked)
+                                                       :field-type (getf field :field-type)
+                                                       :required (getf field :required)
+                                                       :dismiss (getf field :dismiss)
+                                                       :options (mapcar (lambda (option)
+                                                                          (make-instance 'option
+                                                                                         :label (getf option :label)
+                                                                                         :value (getf option :value)))
+                                                                        (getf field :options))
+                                                       :onclick (getf field :onclick)
+                                                       :onchange (getf field :onchange)))
+                                      fields)))
diff --git a/lisp/service/home-service.lisp b/lisp/service/home-service.lisp
new file mode 100644
index 0000000..b914cae
--- /dev/null
+++ b/lisp/service/home-service.lisp
@@ -0,0 +1,18 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass home-service (rest-service)
+  ((content :initarg :content
+            :initform nil
+            :accessor content))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((home-service home-service) &key)
+  (setf (content home-service) (format nil "Welcome to the ~a website" (title *webapp*))))
+
+(defun home-json (&optional message errormsg)
+  (with-noauth (instance home-service)
+    (when message (setf (message instance) message))
+    (when errormsg (setf (errormsg instance) errormsg))))
diff --git a/lisp/service/inetorg-add-service.lisp b/lisp/service/inetorg-add-service.lisp
new file mode 100644
index 0000000..a58a10d
--- /dev/null
+++ b/lisp/service/inetorg-add-service.lisp
@@ -0,0 +1,55 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-add-service (auth-service)
+  ((form :initarg :form
+         :initform nil
+         :accessor form)
+   (title :initarg :title
+          :initform nil
+          :accessor title))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((inetorg-add-service inetorg-add-service) &key)
+  (setf (title inetorg-add-service) "Add InetOrg Entry")
+  (setf (form inetorg-add-service) (make-form "inetorg-add-form"
+                                              nil
+                                              t
+                                              '((:name "add-givenname" :label "givenName" :field-type "text" :required "required")
+                                                (:name "add-sn" :label "sn" :field-type "text" :required "required")
+                                                (:name "add-mail" :label "mail" :field-type "text")
+                                                (:name "add-postaladdress" :label "postalAddress" :field-type "text")
+                                                (:name "add-postalcode" :label "postalCode" :field-type "text")
+                                                (:name "add-st" :label "st" :field-type "text")
+                                                (:name "add-l" :label "l" :field-type "text")
+                                                (:name "add-telephonenumber" :label "telephoneNumber" :field-type "text")
+                                                (:name "add-mobile" :label "mobile" :field-type "text")
+                                                (:name "add-businesscategory" :label "businessCategory" :field-type "text")
+                                                (:label "Create InetOrg Entry" :field-type "button" :onclick "on_inetorg_add_submit_clicked()")))))
+
+(defun inetorg-add-json ()
+  (with-auth (instance inetorg-add-service)
+    t))
+
+(defclass inetorg-add-submit-service (auth-service)
+  ((location-p :initform nil))
+  (:documentation ""))
+
+(defun inetorg-add-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
+  (with-auth (instance inetorg-add-submit-service)
+    (with-ldap (ldap)
+      (let ((ldap-user (make-instance 'ldap-user
+                                      :givenname givenname
+                                      :sn sn
+                                      :mail mail
+                                      :postaladdress postaladdress
+                                      :postalcode postalcode
+                                      :st st
+                                      :l l
+                                      :telephonenumber telephonenumber
+                                      :mobile mobile
+                                      :businesscategory businesscategory)))
+        (add-ldap-user ldap-user ldap)
+        (setf (session-value :message) "InetOrg entry created successfully.")))))
diff --git a/lisp/service/inetorg-delete-service.lisp b/lisp/service/inetorg-delete-service.lisp
new file mode 100644
index 0000000..7c27480
--- /dev/null
+++ b/lisp/service/inetorg-delete-service.lisp
@@ -0,0 +1,26 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-delete-service (auth-service)
+  ((cn :initarg :cn
+       :initform nil
+       :accessor cn)
+   (location-p :initform nil))
+  (:documentation ""))
+
+(defun inetorg-delete-json (cn)
+  (with-auth (instance inetorg-delete-service)
+    (setf (cn instance) cn)))
+
+(defclass inetorg-delete-submit-service (auth-service)
+  ((location-p :initform nil))
+  (:documentation ""))
+
+(defun inetorg-delete-submit-json (cn)
+  (with-auth (instance inetorg-delete-submit-service)
+    (with-ldap (ldap)
+      (let ((ldap-user (get-ldap-user ldap cn)))
+        (delete-ldap-user ldap-user ldap)
+        (setf (session-value :message) "InetOrg entry deleted successfully.")))))
diff --git a/lisp/service/inetorg-modify-service.lisp b/lisp/service/inetorg-modify-service.lisp
new file mode 100644
index 0000000..89e5b9b
--- /dev/null
+++ b/lisp/service/inetorg-modify-service.lisp
@@ -0,0 +1,59 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-modify-service (auth-service)
+  ((form :initarg :form
+         :initform nil
+         :accessor form)
+   (ldap-user-values :initarg :ldap-user-values
+                     :initform nil
+                     :accessor ldap-user-values)
+   (title :initarg :title
+          :initform nil
+          :accessor title)
+   (location-p :initform nil))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((inetorg-modify-service inetorg-modify-service) &key)
+  (setf (form inetorg-modify-service) (make-form "inetorg-modify-form"
+                                                 nil
+                                                 t
+                                                 `((:name "modify-givenname" :label "givenName" :field-type "text")
+                                                   (:name "modify-sn" :label "sn" :field-type "text")
+                                                   (:name "modify-mail" :label "mail" :field-type "text")
+                                                   (:name "modify-postaladdress" :label "postalAddress" :field-type "text")
+                                                   (:name "modify-postalcode" :label "postalCode" :field-type "text")
+                                                   (:name "modify-st" :label "st" :field-type "text")
+                                                   (:name "modify-l" :label "l" :field-type "text")
+                                                   (:name "modify-telephonenumber" :label "telephoneNumber" :field-type "text")
+                                                   (:name "modify-mobile" :label "mobile" :field-type "text")
+                                                   (:name "modify-businesscategory" :label "businessCategory" :field-type "text")
+                                                   (:label "Modify InetOrg Entry" :field-type "button" :onclick "on_inetorg_modify_submit_clicked()")))))
+
+(defun inetorg-modify-json (cn)
+  (with-auth (instance inetorg-modify-service)
+    (with-ldap (ldap)
+      (setf (ldap-user-values instance) (get-ldap-user ldap cn)))))
+
+(defclass inetorg-modify-submit-service (auth-service)
+  ((location-p :initform nil))
+  (:documentation ""))
+
+(defun inetorg-modify-submit-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
+  (with-auth (instance inetorg-modify-submit-service)
+    (with-ldap (ldap)
+      (let ((ldap-user (make-instance 'ldap-user
+                                      :givenname givenname
+                                      :sn sn
+                                      :mail mail
+                                      :postaladdress postaladdress
+                                      :postalcode postalcode
+                                      :st st
+                                      :l l
+                                      :telephonenumber telephonenumber
+                                      :mobile mobile
+                                      :businesscategory businesscategory)))
+        (modify-ldap-user ldap-user ldap)
+        (setf (session-value :message) "InetOrg entry saved successfully.")))))
diff --git a/lisp/service/inetorg-view-service.lisp b/lisp/service/inetorg-view-service.lisp
new file mode 100644
index 0000000..379b1b0
--- /dev/null
+++ b/lisp/service/inetorg-view-service.lisp
@@ -0,0 +1,70 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass inetorg-view-service (auth-service)
+  ((title :initarg :title
+          :initform nil
+          :accessor title))
+  (:documentation ""))
+
+(defun inetorg-view-json (&optional message errormsg)
+  (with-auth (instance inetorg-view-service)
+    (when message (setf (message instance) message))
+    (when errormsg (setf (errormsg instance) errormsg))
+    (setf (title instance) "Use the form to filter the InetOrg results.")))
+
+(defclass inetorg-view-search-service (auth-service)
+  ((form :initarg :form
+         :initform nil
+         :accessor form)
+   (title :initarg :title
+          :initform nil
+          :accessor title)
+   (location-p :initform nil))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((inetorg-view-search-service inetorg-view-search-service) &key)
+  (setf (form inetorg-view-search-service) (make-form "inetorg-view-search-form"
+                                                      nil
+                                                      t
+                                                      '((:name "view-givenname" :label "givenName" :field-type "text")
+                                                        (:name "view-sn" :label "sn" :field-type "text")
+                                                        (:name "view-mail" :label "mail" :field-type "text")
+                                                        (:name "view-postaladdress" :label "postalAddress" :field-type "text")
+                                                        (:name "view-postalcode" :label "postalCode" :field-type "text")
+                                                        (:name "view-st" :label "st" :field-type "text")
+                                                        (:name "view-l" :label "l" :field-type "text")
+                                                        (:name "view-telephonenumber" :label "telephoneNumber" :field-type "text")
+                                                        (:name "view-mobile" :label "mobile" :field-type "text")
+                                                        (:name "view-businesscategory" :label "businessCategory" :field-type "text")
+                                                        (:label "Search InetOrg Entries" :field-type "button" :onclick "on_inetorg_view_search_clicked()")))))
+
+(defun inetorg-view-search-json ()
+  (with-auth (instance inetorg-view-search-service)
+    nil))
+
+(defclass inetorg-view-results-service (auth-service)
+  ((results :initarg :results
+            :initform nil
+            :accessor results)
+   (location-p :initform nil))
+  (:documentation ""))
+
+(defun inetorg-view-results-json (givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory)
+  (with-auth (instance inetorg-view-results-service)
+    (with-ldap (ldap)
+      (setf (results instance)
+            (sort (search-ldap-users ldap
+                                     `((:givenname ,givenname)
+                                       (:sn ,sn)
+                                       (:mail ,mail)
+                                       (:postaladdress ,postaladdress)
+                                       (:postalcode ,postalcode)
+                                       (:st ,st)
+                                       (:l ,l)
+                                       (:telephonenumber ,telephonenumber)
+                                       (:mobile ,mobile)
+                                       (:businesscategory ,businesscategory)))
+                  (lambda (x y) (string< (get-cn x) (get-cn y))))))))
diff --git a/lisp/service/login-service.lisp b/lisp/service/login-service.lisp
new file mode 100644
index 0000000..82b647c
--- /dev/null
+++ b/lisp/service/login-service.lisp
@@ -0,0 +1,43 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass login-service (rest-service)
+  ((form :initarg :form
+         :initform nil
+         :accessor form)
+   (title :initarg :title
+          :initform nil
+          :accessor title))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((login-service login-service) &key)
+  (setf (title login-service) "Login")
+  (setf (form login-service) (make-form "login-form"
+                                        nil
+                                        t
+                                        '((:name "dn" :label "DN" :field-type "text" :required "required")
+                                          (:name "password" :label "Password" :field-type "password" :required "required")
+                                          (:label "Login" :field-type "button" :onclick "on_login_submit_clicked()")))))
+
+(defun login-json ()
+  (with-noauth (instance login-service)
+    t))
+
+(defclass login-authenticate-service (rest-service)
+  ((location-p :initform nil))
+  (:documentation ""))
+
+(defun login-authenticate-json (dn password)
+  (with-noauth (instance login-authenticate-service)
+    (cond ((check-ldap-password (ldap *webapp*) dn password)
+           (setf (session-value :permissions) "admin")
+           (setf (session-value :message) "Successfully logged in.")
+           (setf (session-value :errormsg) nil))
+          (t
+           (setf (session-value :message) nil)
+           (setf (session-value :errormsg) "Login failed.")))
+    (setf (message instance) (session-value :message))
+    (setf (errormsg instance) (session-value :errormsg))))
+
diff --git a/lisp/service/logout-service.lisp b/lisp/service/logout-service.lisp
new file mode 100644
index 0000000..59a9968
--- /dev/null
+++ b/lisp/service/logout-service.lisp
@@ -0,0 +1,14 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass logout-service (rest-service)
+  ((location-p :initform nil))
+  (:documentation ""))
+
+(defun logout-json ()
+  (with-noauth (instance logout-service)
+    (setf (session-value :permissions) "anonymous")
+    (setf (location instance) "/home")
+    (setf (message instance) "You are now logged out.")))
diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp
new file mode 100644
index 0000000..728b8e5
--- /dev/null
+++ b/lisp/service/menu-service.lisp
@@ -0,0 +1,55 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defparameter *menu-config* '((:id "a_menu_home" :label "Home" :handler "/home" :permissions "t")
+                              (:id "a_menu_login" :label "Login" :handler "/login" :permissions "anonymous")
+                              (:id "a_menu_logout" :label "Logout" :handler "/logout" :permissions "admin")
+                              (:id "a_menu_inetorg_view" :label "View InetOrg Entries" :handler "/inetorg/view" :permissions "admin")
+                              (:id "a_menu_inetorg_add" :label "Add InetOrg Entry" :handler "/inetorg/add" :permissions "admin")))
+
+(defclass menuitem ()
+  ((id :initarg :id
+       :initform nil
+       :accessor id)
+   (label :initarg :label
+          :initform nil
+          :accessor label)
+   (handler :initarg :handler
+            :initform nil
+            :accessor handler)
+   (permissions :initarg :permissions
+                :initform nil
+                :accessor permissions)
+   (children :initarg :children
+             :initform nil
+             :accessor children))
+  (:documentation ""))
+  
+(defclass menu-service (base-service)
+  ((menuitems :initarg :menuitems
+              :initform nil
+              :accessor menuitems)
+   (location-p :initarg :location-p
+               :initform nil
+               :accessor location-p))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((menu-service menu-service) &key)
+  (setf (menuitems menu-service)
+        (mapcar (lambda (x)
+                  (make-instance 'menuitem
+                                 :id (getf x :id)
+                                 :label (getf x :label)
+                                 :handler (getf x :handler)))
+                (remove-if 'null (mapcar (lambda (x)
+                                           (when (find-if (lambda (y)
+                                                            (string= (getf x :permissions) y))
+                                                          `("t" ,(session-value :permissions)))
+                                             x))
+                                         *menu-config*)))))
+
+(defun menu-json ()
+  (with-noauth (instance menu-service)
+    t))
diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp
new file mode 100644
index 0000000..ff66dd4
--- /dev/null
+++ b/lisp/service/rest-service.lisp
@@ -0,0 +1,36 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defclass rest-service (base-service)
+  ((location :initarg :location
+             :initform nil
+             :accessor location)
+   (location-p :initarg :location-p
+               :initform t
+               :accessor location-p)
+   (message :initarg :message
+            :initform nil
+            :accessor message)
+   (errormsg :initarg :errormsg
+             :initform nil
+             :accessor errormsg))
+  (:documentation ""))
+
+(defmethod initialize-instance :after ((rest-service rest-service) &key)
+  (when (location-p rest-service)
+    (if (message rest-service)
+        (setf (session-value :message) (message rest-service))
+        (setf (message rest-service) (session-value :message)))
+    (if (errormsg rest-service)
+        (setf (session-value :errormsg) (errormsg rest-service))
+        (setf (errormsg rest-service) (session-value :errormsg)))
+    (when (null (location rest-service))
+      (setf (location rest-service) (type-to-path rest-service)))))
+
+(defun location-json (&optional (location "/home"))
+  (format nil "{\"location\":\"~a\"}" location))
+
+(defun type-to-path (rest-type)
+  (concatenate 'string "/" (ppcre:regex-replace "-service" (string-downcase (type-of rest-type)) "/")))
diff --git a/lisp/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore
new file mode 100644
index 0000000..a1cd79c
--- /dev/null
+++ b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/.gitignore
@@ -0,0 +1,15 @@
+target
+classes
+resources
+checkouts
+pom.xml
+pom.xml.asc
+*.jar
+*.class
+.lein-*
+.nrepl-port
+.hgignore
+.hg
+profiles.clj
+figwheel_server.log
+.rebel_readline_history
diff --git a/lisp/webapps/ldapadmin/clojurescript/ldapadmin/README.md b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/README.md
new file mode 100644
index 0000000..53ca866
--- /dev/null
+++ b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/README.md
@@ -0,0 +1,14 @@
+# ldapadmin
+
+A Clojure library designed to ... well, that part is up to you.
+
+## Usage
+
+FIXME
+
+## License
+
+Copyright © 2017 FIXME
+
+Distributed under the Eclipse Public License either version 1.0 or (at
+your option) any later version.
diff --git a/lisp/webapps/ldapadmin/clojurescript/ldapadmin/project.clj b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/project.clj
new file mode 100644
index 0000000..001af8b
--- /dev/null
+++ b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/project.clj
@@ -0,0 +1,13 @@
+(defproject ldapadmin "0.1.0-SNAPSHOT"
+  :description "An LDAP adminitration utility written in SBCL on the
+  server-side and ClojureScript on the client-side. This is the
+  client-side component."
+  :url "FIXME"
+  :license "public domain"
+  :dependencies [[org.clojure/clojure "LATEST"]
+                 [org.clojure/clojurescript "LATEST"]
+                 [cljs-ajax "LATEST"]
+                 [prismatic/dommy "LATEST"]
+                 [hiccups "LATEST"]]
+  :plugins [[lein-cljsbuild "LATEST"]]
+  :clean-targets ^{:protect false} [:target-path "out" "resources/public/cljs"])
diff --git a/lisp/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
new file mode 100644
index 0000000..d3f0374
--- /dev/null
+++ b/lisp/webapps/ldapadmin/clojurescript/ldapadmin/src/core.cljs
@@ -0,0 +1,447 @@
+(ns ldapadmin.core
+  (:require-macros [hiccups.core :as hiccups :refer [html]])
+  (:require [ajax.core :refer [GET POST]]
+            [dommy.core :as dommy]
+            [hiccups.runtime :as hiccupsrt]
+            [clojure.string :as str]
+            [org-ckons-cljs.notifications.core :as ck-notifications]
+            [org-ckons-cljs.form.core :as ck-form]))
+
+;; declarations
+
+(enable-console-print!)
+(def jquery (js* "$"))
+
+(declare notifications)
+(declare auth-notifications)
+(declare template-menu)
+(declare handler-menu)
+(declare render-menu)
+(declare template-home)
+(declare handler-home)
+(declare render-home)
+(declare template-login)
+(declare handler-login)
+(declare render-login)
+(declare on-login-submit-clicked)
+(declare handler-login-authenticate)
+(declare render-login-authenticate)
+(declare handler-logout)
+(declare render-logout)
+(declare template-inetorg-view)
+(declare handler-inetorg-view)
+(declare render-inetorg-view)
+(declare on-inetorg-view-search-clicked)
+(declare template-inetorg-view-search)
+(declare handler-inetorg-view-search)
+(declare render-inetorg-view-search)
+(declare template-inetorg-view-results)
+(declare handler-inetorg-view-results)
+(declare render-inetorg-view-results)
+(declare on-inetorg-modify-clicked)
+(declare template-inetorg-modify)
+(declare handler-inetorg-modify)
+(declare render-inetorg-modify)
+(declare on-inetorg-modify-submit-clicked)
+(declare handler-inetorg-modify-submit)
+(declare render-inetorg-modify-submit)
+(declare on-inetorg-delete-clicked)
+(declare template-inetorg-delete)
+(declare handler-inetorg-delete)
+(declare render-inetorg-delete)
+(declare on-inetorg-delete-submit-clicked)
+(declare handler-inetorg-delete-submit)
+(declare render-inetorg-delete-submit)
+(declare template-inetorg-add)
+(declare handler-inetorg-add)
+(declare render-inetorg-add)
+(declare on-inetorg-add-submit-clicked)
+(declare handler-inetorg-add-submit)
+(declare render-inetorg-add-submit)
+(declare on-menu-clicked)
+(declare handler-location)
+(declare goto-location)
+
+;; notifications
+
+(defn notifications [jsonobj]
+  (ck-notifications/maybe-message jsonobj)
+  (ck-notifications/maybe-error jsonobj))
+
+(defn auth-notifications [jsonobj]
+  (cond (empty? (get jsonobj "errormsg"))
+        (notifications jsonobj)
+        :else
+        (do
+          (render-home "" (get jsonobj "errormsg"))
+          (render-menu))))
+  
+;; menu
+
+(hiccups/defhtml template-menu [menuitems]
+  [:ul {:class "nav nav-pills"}
+   (for [menuitem menuitems]
+     [:li {:class "nav-item"}
+      [:a {:class (cond (= (str/upper-case (get menuitem "handler"))
+                           (str/upper-case (dommy/html (dommy/sel1 :#location))))
+                        "nav-link active"
+                        :else
+                        "nav-link")
+           :id (get menuitem "id")
+           :onclick (str (namespace ::x) ".on_menu_clicked('" (get menuitem "handler") "')")}
+       (get menuitem "label")]])])
+
+(defn handler-menu [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (dommy/set-html! (dommy/sel1 :#menu) (template-menu (get jsonobj "menuitems")))))
+
+(defn render-menu []
+  (GET "/menu" {:handler handler-menu}))
+
+;; home
+
+(hiccups/defhtml template-home [jsonobj]
+  [:h3 {:style "text-align: center"} (get jsonobj "content")])
+
+(defn handler-home [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#body) (template-home jsonobj))))
+
+(defn render-home
+  ([]
+   (GET "/home" {:handler handler-home}))
+  ([message errormsg]
+   (POST  "/home" {:format :raw
+                   :params {:message message
+                            :errormsg errormsg}
+                   :handler handler-home})))
+
+;; login
+
+(hiccups/defhtml template-login [jsonobj]
+  [:h3 {:style "text-align: center"} (get jsonobj "title")]
+  (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))
+  [:div {:style "text-align: center"}])
+
+(defn handler-login [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#body) (template-login jsonobj))))
+
+(defn render-login []
+  (GET "/login" {:handler handler-login}))
+
+;; login-authenticate
+
+(defn on-login-submit-clicked []
+  (when (-> (jquery "#login-form")
+            (.get "0")
+            (.checkValidity))
+    (render-login-authenticate)))
+
+(defn handler-login-authenticate [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (cond (get jsonobj "errormsg")
+          (goto-location "/login")
+          (get jsonobj "message")
+          (do
+            (dommy/set-html! (dommy/sel1 :#location) "/inetorg/view")
+            (render-inetorg-view)
+            (render-menu)))))
+
+(defn render-login-authenticate []
+  (POST "/login/authenticate" {:format :raw
+                               :params {:dn (dommy/value (dommy/sel1 :#dn))
+                                        :password (dommy/value (dommy/sel1 :#password))}
+                               :handler handler-login-authenticate}))
+
+;; logout
+
+(defn handler-logout [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (render-home (get jsonobj "message") "")
+    (dommy/set-html! (dommy/sel1 :#location) "/home")
+    (render-menu)))
+
+(defn render-logout []
+  (GET "/logout" {:handler handler-logout}))
+
+;; inetorg-view
+
+(hiccups/defhtml template-inetorg-view [jsonobj]
+  [:h3 {:style "text-align: center"} (get jsonobj "title")]
+  [:div {:id "search"}]
+  [:div {:id "results"}]
+  [:div {:id "modify"
+         :class "modal fade"
+         :role "dialog"}
+   [:div {:class "modal-dialog modal-lg"}
+    [:div {:class "modal-content"}
+     [:div {:class "modal-header"}
+      [:button {:type "button"
+                :class "close"
+                :data-dismiss "modal"}
+       "&times;"]
+      [:h4 "Modify InetOrg Entry"]]
+     [:div {:id "modify-body"
+            :class "modal-body"
+            :style "height: 510px;"}]
+     [:div {:class "modal-footer"}
+      [:button {:type "submit"
+                :class "btn btn-danger btn-default"
+                :data-dismiss "modal"}
+       [:span {:class "glyphicon glyphicon-remove"}]
+       "Cancel"]]]]]
+  [:div {:id "delete"
+         :class "modal fade"
+         :role "dialog"}
+   [:div {:class "modal-dialog"}
+    [:div {:class "modal-content"}
+     [:div {:class "modal-header"}
+      [:button {:type "button"
+                :class "close"
+                :data-dismiss "modal"}
+       "&times;"]
+      [:h4 "Delete InetOrg Entry"]]
+     [:div {:id "delete-body"
+            :class "modal-body"}]
+     [:div {:class "modal-footer"}
+      [:button {:type "submit"
+                :class "btn btn-danger btn-default"
+                :data-dismiss "modal"}
+       [:span {:class "glyphicon glyphicon-remove"}]
+       "Cancel"]]]]])
+
+(defn handler-inetorg-view [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#body) (template-inetorg-view jsonobj))
+    (render-inetorg-view-search)))
+
+(defn render-inetorg-view []
+   (GET "/inetorg/view" {:handler handler-inetorg-view}))
+
+;; inetorg-view-search
+
+(defn on-inetorg-view-search-clicked []
+  (when (-> (jquery "#inetorg-view-search-form")
+            (.get "0")
+            (.checkValidity))
+    (render-inetorg-view-results)))
+
+(hiccups/defhtml template-inetorg-view-search [jsonobj]
+  (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)))
+
+(defn handler-inetorg-view-search [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#search) (template-inetorg-view-search jsonobj))
+    (render-inetorg-view-results)))
+
+(defn render-inetorg-view-search []
+  (GET "/inetorg/view/search" {:handler handler-inetorg-view-search}))
+
+;; inetorg-view-results
+
+(hiccups/defhtml template-inetorg-view-results [jsonobj]
+  [:table {:class "table table-hover"}
+   [:thead
+    [:tr
+     [:th "givenName"]
+     [:th "sn"]
+     [:th "mail"]
+     [:th "postalAddress"]
+     [:th "postalCode"]
+     [:th "st"]
+     [:th "l"]
+     [:th "telephoneNumber"]
+     [:th "mobile"]
+     [:th "businessCategory"]
+     [:th "Del"]]]
+   [:tbody
+    (for [ldap-user (get jsonobj "results")]
+      (let* [cn (str (get ldap-user "givenname") " " (get ldap-user "sn"))
+             onclick (str (namespace ::x) ".on_inetorg_modify_clicked('" cn "')")]
+        [:tr
+         [:td {:onclick onclick} (get ldap-user "givenname")]
+         [:td {:onclick onclick} (get ldap-user "sn")]
+         [:td {:onclick onclick} (get ldap-user "mail")]
+         [:td {:onclick onclick} (get ldap-user "postaladdress")]
+         [:td {:onclick onclick} (get ldap-user "postalcode")]
+         [:td {:onclick onclick} (get ldap-user "st")]
+         [:td {:onclick onclick} (get ldap-user "l")]
+         [:td {:onclick onclick} (get ldap-user "telephonenumber")]
+         [:td {:onclick onclick} (get ldap-user "mobile")]
+         [:td {:onclick onclick} (get ldap-user "businesscategory")]
+         [:td [:img {:src "/static/images/edit-delete.png"
+                     :onclick (str (namespace ::x) ".on_inetorg_delete_clicked('" cn "')")}]]]))]])
+
+(defn handler-inetorg-view-results [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#results) (template-inetorg-view-results jsonobj))))
+
+(defn render-inetorg-view-results []
+  (POST "/inetorg/view/results" {:format :raw
+                                 :params {:givenname (dommy/value (dommy/sel1 :#view-givenname))
+                                          :sn (dommy/value (dommy/sel1 :#view-sn))
+                                          :mail (dommy/value (dommy/sel1 :#view-mail))
+                                          :postaladdress (dommy/value (dommy/sel1 :#view-postaladdress))
+                                          :postalcode (dommy/value (dommy/sel1 :#view-postalcode))
+                                          :st (dommy/value (dommy/sel1 :#view-st))
+                                          :l (dommy/value (dommy/sel1 :#view-l))
+                                          :telephonenumber (dommy/value (dommy/sel1 :#view-telephonenumber))
+                                          :mobile (dommy/value (dommy/sel1 :#view-mobile))
+                                          :businesscategory (dommy/value (dommy/sel1 :#view-businesscategory))}
+                                 :handler handler-inetorg-view-results}))
+
+;; inetorg-modify
+
+(defn on-inetorg-modify-clicked [cn]
+  (render-inetorg-modify cn))
+
+(hiccups/defhtml template-inetorg-modify [jsonobj]
+  (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)))
+
+(defn handler-inetorg-modify [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))
+        jquery (js* "$")]
+    (auth-notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#modify-body) (template-inetorg-modify jsonobj))
+    (doseq [[name value] (get jsonobj "ldapUserValues")]
+      (dommy/set-value! (dommy/sel1 (keyword (str "#modify-" name))) value))
+    (.modal (jquery "#modify"))))
+
+(defn render-inetorg-modify [cn]
+  (POST "/inetorg/modify" {:format :raw
+                           :params {:cn cn}
+                           :handler handler-inetorg-modify}))
+
+;; inetorg-modify-submit
+
+(defn on-inetorg-modify-submit-clicked []
+  (.modal (jquery "#modify") "hide")
+  (render-inetorg-modify-submit))
+
+(defn handler-inetorg-modify-submit [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (on-menu-clicked "/inetorg/view")))
+
+(defn render-inetorg-modify-submit []
+  (POST "/inetorg/modify/submit" {:format :raw
+                                  :params {:givenname (dommy/value (dommy/sel1 :#modify-givenname))
+                                           :sn (dommy/value (dommy/sel1 :#modify-sn))
+                                           :mail (dommy/value (dommy/sel1 :#modify-mail))
+                                           :postaladdress (dommy/value (dommy/sel1 :#modify-postaladdress))
+                                           :postalcode (dommy/value (dommy/sel1 :#modify-postalcode))
+                                           :st (dommy/value (dommy/sel1 :#modify-st))
+                                           :l (dommy/value (dommy/sel1 :#modify-l))
+                                           :telephonenumber (dommy/value (dommy/sel1 :#modify-telephonenumber))
+                                           :mobile (dommy/value (dommy/sel1 :#modify-mobile))
+                                           :businesscategory (dommy/value (dommy/sel1 :#modify-businesscategory))}
+                                  :handler handler-inetorg-modify-submit}))
+
+;; inetrog-delete
+
+(defn on-inetorg-delete-clicked [cn]
+  (render-inetorg-delete cn))
+
+(hiccups/defhtml template-inetorg-delete [jsonobj]
+  [:p (str "Are you sure you want to delete the InetOrg entry: " (get jsonobj "cn"))]
+  [:p "This action cannot be undone."]
+  [:button {:type "button"
+            :data-dismiss "modal"
+            :onclick (str (namespace ::x) ".on_inetorg_delete_submit_clicked('" (get jsonobj "cn") "')")}
+   "Delete InetOrg Entry"])
+
+(defn handler-inetorg-delete [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))
+        jquery (js* "$")]
+    (auth-notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#delete-body) (template-inetorg-delete jsonobj))
+    (.modal (jquery "#delete"))))
+
+(defn render-inetorg-delete [cn]
+  (POST "/inetorg/delete" {:format :raw
+                           :params {:cn cn}
+                           :handler handler-inetorg-delete}))
+
+;; inetrog-delete-submit
+
+(defn on-inetorg-delete-submit-clicked [cn]
+  (render-inetorg-delete-submit cn))
+
+(defn handler-inetorg-delete-submit [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (on-menu-clicked "/inetorg/view")))
+
+(defn render-inetorg-delete-submit [cn]
+  (POST "/inetorg/delete/submit" {:format :raw
+                                  :params {:cn cn}
+                                  :handler handler-inetorg-delete-submit}))
+
+;; inetrog-add
+
+(hiccups/defhtml template-inetorg-add [jsonobj]
+  (ck-form/template-generic-form (get jsonobj "form") (namespace ::x)))
+
+(defn handler-inetorg-add [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (dommy/set-html! (dommy/sel1 :#body) (template-inetorg-add jsonobj))))
+
+(defn render-inetorg-add []
+  (GET "/inetorg/add" {:handler handler-inetorg-add}))
+
+;; inetorg-add-submit
+
+(defn on-inetorg-add-submit-clicked []
+  (when (-> (jquery "#inetorg-add-form")
+            (.get "0")
+            (.checkValidity))
+    (render-inetorg-add-submit)))
+
+(defn handler-inetorg-add-submit [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (auth-notifications jsonobj)
+    (notifications jsonobj)
+    (on-menu-clicked "/inetorg/view")))
+
+(defn render-inetorg-add-submit []
+  (POST "/inetorg/add/submit" {:format :raw
+                               :params {:givenname (dommy/value (dommy/sel1 :#add-givenname))
+                                        :sn (dommy/value (dommy/sel1 :#add-sn))
+                                        :mail (dommy/value (dommy/sel1 :#add-mail))
+                                        :postaladdress (dommy/value (dommy/sel1 :#add-postaladdress))
+                                        :postalcode (dommy/value (dommy/sel1 :#add-postalcode))
+                                        :st (dommy/value (dommy/sel1 :#add-st))
+                                        :l (dommy/value (dommy/sel1 :#add-l))
+                                        :telephonenumber (dommy/value (dommy/sel1 :#add-telephonenumber))
+                                        :mobile (dommy/value (dommy/sel1 :#add-mobile))
+                                        :businesscategory (dommy/value (dommy/sel1 :#add-businesscategory))}
+                               :handler handler-inetorg-add-submit}))
+
+;; location
+
+(defn on-menu-clicked [handler]
+  (dommy/set-html! (dommy/sel1 :#location) handler)
+  (render-menu)
+  (cond (= handler "/home") (render-home)
+        (= handler "/login") (render-login)
+        (= handler "/login/authenticate") (render-login-authenticate)
+        (= handler "/logout") (render-logout)
+        (= handler "/inetorg/view") (render-inetorg-view)
+        (= handler "/inetorg/add") (render-inetorg-add)))
+
+(defn handler-location [response]
+  (let [jsonobj (js->clj (js/JSON.parse response))]
+    (on-menu-clicked (get jsonobj "location"))
+    (notifications jsonobj)))
+
+(defn goto-location [location]
+  (POST "/location" {:format :raw
+                     :params {:location location}
+                     :handler handler-location}))
diff --git a/lisp/webapps/ldapadmin/conf/.gitignore b/lisp/webapps/ldapadmin/conf/.gitignore
new file mode 100644
index 0000000..14fa7a6
--- /dev/null
+++ b/lisp/webapps/ldapadmin/conf/.gitignore
@@ -0,0 +1 @@
+options.lisp
diff --git a/lisp/webapps/ldapadmin/conf/options.lisp.example b/lisp/webapps/ldapadmin/conf/options.lisp.example
new file mode 100644
index 0000000..89f0a37
--- /dev/null
+++ b/lisp/webapps/ldapadmin/conf/options.lisp.example
@@ -0,0 +1,11 @@
+((:name "ldapadmin"
+  :url "ldapadmin.tld"
+  :document-root "ldapadmin"
+  :title "LDAP Administration Tool"
+  :meta-description "LDAP Administration Tool"
+  :ldap (:ldap-host "ldap.tld"
+         :sslflag nil
+         :username "cn=Manager,dc=tld"
+         :password "Welcome1"
+         :base-dn "dc=tld"
+         :debug-mode t)))
diff --git a/lisp/webapps/ldapadmin/site.lisp b/lisp/webapps/ldapadmin/site.lisp
new file mode 100644
index 0000000..5b5163a
--- /dev/null
+++ b/lisp/webapps/ldapadmin/site.lisp
@@ -0,0 +1,101 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defmacro .base (&optional (onload-fn "goto_location('/home')"))
+  `(org-ckons-http::html5
+    `(html
+      (head
+       ((meta :name "viewport" :content "width=device-width, initial-scale=1"))
+       ((meta :charset "utf-8"))
+       ((title) ,(title *webapp*))
+       ,@(mapcar (lambda (css)
+                   `((link :rel "stylesheet" :href ,(getf css :href) :integrity ,(getf css :integrity) :crossorigin ,(getf css :crossorigin))))
+                 '((:href "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/css/bootstrap.min.css" :integrity "sha384-Gn5384xqQ1aoWXA+058RXPxPg6fy4IWvTNh0E263XmFcJlSAwiGgFAW/dAiS6JXm" :crossorigin "anonymous")
+                   (:href "https://stackpath.bootstrapcdn.com/bootswatch/4.5.2/darkly/bootstrap.min.css" :integrity "sha384-nNK9n28pDUDDgIiIqZ/MiyO3F4/9vsMtReZK39klb/MtkZI3/LtjSjlmyVPS3KdN" :crossorigin "anonymous")))
+       ,@(mapcar (lambda (js)
+                   `((script :type "text/javascript" :src ,(getf js :src) :integrity ,(getf js :integrity) :crossorigin ,(getf js :crossorigin))))
+                 '((:src "https://code.jquery.com/jquery-3.2.1.slim.min.js" :integrity "sha384-KJ3o2DKtIkvYIK3UENzmM7KCkRr/rE9/Qpg6aAZGJwFDMVNA/GpGFF93hXpG5KkN" :crossorigin "anonymous")
+                   (:src "https://cdnjs.cloudflare.com/ajax/libs/popper.js/1.12.9/umd/popper.min.js" :integrity "sha384-ApNbgh9B+Y1QKtv3Rn7W3mgPxhU9K/ScQsAP7hUibX39j7fakFPskvXusvfa0b4Q" :crossorigin "anonymous")
+                   (:src "https://maxcdn.bootstrapcdn.com/bootstrap/4.0.0/js/bootstrap.min.js" :integrity "sha384-JZR6Spejh4U02d8jOt6vLEHfe/JQGiRRSQQxSfFWpi1MquVdAyjUar5+76PVCmYl" :crossorigin "anonymous")))
+       ((script :type "text/javascript" :src "/static/js/cljs/main.js")))
+      ((body :onload ,(format nil "ldapadmin.core.~a" ,onload-fn))
+       ((div :class "container-fluid")
+        ((div :class "row")
+         ((div :class "col") "&nbsp;")
+         ((div :class "col")
+          ((div :class "page-header")
+           ((h2 :align "center") ,(title *webapp*))))
+         ((div :class "col") "&nbsp;"))
+        ((div :id "menu" :class "well"))
+        ((div :id "location" :style "display: none"))
+        ((div :id "errormsg"))
+        ((div :id "message"))
+        ((div :id "body")))))))
+
+(defmacro .location ()
+  `(location-json location))
+
+(defmacro .home-get ()
+  `(home-json))
+
+(defmacro .home-post ()
+  `(home-json message errormsg))
+
+(defmacro .menu ()
+  `(menu-json))
+
+(defmacro .login ()
+  `(login-json))
+
+(defmacro .login-authenticate ()
+  `(login-authenticate-json dn password))
+
+(defmacro .logout ()
+  `(logout-json))
+
+(defmacro .inetorg-view ()
+  `(inetorg-view-json))
+
+(defmacro .inetorg-view-search ()
+  `(inetorg-view-search-json))
+
+(defmacro .inetorg-view-results ()
+  `(inetorg-view-results-json givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory))
+
+(defmacro .inetorg-modify ()
+  `(inetorg-modify-json cn))
+
+(defmacro .inetorg-modify-submit ()
+  `(inetorg-modify-submit-json givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory))
+
+(defmacro .inetorg-delete ()
+  `(inetorg-delete-json cn))
+
+(defmacro .inetorg-delete-submit ()
+  `(inetorg-delete-submit-json cn))
+
+(defmacro .inetorg-add ()
+  `(inetorg-add-json))
+
+(defmacro .inetorg-add-submit ()
+  `(inetorg-add-submit-json givenname sn mail postaladdress postalcode st l telephonenumber mobile businesscategory))
+
+(define-endpoint :get "/" () .base)
+(define-endpoint :post "/location" ((location :parameter-type 'string)) .location)
+(define-endpoint :get "/home" () .home-get)
+(define-endpoint :post "/home" ((message :parameter-type 'string) (errormsg :parameter-type 'string)) .home-post)
+(define-endpoint :get "/menu" () .menu)
+(define-endpoint :get "/login" () .login)
+(define-endpoint :post "/login/authenticate" ((dn :parameter-type 'string) (password :parameter-type 'string)) .login-authenticate)
+(define-endpoint :get "/logout" () .logout)
+(define-endpoint :get "/inetorg/view" () .inetorg-view)
+(define-endpoint :get "/inetorg/view/search" () .inetorg-view-search)
+(define-endpoint :post "/inetorg/view/results" ((givenname :parameter-type 'string) (sn :parameter-type 'string) (mail :parameter-type 'string) (postaladdress :parameter-type 'string) (postalcode :parameter-type 'string) (st :parameter-type 'string) (l :parameter-type 'string) (telephonenumber :parameter-type 'string) (mobile :parameter-type 'string) (businesscategory :parameter-type 'string)) .inetorg-view-results)
+(define-endpoint :post "/inetorg/modify" ((cn :parameter-type 'string)) .inetorg-modify)
+(define-endpoint :post "/inetorg/modify/submit" ((givenname :parameter-type 'string) (sn :parameter-type 'string) (mail :parameter-type 'string) (postaladdress :parameter-type 'string) (postalcode :parameter-type 'string) (st :parameter-type 'string) (l :parameter-type 'string) (telephonenumber :parameter-type 'string) (mobile :parameter-type 'string) (businesscategory :parameter-type 'string)) .inetorg-modify-submit)
+(define-endpoint :post "/inetorg/delete" ((cn :parameter-type 'string)) .inetorg-delete)
+(define-endpoint :post "/inetorg/delete/submit" ((cn :parameter-type 'string)) .inetorg-delete-submit)
+(define-endpoint :get "/inetorg/add" () .inetorg-add)
+(define-endpoint :post "/inetorg/add/submit" ((givenname :parameter-type 'string) (sn :parameter-type 'string) (mail :parameter-type 'string) (postaladdress :parameter-type 'string) (postalcode :parameter-type 'string) (st :parameter-type 'string) (l :parameter-type 'string) (telephonenumber :parameter-type 'string) (mobile :parameter-type 'string) (businesscategory :parameter-type 'string)) .inetorg-add-submit)
diff --git a/lisp/webapps/ldapadmin/static/images/edit-delete.png b/lisp/webapps/ldapadmin/static/images/edit-delete.png
new file mode 100644
index 0000000..b0de61d
--- /dev/null
+++ b/lisp/webapps/ldapadmin/static/images/edit-delete.png
diff --git a/lisp/webapps/ldapadmin/static/js/cljs b/lisp/webapps/ldapadmin/static/js/cljs
new file mode 120000
index 0000000..349848d
--- /dev/null
+++ b/lisp/webapps/ldapadmin/static/js/cljs
@@ -0,0 +1 @@
+../../clojurescript/ldapadmin/resources/public/cljs
\ No newline at end of file
diff --git a/lisp/webapps/webapp-loader.lisp b/lisp/webapps/webapp-loader.lisp
new file mode 100644
index 0000000..555d493
--- /dev/null
+++ b/lisp/webapps/webapp-loader.lisp
@@ -0,0 +1,157 @@
+;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+(declaim (optimize (speed 0) (safety 3) (debug 3)))
+
+(in-package :ldapadmin)
+
+(defvar *acceptor* nil)
+(defvar *dispatch-table* '(#'dispatch-easy-handlers #'default-dispatcher))
+(defvar *webapps* (make-hash-table :test 'equal))
+(defvar *webapp* nil)
+(defparameter *port* 3006)
+(defparameter *session-timeout* 14400)
+(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name #.*package*)) "./"))
+  "The location of the web server root on the filesystem.")
+
+(defclass webapp ()
+  ((name :initarg :name
+         :initform nil
+         :accessor name
+         :documentation "The name of the webapp as used in the code. A
+string used as the key to any webapp config lookup.")
+   (url :initarg :url
+        :initform nil
+        :accessor url
+        :documentation "The domain portion of the URL to the
+root of the webapp.")
+   (document-root :initarg :document-root
+                  :initform nil
+                  :accessor document-root
+                  :documentation "The absolute filesystem path to
+the webapp's top-level directory, which is inside the webapps
+folder.")
+   (title :initarg :title
+          :initform nil
+          :accessor title
+          :documentation "The default title that shows up in
+the browser title bar.")
+   (meta-description :initarg :meta-description
+          :initform nil
+          :accessor meta-description
+          :documentation "The text that goes into the META DESCRIPTION
+tag, and anywhere else we want to put this text so that it will show
+up in Google.")
+   (ldap :initarg :ldap
+         :initform nil
+         :accessor ldap))
+  (:documentation ""))
+
+(defgeneric get-site-file-path (webapp)
+  (:documentation "Builds a full filesystem path to a webapp's site
+file."))
+
+(defmethod get-site-file-path ((webapp webapp))
+  (format nil "~a/site" (document-root webapp)))
+
+(defgeneric get-pages-file-paths (webapp)
+  (:documentation ""))
+
+(defmethod get-pages-file-paths ((webapp webapp))
+  (mapcar (lambda (pages-file)
+            (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) ""))
+          (remove-if (lambda (x) (equal x "shared"))
+                     (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp))))))
+
+(defun make-server-path (relative-path)
+  "Makes a relative filesystem path into a full one, using
+`*server-root*' as the base."
+  (make-document-root-path *server-root* relative-path))
+
+(defun make-document-root-path (document-root relative-path)
+  "Makes a relative filesystem path into a full one, using
+`document-root' as the base."
+  (concatenate 'string document-root relative-path))
+
+(defun make-webapp-path (relative-path)
+  "Makes an absolute filesystem path to a location in the webapps
+folder."
+  (concatenate 'string *server-root* "webapps/" relative-path))
+
+(defun get-options-files ()
+  (mapcar (lambda (webapp-directory)
+            (format nil "~a/conf/options.lisp" webapp-directory))
+          (remove-if (lambda (x) (or (org-ckons-core::match-it "webapps/$" x)
+                                     (org-ckons-core::match-it "webapps/shared$" x)
+                                     (org-ckons-core::match-it "webapps/CVS$" x)
+                                     (org-ckons-core::match-it "webapps/\\.$" x)
+                                     (org-ckons-core::match-it "webapps/\\.\\.$" x)))
+                     (org-ckons-core::shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path ""))))))
+
+(defun set-webapp (webapp)
+  "Sets a `webapp' object in `*webapps*'.  The lookup key is the
+webapp name.  If a webapp already exists under this key, it gets
+overwritten with the new one."
+  (setf (gethash (name webapp) *webapps*) webapp))
+
+(defun get-webapp (key)
+  "Gets the webapp object."
+  (gethash key *webapps*))
+
+(defun generate-sessionid ()
+  "Generates a unique random string to seed the
+`*session-secret*'. The string is a SHA256 hash."
+  (let ((entropic-value (make-array '(32) :element-type '(unsigned-byte 8))))
+    (with-open-file (urandom-file "/dev/urandom" :direction :input :element-type '(unsigned-byte 8))
+      (loop for i from 0 to 31 do
+           (setf (elt entropic-value i) (read-byte urandom-file))))
+    (let ((digest (ironclad:make-digest 'ironclad:sha256)))
+      (ironclad:update-digest digest entropic-value)
+      (ironclad:byte-array-to-hex-string (ironclad:produce-digest digest)))))
+
+(defun populate-webapps ()
+  (loop for options-file in (get-options-files) do
+       (with-open-file (input options-file :direction :input)
+         (let* ((form (car (read input))))
+           (set-webapp (make-instance 'webapp
+                                      :name (getf form :name)
+                                      :url (getf form :url)
+                                      :document-root (make-webapp-path (getf form :document-root))
+                                      :title (getf form :title)
+                                      :meta-description (getf form :meta-description)
+                                      :ldap (getf form :ldap)))))))
+
+(defun ldapadmin ()
+  "Call this to start the server."
+  (when (null *acceptor*)
+    (let ((package (string-downcase (package-name *package*))))
+      (populate-webapps)
+      (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message))
+      (start-messenger 'text-file-messenger :filename (format nil "/var/log/lisp/~a.log" package))
+      (setf *session-secret* (generate-sessionid))
+      (populate-webapps)
+      (setf *acceptor* (start (make-instance 'easy-acceptor
+                                             :port *port*
+                                             :document-root (make-server-path (format nil "webapps/~a/" package))
+                                             :name (format nil "~a-acceptor" package)))))))
+
+(defmacro with-request-wrapper (uri page-function)
+  ;; Assigning package outside the backquote is necessary because
+  ;; *package* resolves incorrectly to common-lisp-user inside the
+  ;; backquote.
+  (let ((package (string-downcase (package-name *package*))))
+    `(let ((*webapp* (get-webapp ,package)))
+       (org-ckons-core::logger (format nil "Page request URI: [~a]" ,uri))
+       (unless *session*
+         (start-session)
+         (setf (session-max-time *session*) *session-timeout*)
+         (setf (session-value :permissions) "anonymous"))
+       (,page-function))))
+  
+(defmacro define-endpoint (request-type uri var-list page-function)
+  "Does the grunt work of creating an `easy-handler' for each page you
+wish to publish."
+  (let ((name (gensym)))
+    `(progn
+       (org-ckons-core::logger (format nil "Publishing page. URL = [~a]" ,uri))
+       (define-easy-handler (,name :uri ,uri :default-request-type ,request-type)
+           ,var-list
+         (with-request-wrapper ,uri ,page-function)))))