diff options
| -rw-r--r-- | file/file-utils.lisp | 110 | ||||
| -rw-r--r-- | http/html.lisp | 324 | ||||
| -rw-r--r-- | http/httputils.lisp | 66 | ||||
| -rw-r--r-- | json/json-utils.lisp | 72 | ||||
| -rw-r--r-- | ldapadmin.asd | 12 | ||||
| -rw-r--r-- | service/auth-service.lisp | 2 | ||||
| -rw-r--r-- | service/home-service.lisp | 6 | ||||
| -rw-r--r-- | service/login-service.lisp | 4 | ||||
| -rw-r--r-- | service/logout-service.lisp | 2 | ||||
| -rw-r--r-- | service/menu-service.lisp | 2 |
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)))) |