From 5da800de403b41db184e7f1cfe6622d966523adf Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Fri, 14 Oct 2022 15:33:13 -0500 Subject: Fix: added features to get set-cookie to work properly --- lazybones-hunchentoot.lisp | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/lazybones-hunchentoot.lisp b/lazybones-hunchentoot.lisp index 6525846..2ed078c 100644 --- a/lazybones-hunchentoot.lisp +++ b/lazybones-hunchentoot.lisp @@ -43,7 +43,7 @@ :initform nil :documentation "an alist of (CODE CONTENT-FUNCTION CONTENT-TYPE)") (domain - :accessor server-domain + :accessor domain :initarg :domain :initform nil :documentation "A specific domain to associate with this server @@ -89,11 +89,14 @@ ;;; SERVER FUNCTIONS -(defun create-server (&key (port 8888) (address "127.0.0.1") ) +(defun create-server (&key (port 8888) (address "127.0.0.1") (domain "localhost")) "Creates an opaque server on port PORT, and returns it. Servers are backend specific, but each may be passed in to INSTALL-APP, UNINSTALL-APP, START-SERVER, and STOP-SERVER." - (let ((server (make-instance 'lazybones-acceptor :port port :address address))) + (let ((server (make-instance 'lazybones-acceptor + :port port + :address address + :domain domain))) (set-canned-response server 404 "Not Found" "text/plain") (set-canned-response server 500 "Server Error" "text/plain") server)) @@ -106,7 +109,7 @@ UNINSTALL-APP, START-SERVER, and STOP-SERVER." (defun install-app (server app) "Installs a LAZYBONES:APP instance to SERVER, first checking that -the app exists. If app is already isntalled, does nothing." +the app exists. If app is already installed, does nothing." (a:if-let (app (and app (if (symbolp app) (lzb:app app) app))) (pushnew app (acceptor-apps server) :key 'lzb::app-name) (error () "No app to install."))) @@ -130,6 +133,9 @@ RESPONSE-SOURCE can also be a pathname to a file to serve." "Set a new canned response for the code CODE." (push (list code content-source content-type) (canned-responses server))) +(defun server-domain (&optional (server %server%)) + (domain server)) + ;;; HTTP REQUEST FUNCTIONS (defun request-path (&optional (request lzb:*request* )) @@ -270,7 +276,7 @@ the value of the Content-Type request header." (when path (list :path path)) (cond (domain (list :domain domain)) - (server-domain (list :domain (server-domain)))) + ((server-domain) (list :domain (server-domain)))) (when secure (list :secure secure)) (when http-only (list :http-only http-only))))) -- cgit v1.2.3