move code for keeping services running to scopes/core

This commit is contained in:
Helmut Merz 2025-02-14 15:21:11 +01:00
parent 7a838af162
commit 7628cd7e49
5 changed files with 23 additions and 22 deletions

View file

@ -13,23 +13,8 @@
(in-package :scopes/app/demo) (in-package :scopes/app/demo)
(defvar *quit-queue* (lparallel.queue:make-queue :fixed-capacity 1))
(defun main() (defun main()
;(setf (trivial-signal:signal-handler :int) #'quit-handler)
;(setf (trivial-signal:signal-handler :term) #'quit-handler)
(let ((config-path (util:relative-path "config" "etc"))) (let ((config-path (util:relative-path "config" "etc")))
(format t "~%Hello World.~%config-path: ~s~%" config-path) (format t "~%Hello World.~%config-path: ~s~%" config-path)
(load config-path)) (load config-path))
(unwind-protect (core:run-services))
(progn
(core:setup-services)
;(setf forge:*forge-env* (forge:forge-env))
;(forge:setup-builtins)
;(forge:repl)
(lparallel.queue:pop-queue *quit-queue*))
(core:shutdown)))
(defun quit-handler (sig)
(format t "~%quit-handler: got signal ~s~%" sig)
(lparallel.queue:push-queue sig))

View file

@ -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 :lparallel :trivial-signal) :depends-on (:scopes)
:components ((:file "main")) :components ((:file "main"))
:build-operation "program-op" :build-operation "program-op"
:build-pathname "bin/demo" :build-pathname "bin/demo"

View file

@ -9,8 +9,8 @@
(:alx :alexandria)) (:alx :alexandria))
(:export #:action-spec #:define-actions (:export #:action-spec #:define-actions
#:*root* #:default-setup #:default-actions #:*root* #:default-setup #:default-actions
#:find-service #:setup-services #:find-service #:run-services #:setup-services #:shutdown
#:base-context #:context #:add-action #:config #:name #:send #:shutdown #:base-context #:context #:add-action #:config #:name #:send
#:handle-message #:handle-message
#:do-print #:echo)) #:do-print #:echo))
@ -52,10 +52,15 @@
(if (equal (pattern a) pat) (if (equal (pattern a) pat)
(return-from find-action a)))) (return-from find-action a))))
;;;; context ;;;; context, services
(defvar *root* nil) (defvar *root* nil)
(defvar *quit-queue* (lparallel.queue:make-queue :fixed-capacity 1))
(defun quit-handler (sig)
(format t "~%quit-handler: got signal ~s~%" sig)
(lparallel.queue:push-queue sig))
(defclass base-context () (defclass base-context ()
((actions :accessor actions :initform nil) ((actions :accessor actions :initform nil)
(default-actions :reader default-actions :initform nil))) (default-actions :reader default-actions :initform nil)))
@ -75,6 +80,8 @@
(defun setup-services (&optional (cfg config:*root*)) (defun setup-services (&optional (cfg config:*root*))
(setf *root* (make-instance 'context :config cfg)) (setf *root* (make-instance 'context :config cfg))
;(setf (trivial-signal:signal-handler :int) #'quit-handler)
;(setf (trivial-signal:signal-handler :term) #'quit-handler)
(dolist (c (reverse (config:children cfg))) (dolist (c (reverse (config:children cfg)))
(add-service *root* c))) (add-service *root* c)))
@ -82,6 +89,13 @@
(dolist (ctx (alx:hash-table-values (services *root*))) (dolist (ctx (alx:hash-table-values (services *root*)))
(funcall (config:shutdown (config ctx)) ctx))) (funcall (config:shutdown (config ctx)) ctx)))
(defun run-services (&optional (cfg config:*root*))
(unwind-protect
(progn
(setup-services cfg)
(lparallel.queue:pop-queue *quit-queue*))
(shutdown)))
(defun add-action (ctx pat hdlr) (defun add-action (ctx pat hdlr)
(let* ((acts (actions ctx)) (let* ((acts (actions ctx))
(act (find-action pat acts))) (act (find-action pat acts)))

View file

@ -7,7 +7,8 @@
:homepage "https://www.cyberconcepts.org" :homepage "https://www.cyberconcepts.org"
: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 :qbase64 :str) :flexi-streams :ironclad :local-time :log4cl
:lparallel :qbase64 :str :trivial-signal)
: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"

View file

@ -59,7 +59,8 @@
ctx)) ctx))
(defun stop (ctx) (defun stop (ctx)
(clack:stop (listener ctx))) (clack:stop (listener ctx))
(util:lgi))
(defun select-app (ctx env) (defun select-app (ctx env)
(let ((path (cdr (str:split "/" (getf env :path-info))))) (let ((path (cdr (str:split "/" (getf env :path-info)))))