diff --git a/scopes-web.asd b/scopes-web.asd index 9090d1b..9f66847 100644 --- a/scopes-web.asd +++ b/scopes-web.asd @@ -6,7 +6,7 @@ :version "0.0.1" :homepage "https://www.cyberconcepts.org" :description "Web client and server functionality." - :depends-on (:clack :dexador :lack :lack-component :lack-app-file + :depends-on (:clack :dexador :lack :lack-component :lack-app-file :quri :scopes-core) :components ((:file "web/client") (:file "web/server")) diff --git a/web/server.lisp b/web/server.lisp index edad529..cca9ff4 100644 --- a/web/server.lisp +++ b/web/server.lisp @@ -3,7 +3,8 @@ (defpackage :scopes/web/server (:use :common-lisp) (:local-nicknames (:config :scopes/config) - (:core :scopes/core)) + (:core :scopes/core) + (:alx :alexandria)) (:export #:config #:address #:port #:routes #:*listener* #:setup #:start #:stop #:fileserver #:message-handler)) @@ -44,8 +45,8 @@ (defun message-handler (ctx env) ;(print env) ;(print (read-line (getf env :raw-body))) - (let ((head (getf env :message-head)) - (data (read-line (getf env :raw-body)))) + (let ((head (head env)) + (data (data env))) (format t "~&message head ~s, data ~s~%" head data) '(200 (:content-type "text/plain") ("Hello World!")))) @@ -75,3 +76,17 @@ (let ((ctx (make-instance 'context :config cfg :name (config:name cfg)))) (start ctx) ctx)) + +;;;; helper functions + +(defun as-keyword (s) + (intern (string-upcase s) :keyword)) + +(defun head (env) + (let ((head (getf env :message-head))) + (mapcar #'(lambda (e) (as-keyword e)) head))) + +(defun data (env) + (let* ((a1 (quri.decode:url-decode-params (read-line (getf env :raw-body)))) + (a2 (mapcar #'(lambda (p) (cons (as-keyword (car p)) (cdr p))) a1))) + (alx:alist-plist a2)))