summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorckonstanski <ckonstanski@pippiandcarlos.com>2020-12-23 18:40:07 -0700
committerckonstanski <ckonstanski@pippiandcarlos.com>2020-12-23 18:40:07 -0700
commit09f21b7abfdbe78a515833760f7567bd23614757 (patch)
treed85fd4a5ca71d4ab7fed0b330ad0b9ad71f26fc8
parent74da7d1d424e08c8504effe562318ca029eb3a6e (diff)
moved json functions to separate library
-rw-r--r--file/file-utils.lisp110
-rw-r--r--http/html.lisp324
-rw-r--r--http/httputils.lisp66
-rw-r--r--json/json-utils.lisp72
-rw-r--r--ldapadmin.asd12
-rw-r--r--service/auth-service.lisp2
-rw-r--r--service/home-service.lisp6
-rw-r--r--service/login-service.lisp4
-rw-r--r--service/logout-service.lisp2
-rw-r--r--service/menu-service.lisp2
10 files changed, 11 insertions, 589 deletions
diff --git a/file/file-utils.lisp b/file/file-utils.lisp
deleted file mode 100644
index 934dc41..0000000
--- a/file/file-utils.lisp
+++ /dev/null
@@ -1,110 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-(declaim (optimize (speed 0) (safety 3) (debug 3)))
-
-(in-package #:ldapadmin)
-
-(defun compile-and-load (filename)
- "Compiles and then loads a file. `filename' should not have an
-extension, such as .fasl or .lisp."
- (compile-file filename)
- (load filename))
-
-(defun write-pid-file ()
- (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
-line of the file. `infile' can be a string or a pathname
-object."
- (let ((infile-list ()))
- (with-open-file (filehandle infile :if-does-not-exist nil)
- (if (streamp filehandle)
- (progn
- (loop for line = (read-line filehandle nil)
- while line do
- (push line infile-list))
- (nreverse infile-list))
- nil))))
-
-(defun parse-csv-line (line)
- "Parses a single line of CSV input into a list of string fields."
- (let ((quoted-string-mode nil)
- (line-list ())
- (field-collector ""))
- (loop for this-char across (ppcre:regex-replace-all #\Return line "") do
- (cond ((equal this-char #\")
- (setf quoted-string-mode (not quoted-string-mode)))
- ((and (equal this-char #\,) (not quoted-string-mode))
- (push field-collector line-list)
- (setf field-collector ""))
- (t
- (setf field-collector (format nil "~a~a" field-collector this-char)))))
- ;; get the field after the last comma
- (push field-collector line-list)
- (nreverse line-list)))
-
-(defmacro dofile ((line filename) &body body)
- "Wrapper for the common task of opening a file and reading it one
-line at a time."
- (let ((stream (gensym)))
- `(with-open-file (,stream ,filename)
- (loop for ,line = (read-line ,stream nil nil)
- while ,line do ,@body))))
-
-(defun mkdir (path)
- (uffi:run-shell-command (format nil "mkdir -p ~a" path)))
-
-(defun copy-file (source destination)
- "Copies file from `source' to `destination'. If the destination
-directory does not exist, it will be created."
- (when (and (file-exists-p source)
- (file-p source)
- (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))
- (loop for part in (nreverse destination-parts) do
- (setf destination-directory (format nil "~a/~a" destination-directory part)))
- (mkdir destination-directory)
- (uffi:run-shell-command (format nil "cp '~a' '~a'" source destination)))))
-
-(defun purge-old-files (directory-path)
- "Deletes everything out of a directory that is older than 8 hours
-old."
- (uffi:run-shell-command (format nil "find ~a/* -mmin 480 |xargs rm -rf" directory-path)))
-
-(defun purge-files-regex (directory-path regex)
- "Deletes everything out of a directory whose name matches the
-`regex'."
- (uffi:run-shell-command (format nil "find ~a/* -regex '~a' |xargs rm -rf" directory-path regex)))
-
-(defun file-exists-p (file-path)
- (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 (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 (org-ckons-core::shell-wrapper (format nil "file '~a' |grep 'directory'" absolute-path))) t nil))
-
-(defun symlink-p (absolute-path)
- (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))
-
-(defun path-contained-p (root-path path-to-check)
- "Returns `(,root-path) if `path-to-check' is contained within `root-path',
-`nil' otherwise."
- (org-ckons-core::match-it root-path path-to-check))
-
-(defun find-files (working-dir base-dir pattern)
- (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
- pattern)))
diff --git a/http/html.lisp b/http/html.lisp
deleted file mode 100644
index 99f0a4b..0000000
--- a/http/html.lisp
+++ /dev/null
@@ -1,324 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-(declaim (optimize (speed 0) (safety 3) (debug 3)))
-
-;; Lifted directly from araneida.
-
-(in-package :ldapadmin)
-
-;;; XXX fix this, it's not correct
-(defun html-reserved-p (c)
- (member c '(#\< #\" #\> #\&)))
-
-(defun html-escape (html-string)
- (apply #'concatenate 'string
- (loop for c across html-string
- if (html-reserved-p c)
- collect (format nil "&#~A;" (char-code c))
- else if (eql c #\Newline) collect "<br>"
- else collect (string c))))
-
-(defun s. (&rest args)
- "Concatenate ARGS as strings"
- (declare (optimize (speed 3)))
- (let ((*print-pretty* nil))
- (with-output-to-string (out)
- (dolist (arg args)
- (princ arg out)))))
-
-(defun html-escape-tag (tag attrs content)
- (declare (ignore tag attrs))
- (s. (mapcar #'html-escape content)))
-
-(setf (get 'escape 'html-converter) #'html-escape-tag)
-(setf (get 'null 'html-converter) #'princ-to-string)
-
-(macrolet ((html-attr-body ()
- `(with-output-to-string (o)
- (loop for (att val . rest) on attr by #'cddr do
- (cond
- #+parenscript((and (symbolp att) (equal (symbol-name 'css) (symbol-name att)))
- (progn
- (princ " " o)
- (princ "style=\"" o)
- (princ (val-printer (parenscript::css-inline-func val)) o)
- (princ "\"" o)))
- ((symbolp att)
- (progn
- (princ " " o)
- (princ (symbol-name att) o)
- (princ "=\"" o)
- (princ (val-printer val) o)
- (princ "\"" o)))
- (t
- (error "attribute ~S is not a symbol in attribute list ~S" att attr)))))))
- (defun html-attr (attr)
- (macrolet ((val-printer (val)
- val))
- (html-attr-body)))
- (defun html-attr-escaped (attr)
- (macrolet ((val-printer (val)
- `(html-escape ,val)))
- (html-attr-body))))
-
-(defun empty-element-p (tag)
- (member (intern (symbol-name tag) #.*package*) '()))
-
-(defmacro defhtmltag (tag (attributes-var content-var) &body body)
- "Define a custom HTML tag
-Useful for custom phrases, or even special constructs.
-
-Example:
-(defhtmltag coffee (attr content)
- (declare (ignore attr content))
- \"c|_|\")
-
-So, saying
-(span \"Nice hot \" (coffee))
-
-Would produce:
-<span>Nice hot c|_|</span>
-
-More in-depth use would be something such as:
-(even-odd-list
- (li \"one\")
- (li \"two\")
- (li \"three\"))
-
-Turning into:
-(ul
- ((li :class \"odd\") \"one\")
- ((li :class \"even\") \"two\")
- ((li :class \"odd\") \"odd\"))
-
-Your custom tag is expected to return either a string or
-an html construct like you'd pass to HTML-STREAM."
- (with-gensyms (throw-away)
- `(setf (get ',tag :html-converter)
- (lambda (,throw-away ,attributes-var ,content-var)
- (declare (ignore ,throw-away))
- (funcall
- (lambda (,attributes-var ,content-var)
- ,@body)
- ,attributes-var ,content-var)))))
-
-(defun htmlp (html)
- "Returns t if html is a legal HTML list.
-NB: HTML and friends print out a superset of legal html lists.
-
-'(ul (li \"yes\") (li \"no\")) is legal
-3 is not
-
-But HTML will print both of them"
- (and (consp html)
- (not (stringp (car html)))))
-
-(defmacro destructure-html ((tag-sym attrs-sym content-sym) html &body body)
- "Destructure an HTML construct.
-(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"
- (org-ckons-core::once-only (html)
- `(if (htmlp ,html)
- (let ((,tag-sym (if (consp (car ,html))
- (caar ,html)
- (car ,html)))
- (,attrs-sym (if (consp (car ,html))
- (cdar ,html)
- nil))
- (,content-sym (cdr ,html)))
- ,@body))))
-
-; I admit, this is a rather goofy way to write this. There's just so much code they have in common
-; and this lets me modify them rather easily.
-(macrolet ((html-body ()
- `(ret-block
- (cond ((htmlp things)
- (destructure-html (tag attrs content) things
- (let ((special-effect (get tag :html-converter)))
- (if special-effect
- (if (not (functionp special-effect))
- (error "Tag ~A has :html-converter set, but NOT as a function." tag)
- (call-self stream (funcall special-effect tag attrs content) inline-elements))
- (cond ((equal (symbol-name 'comment) (symbol-name tag))
- (printing
- (format-out "<!-- ~{~A ~}~%" attrs)
- (iter-list (c content)
- (call-self stream c inline-elements))
- (format-out " -->~%")))
- #+parenscript
- ((equal (symbol-name 'css) (symbol-name tag))
- (printing
- (format-out "<style type=\"text/css\">~%")
- (format-out "<!--~%")
- (iter-list (c content)
- (format-out (parenscript::css-rule-to-string (parenscript::make-css-rule (car c) (cdr c)))))
- (format-out "~%-->")
- (format-out "</style>")))
- #+parenscript
- ((equal (symbol-name 'js-script) (symbol-name tag))
- (printing
- (format-out "<script type=\"text/javascript\">~%")
- (format-out "// <![CDATA[~%")
- (format-out (parenscript:js* (cons 'progn content)))
- (format-out "~%// ]]>~%")))
- ((not (empty-element-p tag))
- (printing
- (format-out "<~A~A>" (symbol-name tag) (attr-printer attrs))
- (iter-list (c content)
- (call-self stream c inline-elements))
- (format-out "</~A>~:[~;~%~]"
- (symbol-name tag)
- (not (member tag inline-elements)))))
- (t
- (format-out "<~A~A>" (symbol-name tag) (attr-printer attrs))))))))
- ((consp things)
- (iter-list (thing things) (format-out "~A" thing)))
- ((functionp things)
- (call-function things stream))
- ((keywordp things)
- (format-out "<~A>" (symbol-name things)))
- (t
- (format-out "~A" (thing-printer things)))))))
-
- ;; stream forms first
- (macrolet ((ret-block (output-block)
- `(progn
- ,output-block
- t))
- (iter-list ((item list) func)
- `(dolist (,item ,list)
- ,func))
- (printing (&body list)
- `(progn
- ,@list))
- (format-out (&rest args)
- `(format stream ,@args))
- (call-function (things stream)
- `(funcall ,things ,stream)))
-
- (defun html-stream (stream things &optional inline-elements)
- "Format supplied argument as HTML. Argument may be a string
-\(returned unchanged\) or a list of \(tag content\) where tag may be
-\(tagname attrs\). \(\(a :href \"/ \"\) \"home\"\) is formatted as
-you'd expect it to be. INLINE-ELEMENTS is a list of elements not to
-print a newline after. Returns T unless broken, so can be the last
-form in a handler For special effects, set the HTML-CONVERTER property
-of a symbol for a tag to a function. It will be called with arguments
-\(TAG ATTRS CONTENT\) and should return a string to be interpolated at
-that point."
- (declare (optimize (speed 3))
- (type stream stream))
- (macrolet ((attr-printer (attrs)
- `(html-attr ,attrs))
- (call-self (stream things &optional inline-elements)
- `(html-stream ,stream ,things ,inline-elements))
- (thing-printer (things)
- `(princ-to-string things)))
- (html-body)))
-
- (defun html-escaped-stream (stream things &optional inline-elements)
- "Format supplied argument as HTML, escaping properly.
-Just like html-stream except certain things are now html-escaped.
-Content - in '\(p \"foo\"\) \"foo\" is the content - is escaped, as
-well as the values of attributes. Please note that this CAN result in
-double escaping if calling code also escapes. For special effects,
-set the HTML-CONVERTER property of a symbol for a tag to a function.
-It will be called with arguments \(TAG ATTRS CONTENT\) and should
-return a string to be interpolated at that point. NB that the attrs
-and content will be passed in *unescaped*"
- (declare (optimize (speed 3))
- (type stream stream))
- (macrolet ((attr-printer (attrs)
- `(html-attr-escaped ,attrs))
- (call-self (stream things &optional inline-elements)
- `(html-escaped-stream ,stream ,things ,inline-elements))
- (thing-printer (things)
- `(html-escape (princ-to-string ,things))))
- (html-body))))
-
- ;; now for the string forms
- (macrolet ((ret-block (output-block)
- output-block)
- (iter-list ((item list) func)
- `(apply #'concatenate 'string (mapcar (lambda (,item) ,func) ,list)))
- (printing (&body list)
- `(concatenate 'string
- ,@list))
- (format-out (&rest args)
- `(format nil ,@args))
- (call-function (things stream)
- (declare (ignore stream))
- `(funcall ,things)))
-
- (defun html (things &optional inline-elements)
- "Format supplied argument as HTML. Argument may be a string
-\(returned unchanged\) or a list of \(tag content\) where tag may be
-\(tagname attrs\). \(\(a :href \"/\"\) \"home\"\) is formatted as
-you'd expect it to be. For special effects, set the HTML-CONVERTER
-property of a symbol for a tag to a function. It will be called with
-arguments \(TAG ATTRS CONTENT\) and should return a string to be
-interpolated at that point."
- (declare (optimize (speed 3)))
- (macrolet ((attr-printer (attrs)
- `(html-attr ,attrs))
- (call-self (stream things &optional inline-elements)
- `(html ,things ,inline-elements))
- (thing-printer (things)
- `(princ-to-string ,things)))
- (html-body)))))
-
-(defun html5 (things &optional inline-elements)
- (format nil "<!DOCTYPE html>~%~a" (html things inline-elements)))
-
-#||
-(search-html-tree '((string> ht :element) t (= p :element)) '((html) ((body) ((p) "foo") ((p) "bar") ((div :title "titl") "blah"))))
-||#
-
-(defun search-html-tree (search-terms tree)
- (labels ((node-matches (term tree)
- (or (eql term t)
- (destructuring-bind (op content name) term
- (let ((r-op (if (eql op '=) 'equal op)))
- (if (eql name :element)
- (funcall r-op content (caar tree))
- (funcall r-op content (getf (cdar tree) name))))))))
- (cond ((eql (cdr search-terms) nil)
- (and (node-matches (car search-terms) tree) tree))
- ((null tree) nil)
- ((node-matches (car search-terms) tree)
- (remove-if #'null
- (mapcar (lambda (tr)
- (search-html-tree (cdr search-terms) tr))
- (cdr tree)))))))
-
-
-#+parenscript
-(defmacro css-file (request &rest rules)
- "Sends CSS as a file in response to request, as specified by rules.
- For example:
- (defmethod handle-request-response ((handler my-handler) method request)
- (css-file request
- (* :border \"1px solid black\")
- (div.bl0rg :font-family \"serif\")
- ((\"a:active\" \"a:hoover\") :color \"black\" :size \"200%\")))
- See the documentation for Parenscript for more info on the CSS rules themselves."
- `(progn
- (request-send-headers ,request :content-type "text/css")
- ,@(mapcar (lambda (rule)
- `(princ (parenscript::css-rule-to-string (parenscript::css-rule ,@rule)) (request-stream ,request)))
- rules)
- t))
-
-#+parenscript
-(defmacro js-file (request &rest body)
- "Sends Javascript as a file in response to request, as specified by the javascript body.
- For example:
- (defmethod handle-request-response ((handler my-handler) method request)
- (js-file request
- (defun hello ()
- (alert \"Hello, World!\"))))
- See the documentation for Parenscript for more info on how to do Javascript."
- `(progn
- (request-send-headers ,request :content-type "text/javascript")
- (princ (parenscript:js ,@body) (request-stream ,request))
- t))
diff --git a/http/httputils.lisp b/http/httputils.lisp
deleted file mode 100644
index fbd5c36..0000000
--- a/http/httputils.lisp
+++ /dev/null
@@ -1,66 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-(declaim (optimize (speed 0) (safety 3) (debug 3)))
-
-(in-package #:ldapadmin)
-
-(defmacro with-cookie-jar (&rest body)
- `(let ((cookie-jar (make-instance 'drakma:cookie-jar)))
- ,@body))
-
-(defun drakma-request (url
- cookie-jar
- &key
- (method :get)
- (content-type "application/x-www-form-urlencoded")
- (content nil)
- (user-agent :firefox)
- (redirect t)
- (auto-referer t)
- (additional-headers nil)
- (connection-timeout 20)
- (proxy nil)
- (proxy-basic-authorization nil)
- (basic-authorization nil))
- (drakma:http-request url
- :cookie-jar cookie-jar
- :method method
- :content-type content-type
- :content content
- :user-agent user-agent
- :redirect redirect
- :auto-referer auto-referer
- :connection-timeout connection-timeout
- :additional-headers additional-headers
- :proxy proxy
- :proxy-basic-authorization proxy-basic-authorization
- :basic-authorization basic-authorization
- :close t))
-
-(defun escape-url (url)
- (let ((escaped-url url))
- (setf escaped-url (ppcre:regex-replace-all "%" escaped-url "%25"))
- (setf escaped-url (ppcre:regex-replace-all "\\?" escaped-url "%3F"))
- (setf escaped-url (ppcre:regex-replace-all "#" escaped-url "%23"))
- (setf escaped-url (ppcre:regex-replace-all "/" escaped-url "%2F"))
- (setf escaped-url (ppcre:regex-replace-all "'" escaped-url "%27"))
- (setf escaped-url (ppcre:regex-replace-all " " escaped-url "%20"))
- (setf escaped-url (ppcre:regex-replace-all "\\(" escaped-url "%28"))
- (setf escaped-url (ppcre:regex-replace-all "\\)" escaped-url "%29"))
- (setf escaped-url (ppcre:regex-replace-all ":" escaped-url "%3A"))
- escaped-url))
-
-(defun unescape-url (url)
- (let ((unescaped-url url))
- (setf unescaped-url (ppcre:regex-replace-all "%25" unescaped-url "%"))
- (setf unescaped-url (ppcre:regex-replace-all "%3F" unescaped-url "?"))
- (setf unescaped-url (ppcre:regex-replace-all "%23" unescaped-url "#"))
- (setf unescaped-url (ppcre:regex-replace-all "%2F" unescaped-url "/"))
- (setf unescaped-url (ppcre:regex-replace-all "%27" unescaped-url "'"))
- (setf unescaped-url (ppcre:regex-replace-all "%20" unescaped-url " "))
- (setf unescaped-url (ppcre:regex-replace-all "%28" unescaped-url "("))
- (setf unescaped-url (ppcre:regex-replace-all "%29" unescaped-url ")"))
- (setf unescaped-url (ppcre:regex-replace-all "%3A" unescaped-url ":"))
- unescaped-url))
-
-(defun newlines-to-backslash-n (body)
- (cl-ppcre:regex-replace-all #\Newline body "\\\\n"))
diff --git a/json/json-utils.lisp b/json/json-utils.lisp
deleted file mode 100644
index 0e0fa12..0000000
--- a/json/json-utils.lisp
+++ /dev/null
@@ -1,72 +0,0 @@
-;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-(declaim (optimize (speed 0) (safety 3) (debug 3)))
-
-(in-package #:ldapadmin)
-
-(defun json-to-object (object-type json-obj)
- (remove-if-not (lambda (x)
- (let ((found-value nil))
- (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 (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)))))
- object))
- json-obj)))
-
-(defun objects-to-json (list-of-objects &optional (explicit-encoder-p nil))
- (labels ((objectp (object)
- (not (eq () (remove-if 'null (mapcar (lambda (superclass)
- (eq (class-name superclass) 'base-service))
- (sb-mop:class-direct-superclasses (class-of object)))))))
- (list-of-lists-p (object)
- (and (listp object)
- (find-if (lambda (y) (not (null y)))
- (mapcar (lambda (x)
- (listp x))
- object))))
- (list-of-objects-p (object)
- (and (listp object)
- (find-if (lambda (y) (not (null y)))
- (mapcar (lambda (x)
- (objectp x))
- object))))
- (map-slots (object)
- (remove-if 'null (mapcar (lambda (slot)
- (let ((symb (intern (symbol-name slot) :keyword))
- (value (slot-value object slot)))
- (when value
- (cons symb (cond ((or (equal value (json:json-bool t))
- (equal value (json:json-bool nil)))
- value)
- ((list-of-lists-p value)
- (listify value))
- ((list-of-objects-p value)
- (if explicit-encoder-p
- (error "Can't do list-of-objects with the explicit encoder.")
- (listify value)))
- ((listp value)
- (map 'vector #'identity value))
- ((objectp value)
- (if explicit-encoder-p
- (cons :object (map-slots value))
- (map-slots value)))
- (t
- value))))))
- (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)))
- (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)))
- (json:encode-json-alist-to-string alist)))
- listobj)))))
diff --git a/ldapadmin.asd b/ldapadmin.asd
index e0cc91a..20d6303 100644
--- a/ldapadmin.asd
+++ b/ldapadmin.asd
@@ -17,8 +17,8 @@
:depends-on ,(eval depends-on)
:components ,components))
-(defparameter *quicklisp-packages* '(net-telent-date cl-ppcre uffi hunchentoot cl-log ironclad cl-json trivial-ldap))
-(defparameter *asdf-packages* '(org-ckons-core org-ckons-http))
+(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
@@ -36,14 +36,8 @@
(:module condition
:depends-on (core)
:components ((:file "condition")))
- (:module file
- :depends-on (condition)
- :components ((:file "file-utils")))
- (:module json
- :depends-on (condition)
- :components ((:file "json-utils")))
(:module ldap
- :depends-on (json)
+ :depends-on (condition)
:components ((:file "generics")
(:file "ldap" :depends-on ("generics"))))
(:module entity
diff --git a/service/auth-service.lisp b/service/auth-service.lisp
index 24556b7..e6f3ef4 100644
--- a/service/auth-service.lisp
+++ b/service/auth-service.lisp
@@ -16,4 +16,4 @@
`(let ((,instance (make-instance ',auth-service)))
(when (null (errormsg ,instance))
,@body)
- (objects-to-json `(,,instance))))
+ (org-ckons-json::objects-to-json `(,,instance))))
diff --git a/service/home-service.lisp b/service/home-service.lisp
index fd96b36..2685264 100644
--- a/service/home-service.lisp
+++ b/service/home-service.lisp
@@ -13,6 +13,6 @@
(setf (content home-service) (format nil "Welcome to the ~a website" (title *webapp*))))
(defun home-json (&optional message errormsg)
- (objects-to-json `(,(make-instance 'home-service
- :message message
- :errormsg errormsg))))
+ (org-ckons-json::objects-to-json `(,(make-instance 'home-service
+ :message message
+ :errormsg errormsg))))
diff --git a/service/login-service.lisp b/service/login-service.lisp
index 7007327..10e0722 100644
--- a/service/login-service.lisp
+++ b/service/login-service.lisp
@@ -22,7 +22,7 @@
(:label "Login" :field-type "button" :onclick "on_login_submit_clicked()")))))
(defun login-json ()
- (objects-to-json `(,(make-instance 'login-service))))
+ (org-ckons-json::objects-to-json `(,(make-instance 'login-service))))
(defclass login-authenticate-service (rest-service)
((location-p :initarg :location-p
@@ -40,4 +40,4 @@
(when (check-ldap-password (ldap *webapp*) dn password)
(setf (session-value :permissions) "admin")
(setf auth-result t))
- (objects-to-json `(,(make-instance 'login-authenticate-service :auth-result auth-result)))))
+ (org-ckons-json::objects-to-json `(,(make-instance 'login-authenticate-service :auth-result auth-result)))))
diff --git a/service/logout-service.lisp b/service/logout-service.lisp
index afc3ace..10f469f 100644
--- a/service/logout-service.lisp
+++ b/service/logout-service.lisp
@@ -15,4 +15,4 @@
(defun logout-json ()
(setf (session-value :permissions) nil)
- (objects-to-json `(,(make-instance 'logout-service))))
+ (org-ckons-json::objects-to-json `(,(make-instance 'logout-service))))
diff --git a/service/menu-service.lisp b/service/menu-service.lisp
index 8ee9c25..8ea0515 100644
--- a/service/menu-service.lisp
+++ b/service/menu-service.lisp
@@ -52,4 +52,4 @@
*menu-config*)))))
(defun menu-json ()
- (objects-to-json `(,(make-instance 'menu-service))))
+ (org-ckons-json::objects-to-json `(,(make-instance 'menu-service))))