From ce9ea72d1cb0fcf7d6504f84d6e44a6a049072f1 Mon Sep 17 00:00:00 2001 From: Bruno Dias Date: Sat, 9 Nov 2024 09:07:36 -0300 Subject: [PATCH] session, cookies, woo... --- cookies/package.lisp | 14 ++++++++++++++ routing/responses.lisp | 29 +++++++++++++++-------------- routing/routes.lisp | 2 +- routing/types.lisp | 4 ++-- session/package.lisp | 29 +++++++++++++++++++++++++++++ web-server/session-csrf.lisp | 14 ++++++++++++++ {routing => web-server}/woo.lisp | 0 wst.cookies.asd | 4 ++++ wst.routing.woo.asd | 5 ----- wst.session.asd | 4 ++++ wst.web-server.session-csrf.asd | 4 ++++ wst.web-server.woo.asd | 4 ++++ 12 files changed, 91 insertions(+), 22 deletions(-) create mode 100644 cookies/package.lisp create mode 100644 session/package.lisp create mode 100644 web-server/session-csrf.lisp rename {routing => web-server}/woo.lisp (100%) create mode 100644 wst.cookies.asd delete mode 100644 wst.routing.woo.asd create mode 100644 wst.session.asd create mode 100644 wst.web-server.session-csrf.asd create mode 100644 wst.web-server.woo.asd diff --git a/cookies/package.lisp b/cookies/package.lisp new file mode 100644 index 0000000..3d38841 --- /dev/null +++ b/cookies/package.lisp @@ -0,0 +1,14 @@ +(defpackage #:wst.cookies + (:use #:cl) + (:export + #:initialize-session + #:recover-session + #:terminate-session + #:update-session)) + +(in-package :wst.cookies) + +(defgeneric initialize-session (driver data &key &allow-other-keys)) +(defgeneric recover-session (driver session-id &key &allow-other-keys)) +(defgeneric terminate-session (driver session &key &allow-other-keys)) +(defgeneric update-session (driver session &key &allow-other-keys)) diff --git a/routing/responses.lisp b/routing/responses.lisp index 2084b7c..6ca6e84 100644 --- a/routing/responses.lisp +++ b/routing/responses.lisp @@ -1,16 +1,16 @@ (in-package :wst.routing) (defun write-response (response - &key - content - status - headers - (content-type "text/html")) + &key + content + status + headers + (content-type "text/html")) (setf (response-status response) status - (response-headers response) (append (response-headers response) - (list :content-type content-type) - headers) - (response-content response) content) + (response-headers response) (append (response-headers response) + (list :content-type content-type) + headers) + (response-content response) content) response) (defun default-internal-server-error-resounse (response) @@ -22,12 +22,13 @@ (:method ((ty t) response &key headers content) (write-response response :status 200 :headers headers :content content))) -(defgeneric internal-server-error-response (ty response &key headers) +(defgeneric internal-server-error-response (ty response &key headers content) (:documentation "Build a response for a type TY (:json, :html, t = html). CONTENT is any object that is serialized accourding to the type.") - (:method ((ty t) response &key headers) - (declare (ignorable headers)) - (default-internal-server-error-resounse response))) + (:method ((ty t) response &key headers content) + (if content + (write-response response :status 500 :content content :headers headers) + (default-internal-server-error-resounse response)))) (defgeneric not-found-response (ty response &key) (:documentation "Build a response for a type TY (:json, :html, t = html). @@ -58,7 +59,7 @@ CONTENT is any object that is serialized accourding to the type.") (:method ((ty t) response location &key) (write-response response :status 303 :content "see-other" - :headers (list :location location)))) + :headers (list :location location)))) (defgeneric unprocessable-entity (ty response &key) (:documentation "Build a response for a type TY (:json, :html, t = html). diff --git a/routing/routes.lisp b/routing/routes.lisp index 80d2949..9c941d3 100644 --- a/routing/routes.lisp +++ b/routing/routes.lisp @@ -99,7 +99,7 @@ (setf (gethash key cookies) value) cookies)) (cl-ppcre:split ";\\s?" cookies) - :initial-value (make-hash-table))) + :initial-value (make-hash-table :test 'equal))) (declaim (ftype (function (hash-table request response) t) parse-cookies)) diff --git a/routing/types.lisp b/routing/types.lisp index 4f30016..1ae886f 100644 --- a/routing/types.lisp +++ b/routing/types.lisp @@ -26,7 +26,7 @@ (let ((ref (gensym "DATA"))) `(let* ((,ref (request-data ,request)) ,@(mapcar (lambda (item) - (list (intern (string-upcase (string item))) + (list item `(getf ,ref ,(intern (string item) :keyword)))) keys)) ,@body))) @@ -35,7 +35,7 @@ (let ((ref (gensym "DATA"))) `(let* ((,ref (response-data ,response)) ,@(mapcar (lambda (item) - (list (intern (string-upcase (string item))) + (list item `(getf ,ref ,(intern (string item) :keyword)))) keys)) ,@body))) diff --git a/session/package.lisp b/session/package.lisp new file mode 100644 index 0000000..b84badb --- /dev/null +++ b/session/package.lisp @@ -0,0 +1,29 @@ +(defpackage #:wst.session + (:use #:cl) + (:export + #:create-session + #:recover-session + #:update-session + #:session-exists-p + #:renew-session + #:terminate-session)) + +(in-package :wst.session) + +(defgeneric create-session (object data &key &allow-other-keys) + (:documentation "Creates a new session for a user, returning a unique session ID.")) + +(defgeneric recover-session (object session-id &key &allow-other-keys) + (:documentation "Retrieves the session data for the given session ID, or NIL if expired or non-existent.")) + +(defgeneric update-session (object session &key &allow-other-keys) + (:documentation "Updates the SESSION for the given session ID.")) + +(defgeneric session-exists-p (object session-id &key &allow-other-keys) + (:documentation "Returns T if the session exists and is active, NIL otherwise.")) + +(defgeneric renew-session (object session-id &optional additional-time &key &allow-other-keys) + (:documentation "Renews the session by extending its expiry time.")) + +(defgeneric terminate-session (object session-id &key &allow-other-keys) + (:documentation "Destroys the session with the given session ID.")) diff --git a/web-server/session-csrf.lisp b/web-server/session-csrf.lisp new file mode 100644 index 0000000..6b319df --- /dev/null +++ b/web-server/session-csrf.lisp @@ -0,0 +1,14 @@ +(defpackage #:wst.web-server.session-csrf + (:use #:cl) + (:export + #:session-csrf-token + #:add-session-csrf-token + #:remove-session-csrf-token + #:verify-session-csrf-token)) + +(in-package :wst.web-server.session-csrf) + +(defgeneric session-csrf-token (obj &key &allow-other-keys)) +(defgeneric add-session-csrf-token (obj key &key &allow-other-keys)) +(defgeneric remove-session-csrf-token (obj &key &allow-other-keys)) +(defgeneric verify-session-csrf-token (obj key &key &allow-other-keys)) diff --git a/routing/woo.lisp b/web-server/woo.lisp similarity index 100% rename from routing/woo.lisp rename to web-server/woo.lisp diff --git a/wst.cookies.asd b/wst.cookies.asd new file mode 100644 index 0000000..6f676f7 --- /dev/null +++ b/wst.cookies.asd @@ -0,0 +1,4 @@ +(asdf:defsystem #:wst.cookies + :pathname "cookies" + :serial t + :components ((:file "package"))) diff --git a/wst.routing.woo.asd b/wst.routing.woo.asd deleted file mode 100644 index d425876..0000000 --- a/wst.routing.woo.asd +++ /dev/null @@ -1,5 +0,0 @@ -(asdf:defsystem #:wst.routing.woo - :depends-on (#:wst.routing) - :pathname "routing" - :serial t - :components ((:file "woo"))) diff --git a/wst.session.asd b/wst.session.asd new file mode 100644 index 0000000..425275f --- /dev/null +++ b/wst.session.asd @@ -0,0 +1,4 @@ +(asdf:defsystem #:wst.session + :pathname "session" + :serial t + :components ((:file "package"))) diff --git a/wst.web-server.session-csrf.asd b/wst.web-server.session-csrf.asd new file mode 100644 index 0000000..73457be --- /dev/null +++ b/wst.web-server.session-csrf.asd @@ -0,0 +1,4 @@ +(asdf:defsystem #:wst.web-server.session-csrf + :pathname "web-server" + :serial t + :components ((:file "session-csrf"))) diff --git a/wst.web-server.woo.asd b/wst.web-server.woo.asd new file mode 100644 index 0000000..159d825 --- /dev/null +++ b/wst.web-server.woo.asd @@ -0,0 +1,4 @@ +(asdf:defsystem #:wst.web-server.woo + :pathname "web-server" + :serial t + :components ((:file "woo")))