From 9377ab116a1a12fdcb90df0bd236aa27a8267332 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Thu, 29 Aug 2024 21:57:24 +0200 Subject: [PATCH] web/response, work in progress: more on response message processing by interaction --- core/core.lisp | 4 +++- shape/shape.lisp | 2 +- util/util.lisp | 13 +++++++------ web/response.lisp | 29 +++++++++++++++++------------ web/server.lisp | 6 +++--- 5 files changed, 31 insertions(+), 23 deletions(-) diff --git a/core/core.lisp b/core/core.lisp index b5c8dd5..aaff20b 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -46,6 +46,8 @@ (defvar *root* nil) +(defclass base-context ()) + (defclass context () ((config :reader config :initarg :config) (name :reader name :initarg :name) @@ -95,7 +97,7 @@ (cond ((do-actions ctx msg) t) ((do-actions ctx msg #'default-actions) t) - (t (log:warn "no action selected for ~s" msg))))) + (t (log:warn "handle-message: no action selected for ~s" msg))))) (defun do-actions (ctx msg &optional (acts #'actions)) (let ((hdlrs (select msg (funcall acts ctx)))) diff --git a/shape/shape.lisp b/shape/shape.lisp index f1c7b8c..bbda9d5 100644 --- a/shape/shape.lisp +++ b/shape/shape.lisp @@ -24,7 +24,7 @@ (print-fields rec stream 'head 'data)) (defun print-fields (rec stream &rest fields) - (let ((fm (util:make-vars-format fields))) + (let ((fm (util:make-vars-format fields nil))) (print-unreadable-object (rec stream :type t) (apply #'format stream fm (mapcar #'(lambda (x) (funcall x rec)) fields))))) diff --git a/util/util.lisp b/util/util.lisp index 0df9da9..a8b4bc6 100644 --- a/util/util.lisp +++ b/util/util.lisp @@ -17,16 +17,17 @@ ;;;; formatting and logging shortcuts -(defun make-vars-format (vars) - (format nil "~{~(~a~): ~~S ~}" vars)) +(defun make-vars-format (vars info) + (let ((prefix (if info (format nil "~a: " info) ""))) + (format nil "~a~{~(~a~): ~~S ~}" prefix vars))) -(defmacro lg (level &rest vars) +(defmacro lg (level info &rest vars) (let ((lm (find-symbol (string level) :log)) - (fm (make-vars-format vars))) + (fm (make-vars-format vars info))) `(,lm ,fm ,@vars))) -(defmacro lgd (&rest vars) `(lg :debug ,@vars)) -(defmacro lgi (&rest vars) `(lg :info ,@vars)) +(defmacro lgd (&rest vars) `(lg :debug nil ,@vars)) +(defmacro lgi (&rest vars) `(lg :info nil ,@vars)) ;;;; date and time manipulations diff --git a/web/response.lisp b/web/response.lisp index 4fd5d1a..8128e01 100644 --- a/web/response.lisp +++ b/web/response.lisp @@ -15,15 +15,27 @@ ;;;; server interaction - receive response message from action processing chain (defclass interaction () - ((messages :accessor messages :initform nil))) + ((response :reader response :initarg :response) + (messages :accessor messages :initform nil))) (defmethod print-object ((ia interaction) s) (shape:print-fields ia s 'messages)) (defmethod core:send ((ia interaction) msg) (util:lgd msg) + ;(handle-message ia msg) (push msg (messages ia))) +(defun add-cookies (iact) + (let ((headers (resp (response iact)))) + (dolist (cdata (cookie-data iact)) + (setf headers + (cons :set-cookie (cons (render-cookie iact cdata) headers)))) + headers)) + +(defun render-cookie (iact cdata) + "DEMO=1234567; Path=/; Domain=testing.cyberscopes.org") + (defun cookie-data (ia) (let ((c nil)) c)) @@ -35,7 +47,7 @@ (defclass response () ((context :reader context :initarg :context) (env :reader env :initarg :env) - (bakers :accessor bakers :initform nil) + (headers :accessor headers :initform nil) (ctype :reader ctype :allocation :class))) (defgeneric render-content (resp msg)) @@ -72,18 +84,14 @@ (defun html-response-class (html-responder) (or html-responder *html-response-class* 'html-response)) -(defun make-headers (resp iact) - (let ((headers (list :content-type (ctype resp)))) - (dolist (cdata (cookie-data iact)) - (setf headers - (cons :set-cookie (cons (render-cookie resp cdata) headers)))) - headers)) +(defun make-headers (resp) + (cons :content-type (cons (ctype resp) (headers resp)))) (defun render (resp iact) ; pre-process special message heads, e.g. (:system :error ...) ; => set status code, provide additional data elements ; set additional headers - (let ((headers (make-headers resp iact)) + (let ((headers (make-headers resp)) (rcode 200)) #'(lambda (responder) (let ((writer (funcall responder (list rcode headers)))) @@ -93,6 +101,3 @@ (defun render-not-found(resp) (list 404 '(:content-type "text/plain") '("Not found"))) - -(defun render-cookie (resp cdata) - "DEMO=1234567; Path=/; Domain=testing.cyberscopes.org") diff --git a/web/server.lisp b/web/server.lisp index 36b27f2..3cc4eef 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -86,10 +86,10 @@ (lack/component:call file-app env)))) (defun message-handler (ctx env &key html-responder) - (let* ((iact (make-instance 'response:interaction)) + (let* ((resp (response:setup ctx env :html-responder html-responder)) + (iact (make-instance 'response:interaction :response resp)) (msg (message:create - (head env) :data (plist (post-data env)) :sender iact)) - (resp (response:setup ctx env :html-responder html-responder))) + (head env) :data (plist (post-data env)) :sender iact))) (util:lgd msg) ; (check-auth ctx msg env) => (response:render-unauthorized resp) (if (core:handle-message ctx msg)