Moved core to its own library

13 files changed, 80 insertions, 240 deletions

diff --git a/core/core.lisp b/core/core.lisp
new file mode 100644
index 0000000..259e15b
--- /dev/null
+++ b/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/core/coreutils.lisp b/core/coreutils.lisp
deleted file mode 100644
index e7362d8..0000000
--- a/core/coreutils.lisp
+++ /dev/null
@@ -1,186 +0,0 @@
-;;; -*- 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)
-
-(defparameter *server-root* (namestring (asdf:system-relative-pathname (intern (package-name *package*)) "./"))
-  "The location of the web server root on the filesystem.")
-
-(defmacro with-gensyms (syms &body body)
-  `(let ,(mapcar #'(lambda (s)
-                     `(,s (gensym)))
-                 syms)
-     ,@body))
-
-(defmacro once-only ((&rest names) &body body)
-  (let ((gensyms (loop for n in names collect (gensym))))
-    `(let (,@(loop for g in gensyms collect `(,g (gensym))))
-       `(let (,,@(loop for g in gensyms for n in names collect ``(,,g ,,n)))
-          ,(let (,@(loop for n in names for g in gensyms collect `(,n ,g)))
-             ,@body)))))
-
-(defun logger (output)
-  "Logs output to the cl-log log file."
-  (log-message :info (format nil "~a: ~a" (net.telent.date:universal-time-to-rfc2822-date (get-universal-time)) output)))
-
-(defun string-to-list (my-string)
-  "Converts a sequence to a list \(or whatever the sequence is a
-string representation of\)."
-  (with-input-from-string (stream my-string)
-    (read stream)))
-
-(defmacro add-to-list (output-list &rest value-to-add)
-  "Wraps the SETF...APPEND idiom in a smaller package."
-  `(setf ,output-list (append ,output-list ,@value-to-add)))
-
-(defun parse-symbol (my-symbol)
-  (let ((symbol-parts (ppcre:split "::" (symbol-name my-symbol))))
-    (if (= (length symbol-parts) 1)
-        (car symbol-parts)
-        (cadr symbol-parts))))
-
-(defun flatten (mylist)
-  (cond ((atom mylist) mylist)
-        ((listp (car mylist))
-         (append (flatten (car mylist)) (flatten (cdr mylist))))
-        (t (append (list (car mylist)) (flatten (cdr mylist))))))
-
-(defun match-it (regex field)
-  "Wraps a PCRE search in a smaller package."
-  (cl-ppcre:all-matches-as-strings regex field))
-
-(defun cast-float (string-rep)
-  "Tries to return the float representation of `string-rep'.  If
-`string-rep' cannot be parsed as a float, returns `nil'."
-  (let ((read-value (read-from-string string-rep)))
-    (cond ((floatp read-value) read-value)
-          ((integerp read-value) (float read-value))
-          (t nil))))
-
-(defun pretty-print (raw-string &optional textbox-p)
-  "Filters `nil' string values, returning ` ' instead.  But if
-`textbox-p' is t, it returns an empty string instead of ` '."
-  (let ((trimmed-string (when raw-string (string-trim '(#\Space #\Tab) raw-string))))
-    (if (and trimmed-string (> (length trimmed-string) 0))
-        (format nil "~a" (ppcre:regex-replace-all "\"" trimmed-string """))
-        (if textbox-p "" " "))))
-
-(defun strip-milliseconds (sql-datetime)
-  (subseq sql-datetime 0 (position #\. sql-datetime)))
-
-#+sbcl
-(defun map-slot-names (instance)
-  "Returns a list of the names of all the slots of any class instance
-using reflection.  The returned values are symbols.  Only works with
-SBCL."
-  (mapcar #'sb-mop:slot-definition-name
-          (sb-mop:class-slots (class-of instance))))
-
-(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-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 null-or-empty-p (sequence)
-  (or (null sequence) (equal (length sequence) 0)))
-
-(defun xml-escape (mystring)
-  (setf mystring (ppcre:regex-replace-all "<" mystring "&lt;"))
-  (setf mystring (ppcre:regex-replace-all ">" mystring "&gt;"))
-  (setf mystring (ppcre:regex-replace-all "&" mystring "&amp;"))
-  (setf mystring (ppcre:regex-replace-all "\"" mystring "&quot;"))
-  (setf mystring (ppcre:regex-replace-all "'" mystring "&apos;"))
-  mystring)
-
-(defun xml-unescape (mystring)
-  (setf mystring (ppcre:regex-replace-all "&lt;" mystring "<"))
-  (setf mystring (ppcre:regex-replace-all "&gt;" mystring ">"))
-  (setf mystring (ppcre:regex-replace-all "&amp;" mystring "&"))
-  (setf mystring (ppcre:regex-replace-all "&quot;" mystring "\""))
-  (setf mystring (ppcre:regex-replace-all "&apos;" mystring "'"))
-  mystring)
-
-(defun trim-last-char (mystring)
-  (if (null-or-empty-p mystring)
-      ""
-      (subseq mystring 0 (- (length mystring) 1))))
-
-(defun string-to-real (string-rep)
-  "Converts a string representation of a number to a rational
-representation.  For some reason, the lisp community calls rational
-numbers `real'. If you pass this method garbage, you will get 0. It
-always returns a number."
-  (if (null-or-empty-p string-rep)
-      0
-      (let* ((string-parts (ppcre:split "\\." (string-trim '(#\Space #\Tab) string-rep)))
-             (integer-portion (parse-integer (car string-parts) :junk-allowed t))
-             (fractional-portion-string (second string-parts))
-             (fractional-divisor 1))
-        (multiple-value-bind (fractional-portion fractional-portion-length)
-            (if (> (length fractional-portion-string) 0)
-                (parse-integer fractional-portion-string :junk-allowed t)
-                (values nil 0))
-          (when (null integer-portion)
-            (setf integer-portion 0))
-          (when (null fractional-portion)
-            (setf fractional-portion 0))
-          (when (not (= fractional-portion 0))
-            (setf fractional-divisor (expt 10 fractional-portion-length)))
-          (if (>= integer-portion 0)
-              (+ integer-portion (/ fractional-portion fractional-divisor))
-              (- integer-portion (/ fractional-portion fractional-divisor)))))))
-
-(defun real-to-string (real-rep &key (places 2))
-  "Converts a rational representaion of a number into a string
-representation, rounded to `places' decimal places."
-  (when real-rep
-    (if (= places 0)
-        (format nil "~a" (parse-integer (format nil "~,2f" real-rep) :junk-allowed t))
-        (format nil
-                (format nil "~~,~af" places)
-                (coerce real-rep 'long-float)))))
-
-(defun double-to-real (double-rep &key (places 2))
-  "Converts a double to a real.  It does this by converting the double
-to a string, and then the string to a real.  Decimal place truncation
-happens when converting to a string."
-  (string-to-real (real-to-string double-rep :places places)))
-
-(defun pad-with-zeros (string-rep places)
-  "Left-pads a string representaion of a number with leading zeros to
-make it the specified length."
-  (loop for i from (+ (length string-rep) 1) to places do
-       (setf string-rep (format nil "0~a" string-rep)))
-  string-rep)
-
-(defun shell-wrapper (command)
-  "Calls a shell command and returns the output as a list, where each
-atom of the list is a string that contains one line of the output."
-  (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)))
-    (with-output-to-string (stream output)
-      (uffi:run-shell-command command :output stream))
-    (loop for line in (ppcre:split #\Newline output)
-       collect line)))
-
-(defun reduce-to-char-separated-string (mylist char)
-  (format nil "~a" (reduce (lambda (&optional x y)
-                             (cond ((and x y) (format nil "~a~a~a" x char y))
-                                   ((and x (not y)) (format nil "~a" x))
-                                   ((and (not x) y) (format nil "~a" y))
-                                   (t "")))
-                           mylist)))
-
-(defun reduce-to-comma-separated-string (mylist)
-  (reduce-to-char-separated-string mylist ","))
-
-(defun reduce-to-newline-separated-string (mylist)
-  (reduce-to-char-separated-string mylist #\Newline))
diff --git a/entity/entity.lisp b/entity/entity.lisp
index c7f9842..327fb2f 100644
--- a/entity/entity.lisp
+++ b/entity/entity.lisp
@@ -15,26 +15,26 @@ on those slots. `slot' is the iterator."
   `(remove-if #'null (mapcar (lambda (slot)
                                (when (slot-is-field-p slot)
                                  ,@body))
-                             (map-slot-names ,entity))))
+                             (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 (null-or-empty-p (slot-value entity slot)))))
+                   (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) (match-it regex (symbol-name x)))
-                       (map-slot-names entity))
+  (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 (map-slot-names entity) do
-         (let ((class-slot-string (parse-symbol class-slot)))
+    (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 (parse-symbol arg-slot)))
+                (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)))
diff --git a/entity/generics.lisp b/entity/generics.lisp
index e2a050a..b14aa9a 100644
--- a/entity/generics.lisp
+++ b/entity/generics.lisp
@@ -12,9 +12,10 @@ 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 `map-slot-names'
-returns slot names prefixed with the package name, this method was
-written to intersect lists ignoring package prefixes."))
+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'
diff --git a/entity/ldap-user.lisp b/entity/ldap-user.lisp
index f8d8a1c..9097e54 100644
--- a/entity/ldap-user.lisp
+++ b/entity/ldap-user.lisp
@@ -50,14 +50,14 @@
          (change-attrs (remove-if #'null
                                   (mapcar (lambda (attr)
                                             (let ((new-attr (assoc (car attr) new-attrs)))
-                                              (cond ((and (null-or-empty-p (cdr attr))
-                                                          (not (null-or-empty-p (cdr new-attr))))
+                                              (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 (null-or-empty-p (cdr attr)))
-                                                          (null-or-empty-p (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 (null-or-empty-p (cdr attr)))
-                                                          (not (null-or-empty-p (cdr new-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))))
@@ -71,5 +71,5 @@
 
 (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 (add-to-list new-attrs '((objectclass . (inetorgperson)))))))
+         (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/file/file-utils.lisp b/file/file-utils.lisp
index cafdf17..934dc41 100644
--- a/file/file-utils.lisp
+++ b/file/file-utils.lisp
@@ -10,7 +10,7 @@ extension, such as .fasl or .lisp."
   (load filename))
 
 (defun write-pid-file ()
-  (shell-wrapper (format nil "echo ~a >~a/~a.pid" (sb-posix:getpid) (sb-posix:getenv "HOME") (string-downcase (package-name *package*)))))
+  (org-ckons-core::shell-wrapper (format nil "echo ~a >~a/~a.pid" (sb-posix:getpid) (sb-posix:getenv "HOME") (string-downcase (package-name *package*)))))
 
 (defun file-to-list (infile)
   "Reads `infile' and returns a list, where each atom is a single
@@ -59,8 +59,8 @@ line at a time."
 directory does not exist, it will be created."
   (when (and (file-exists-p source)
              (file-p source)
-             (not (null-or-empty-p destination)))
-    (let ((destination-parts (nreverse (remove-if #'null-or-empty-p (ppcre:split "/" destination))))
+             (not (org-ckons-core::null-or-empty-p destination)))
+    (let ((destination-parts (nreverse (remove-if #'org-ckons-core::null-or-empty-p (ppcre:split "/" destination))))
           (destination-file "")
           (destination-directory ""))
         (setf destination-file (pop destination-parts))
@@ -80,19 +80,19 @@ old."
   (uffi:run-shell-command (format nil "find ~a/* -regex '~a' |xargs rm -rf" directory-path regex)))
 
 (defun file-exists-p (file-path)
-  (equal (car (shell-wrapper (format nil "if test -f '~a'; then echo 0; else echo 1; fi" file-path))) "0"))
+  (equal (car (org-ckons-core::shell-wrapper (format nil "if test -f '~a'; then echo 0; else echo 1; fi" file-path))) "0"))
 
 (defun file-mtime (file-path)
-  (let ((output (car (shell-wrapper (format nil "ls --full-time '~a' |awk '{ print $6,$7 }' |awk -F. '{ print $1; }'" file-path)))))
-    (if (not (match-it "^\\d\\d\\d\\d-\\d\\d-\\d\\d \\d\\d:\\d\\d:\\d\\d$" output))
+  (let ((output (car (org-ckons-core::shell-wrapper (format nil "ls --full-time '~a' |awk '{ print $6,$7 }' |awk -F. '{ print $1; }'" file-path)))))
+    (if (not (org-ckons-core::match-it "^\\d\\d\\d\\d-\\d\\d-\\d\\d \\d\\d:\\d\\d:\\d\\d$" output))
         (error 'handled-error :text (format nil "Error in `file-mtime': ~a" output))
         output)))
 
 (defun directory-p (absolute-path)
-  (if (car (shell-wrapper (format nil "file '~a' |grep 'directory'" absolute-path))) t nil))
+  (if (car (org-ckons-core::shell-wrapper (format nil "file '~a' |grep 'directory'" absolute-path))) t nil))
 
 (defun symlink-p (absolute-path)
-  (if (car (shell-wrapper (format nil "file '~a' |grep 'symbolic link'" absolute-path))) t nil))
+  (if (car (org-ckons-core::shell-wrapper (format nil "file '~a' |grep 'symbolic link'" absolute-path))) t nil))
 
 (defun file-p (absolute-path)
   (if (or (directory-p absolute-path) (symlink-p absolute-path)) nil t))
@@ -100,10 +100,10 @@ old."
 (defun path-contained-p (root-path path-to-check)
   "Returns `(,root-path) if `path-to-check' is contained within `root-path',
 `nil' otherwise."
-  (match-it root-path path-to-check))
+  (org-ckons-core::match-it root-path path-to-check))
 
 (defun find-files (working-dir base-dir pattern)
-  (shell-wrapper (format nil
+  (org-ckons-core::shell-wrapper (format nil
                          "pushd ~a >/dev/null 2>&1 ; find ~a -iname '~a' ; popd >/dev/null 2>&1"
                          working-dir
                          base-dir
diff --git a/core/html.lisp b/http/html.lisp
index c76e9cb..99f0a4b 100644
--- a/core/html.lisp
+++ b/http/html.lisp
@@ -117,7 +117,7 @@ But HTML will print both of them"
 (destructure-html (tag attrs content) '((span :class \"strange\") \"A strange span!\")
   (format t \"<~A ~{~A~}>~{~A~}</~A>\" tag attrs content tag))
 If the construct is invalid, it will cause an error"
-  (once-only (html)
+  (org-ckons-core::once-only (html)
     `(if (htmlp ,html)
       (let ((,tag-sym (if (consp (car ,html))
 			  (caar ,html)
diff --git a/core/httputils.lisp b/http/httputils.lisp
index fbd5c36..fbd5c36 100644
--- a/core/httputils.lisp
+++ b/http/httputils.lisp
diff --git a/json/json-utils.lisp b/json/json-utils.lisp
index 90262ef..0e0fa12 100644
--- a/json/json-utils.lisp
+++ b/json/json-utils.lisp
@@ -6,13 +6,13 @@
 (defun json-to-object (object-type json-obj)
   (remove-if-not (lambda (x)
                    (let ((found-value nil))
-                     (loop for slot in (map-slot-names x) do
+                     (loop for slot in (org-ckons-core::map-slot-names x) do
                           (when (slot-value x slot)
                             (setf found-value t)))
                      found-value))
                  (mapcar (lambda (obj)
                            (let ((object (make-instance object-type)))
-                             (loop for slot in (map-slot-names object) do
+                             (loop for slot in (org-ckons-core::map-slot-names object) do
                                   (let ((symb (intern (symbol-name slot) :keyword)))
                                     (setf (slot-value object slot)
                                           (cdr (find-if (lambda (param) (eq (car param) symb)) obj)))))
@@ -58,13 +58,13 @@
                                                                   (map-slots value)))
                                                              (t
                                                               value))))))
-                                      (map-slot-names object))))
+                                      (org-ckons-core::map-slot-names object))))
            (listify (list-of-objects)
              (mapcar (lambda (object)
                        (map-slots object))
                      list-of-objects)))
     (let ((listobj (listify list-of-objects)))
-      (reduce-to-comma-separated-string (mapcar (lambda (alist)
+      (org-ckons-core::reduce-to-comma-separated-string (mapcar (lambda (alist)
                                                   (if explicit-encoder-p
                                                       (json:with-explicit-encoder
                                                         (json:encode-json-to-string (cons :object alist)))
diff --git a/ldap/ldap.lisp b/ldap/ldap.lisp
index 0c16414..2d477e4 100644
--- a/ldap/ldap.lisp
+++ b/ldap/ldap.lisp
@@ -120,8 +120,8 @@ binddn. Returns `t' if the password is valid, `nil' otherwise."
 \"Konstanski\"))' to an LDAP search base fragment like
 \"(givenname=Carlos)(sn=Konstanski)\". Any `nil' or empty-string
 values are ignored."
-  (reduce-to-char-separated-string (mapcar (lambda (term)
-                                             (when (not (null-or-empty-p (cadr term)))
+  (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))
diff --git a/ldapadmin.asd b/ldapadmin.asd
index 5d6b331..d5155f6 100644
--- a/ldapadmin.asd
+++ b/ldapadmin.asd
@@ -17,25 +17,29 @@
        :depends-on ,(eval depends-on)
        :components ,components))
 
-(defparameter *asdf-packages* '(net-telent-date cl-ppcre uffi hunchentoot cl-log ironclad cl-json drakma trivial-ldap))
+(defparameter *quicklisp-packages* '(net-telent-date cl-ppcre uffi hunchentoot cl-log ironclad cl-json drakma trivial-ldap))
+(defparameter *asdf-packages* '(org-ckons-core))
+(defparameter *all-packages* (append *quicklisp-packages* *asdf-packages*))
 
-(loop for pkg in *asdf-packages* do
+(loop for pkg in *quicklisp-packages* do
      (ql:quickload (symbol-name pkg)))
 
 (do-defsystem :name "ldapadmin"
-              :version "1.00.000"
-              :maintainer "Carlos Konstanski <ckonstanski@pippiandcarlos.com>"
-              :author "Carlos Konstanski <ckonstanski@pippiandcarlos.com>"
+              :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. Its purpose is to be an administrative frontend to an openldap server."
-              :depends-on *asdf-packages*
+              :long-description "ldapadmin is a web application written in Common Lisp, based on the Hunchentoot web server. It is an LDAP frontend web UI."
+              :depends-on *all-packages*
               :components ((:module core
-                            :components ((:file "coreutils")
-                                         (:file "httputils" :depends-on ("coreutils"))
-                                         (:file "html" :depends-on ("coreutils"))))
+                            :components ((:file "core")))
                            (:module condition
                             :depends-on (core)
                             :components ((:file "condition")))
+                           (:module http
+                            :depends-on (condition)
+                            :components ((:file "httputils")
+                                         (:file "html")))
                            (:module file
                             :depends-on (condition)
                             :components ((:file "file-utils")))
diff --git a/service/logout-service.lisp b/service/logout-service.lisp
index d6aef8f..afc3ace 100644
--- a/service/logout-service.lisp
+++ b/service/logout-service.lisp
@@ -10,8 +10,9 @@
   (:documentation ""))
 
 (defmethod initialize-instance :after ((logout-service logout-service) &key)
+  (setf (location logout-service) "/home")
   (setf (message logout-service) "You are now logged out."))
 
 (defun logout-json ()
-  (set-user (make-default-user))
+  (setf (session-value :permissions) nil)
   (objects-to-json `(,(make-instance 'logout-service))))
diff --git a/webapps/webapp-loader.lisp b/webapps/webapp-loader.lisp
index 83f1979..56df461 100644
--- a/webapps/webapp-loader.lisp
+++ b/webapps/webapp-loader.lisp
@@ -9,6 +9,8 @@
 (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
@@ -57,7 +59,17 @@ file."))
   (mapcar (lambda (pages-file)
             (ppcre:regex-replace-all "\\.lisp$" (format nil "~a" pages-file) ""))
           (remove-if (lambda (x) (equal x "shared"))
-                     (shell-wrapper (format nil "find '~a' -maxdepth 1 -type f -iname 'pages*.lisp' |sort" (document-root webapp))))))
+                     (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
@@ -67,12 +79,12 @@ folder."
 (defun get-options-files ()
   (mapcar (lambda (webapp-directory)
             (format nil "~a/conf/options.lisp" webapp-directory))
-          (remove-if (lambda (x) (or (match-it "webapps/$" x)
-                                     (match-it "webapps/shared$" x)
-                                     (match-it "webapps/CVS$" x)
-                                     (match-it "webapps/\\.$" x)
-                                     (match-it "webapps/\\.\\.$" x)))
-                     (shell-wrapper (format nil "find '~a' -maxdepth 1 -type d |sort" (make-webapp-path ""))))))
+          (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
@@ -127,7 +139,7 @@ overwritten with the new one."
   ;; backquote.
   (let ((package (string-downcase (package-name *package*))))
     `(let ((*webapp* (get-webapp ,package)))
-       (logger (format nil "Page request URI: [~a]" ,uri))
+       (org-ckons-core::logger (format nil "Page request URI: [~a]" ,uri))
        (unless *session*
          (start-session)
          (setf (session-max-time *session*) *session-timeout*)
@@ -139,7 +151,7 @@ overwritten with the new one."
 wish to publish."
   (let ((name (gensym)))
     `(progn
-       (logger (format nil "Publishing page. URL = [~a]" ,uri))
+       (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)))))