web/server: convert message head and data to canonical form (keyword keys, property lists)
This commit is contained in:
parent
288563d373
commit
1baa728234
2 changed files with 19 additions and 4 deletions
|
@ -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"))
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Reference in a new issue