work in progress: render login form
This commit is contained in:
parent
fb33a65d54
commit
e7178b20d9
7 changed files with 17 additions and 14 deletions
|
@ -19,3 +19,4 @@
|
||||||
,(util:path-from-string (config:from-env :docroot "/var/www/html/")))))
|
,(util:path-from-string (config:from-env :docroot "/var/www/html/")))))
|
||||||
(config:add-action '(:test :data) #'core:echo)
|
(config:add-action '(:test :data) #'core:echo)
|
||||||
(config:add-action '(:auth :login) #'core:echo)
|
(config:add-action '(:auth :login) #'core:echo)
|
||||||
|
(config:add-action '(:auth :show :form :login) #'auth:login-form)
|
||||||
|
|
|
@ -2,7 +2,8 @@
|
||||||
|
|
||||||
(defpackage :scopes/app/demo
|
(defpackage :scopes/app/demo
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:local-nicknames (:config :scopes/config)
|
(:local-nicknames (:auth :scopes-auth/web)
|
||||||
|
(:config :scopes/config)
|
||||||
(:cs-hx :scopes/frontend/cs-hx)
|
(:cs-hx :scopes/frontend/cs-hx)
|
||||||
(:core :scopes/core)
|
(:core :scopes/core)
|
||||||
(:forge :scopes/forge)
|
(:forge :scopes/forge)
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
:version "0.0.1"
|
:version "0.0.1"
|
||||||
:homepage "https://www.cyberconcepts.org"
|
:homepage "https://www.cyberconcepts.org"
|
||||||
:description ""
|
:description ""
|
||||||
:depends-on (:scopes)
|
:depends-on (:scopes :scopes-auth)
|
||||||
:components ((:file "main"))
|
:components ((:file "main"))
|
||||||
:build-operation "program-op"
|
:build-operation "program-op"
|
||||||
:build-pathname "bin/demo"
|
:build-pathname "bin/demo"
|
||||||
|
|
|
@ -59,12 +59,6 @@
|
||||||
|
|
||||||
(defvar *root* nil)
|
(defvar *root* nil)
|
||||||
|
|
||||||
;;; check / fix:
|
|
||||||
(defvar *quit-queue* (lpq:make-queue :fixed-capacity 1))
|
|
||||||
(defun quit-handler (sig)
|
|
||||||
(format t "~%quit-handler: got signal ~s~%" sig)
|
|
||||||
(lpq:push-queue sig *quit-queue*))
|
|
||||||
|
|
||||||
(defclass base-context ()
|
(defclass base-context ()
|
||||||
((actions :accessor actions :initform nil)))
|
((actions :accessor actions :initform nil)))
|
||||||
|
|
||||||
|
@ -104,7 +98,6 @@
|
||||||
|
|
||||||
(defun setup-services (&optional (cfg config:*root*))
|
(defun setup-services (&optional (cfg config:*root*))
|
||||||
(setf *root* (make-instance 'root-service :config cfg))
|
(setf *root* (make-instance 'root-service :config cfg))
|
||||||
;(setf (trivial-signal:signal-handler :int) #'quit-handler)
|
|
||||||
(dolist (c (reverse (config:children cfg)))
|
(dolist (c (reverse (config:children cfg)))
|
||||||
(add-service *root* c)))
|
(add-service *root* c)))
|
||||||
|
|
||||||
|
|
|
@ -6,13 +6,20 @@
|
||||||
(:config :scopes/config)
|
(:config :scopes/config)
|
||||||
(:core :scopes/core)
|
(:core :scopes/core)
|
||||||
(:jwt :scopes/web/jwt)
|
(:jwt :scopes/web/jwt)
|
||||||
|
(:message :scopes/core/message)
|
||||||
(:server :scopes/web/server)
|
(:server :scopes/web/server)
|
||||||
(:shape :scopes/shape)
|
(:shape :scopes/shape)
|
||||||
(:util :scopes/util))
|
(:util :scopes/util))
|
||||||
(:export #:login))
|
(:export #:login #:login-form))
|
||||||
|
|
||||||
(in-package :scopes-auth/web)
|
(in-package :scopes-auth/web)
|
||||||
|
|
||||||
|
(defun login-form (ctx msg)
|
||||||
|
(let ((msg (message:create '(:html :render :form :login)
|
||||||
|
:data '(:fields (:login :password) :button "Login")
|
||||||
|
:sender (message:sender msg))))
|
||||||
|
(core:echo ctx msg)))
|
||||||
|
|
||||||
(defun login (ctx msg)
|
(defun login (ctx msg)
|
||||||
(let* ((prc (auth:login (shape:data msg))))
|
(let* ((prc (auth:login (shape:data msg))))
|
||||||
;(jwt:create ...)
|
;(jwt:create ...)
|
||||||
|
|
|
@ -8,7 +8,7 @@
|
||||||
:description "Core packages of the scopes project."
|
:description "Core packages of the scopes project."
|
||||||
:depends-on (:alexandria :cl-dotenv :com.inuoe.jzon
|
:depends-on (:alexandria :cl-dotenv :com.inuoe.jzon
|
||||||
:flexi-streams :ironclad :local-time :log4cl
|
:flexi-streams :ironclad :local-time :log4cl
|
||||||
:lparallel :qbase64 :serapeum :str :trivial-signal)
|
:lparallel :qbase64 :serapeum :str)
|
||||||
:components ((:file "config" :depends-on ("util/util"))
|
:components ((:file "config" :depends-on ("util/util"))
|
||||||
(:file "core/core"
|
(:file "core/core"
|
||||||
:depends-on ("core/message" "config"
|
:depends-on ("core/message" "config"
|
||||||
|
|
|
@ -53,6 +53,7 @@
|
||||||
:address (address cfg)
|
:address (address cfg)
|
||||||
;:server :woo
|
;:server :woo
|
||||||
:debug nil
|
:debug nil
|
||||||
|
:use-default-middleware nil
|
||||||
:silent t))
|
:silent t))
|
||||||
(util:lgi (port cfg))
|
(util:lgi (port cfg))
|
||||||
ctx))
|
ctx))
|
||||||
|
@ -71,9 +72,9 @@
|
||||||
#'(lambda () (message-handler ctx env)))
|
#'(lambda () (message-handler ctx env)))
|
||||||
|
|
||||||
(defun match (pattern path)
|
(defun match (pattern path)
|
||||||
(dolist (e pattern)
|
(dolist (e pattern)
|
||||||
(unless (string= e (pop path))
|
(unless (string= e (pop path))
|
||||||
(return-from match nil)))
|
(return-from match nil)))
|
||||||
t)
|
t)
|
||||||
|
|
||||||
(defun fileserver (ctx env &key doc-root)
|
(defun fileserver (ctx env &key doc-root)
|
||||||
|
|
Loading…
Add table
Reference in a new issue