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"
|
:version "0.0.1"
|
||||||
:homepage "https://www.cyberconcepts.org"
|
:homepage "https://www.cyberconcepts.org"
|
||||||
:description "Web client and server functionality."
|
: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)
|
:scopes-core)
|
||||||
:components ((:file "web/client")
|
:components ((:file "web/client")
|
||||||
(:file "web/server"))
|
(:file "web/server"))
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
(defpackage :scopes/web/server
|
(defpackage :scopes/web/server
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:config :scopes/config)
|
(:local-nicknames (:config :scopes/config)
|
||||||
(:core :scopes/core))
|
(:core :scopes/core)
|
||||||
|
(:alx :alexandria))
|
||||||
(:export #:config #:address #:port #:routes
|
(:export #:config #:address #:port #:routes
|
||||||
#:*listener* #:setup #:start #:stop
|
#:*listener* #:setup #:start #:stop
|
||||||
#:fileserver #:message-handler))
|
#:fileserver #:message-handler))
|
||||||
|
@ -44,8 +45,8 @@
|
||||||
(defun message-handler (ctx env)
|
(defun message-handler (ctx env)
|
||||||
;(print env)
|
;(print env)
|
||||||
;(print (read-line (getf env :raw-body)))
|
;(print (read-line (getf env :raw-body)))
|
||||||
(let ((head (getf env :message-head))
|
(let ((head (head env))
|
||||||
(data (read-line (getf env :raw-body))))
|
(data (data env)))
|
||||||
(format t "~&message head ~s, data ~s~%" head data)
|
(format t "~&message head ~s, data ~s~%" head data)
|
||||||
'(200 (:content-type "text/plain") ("Hello World!"))))
|
'(200 (:content-type "text/plain") ("Hello World!"))))
|
||||||
|
|
||||||
|
@ -75,3 +76,17 @@
|
||||||
(let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
|
(let ((ctx (make-instance 'context :config cfg :name (config:name cfg))))
|
||||||
(start ctx)
|
(start ctx)
|
||||||
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