From 7628cd7e4947bb20714d9e71bf99f63033e22f4a Mon Sep 17 00:00:00 2001
From: Helmut Merz <helmutm@cy55.de>
Date: Fri, 14 Feb 2025 15:21:11 +0100
Subject: [PATCH] move code for keeping services running to scopes/core

---
 app/demo/main.lisp       | 17 +----------------
 app/demo/scopes-demo.asd |  2 +-
 core/core.lisp           | 20 +++++++++++++++++---
 scopes-core.asd          |  3 ++-
 web/server.lisp          |  3 ++-
 5 files changed, 23 insertions(+), 22 deletions(-)

diff --git a/app/demo/main.lisp b/app/demo/main.lisp
index 75757b4..b202714 100644
--- a/app/demo/main.lisp
+++ b/app/demo/main.lisp
@@ -13,23 +13,8 @@
 
 (in-package :scopes/app/demo)
 
-(defvar *quit-queue* (lparallel.queue:make-queue :fixed-capacity 1))
-
 (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")))
     (format t "~%Hello World.~%config-path: ~s~%" config-path)
     (load config-path))
-  (unwind-protect 
-    (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))
+  (core:run-services))
diff --git a/app/demo/scopes-demo.asd b/app/demo/scopes-demo.asd
index e5d5206..664916b 100644
--- a/app/demo/scopes-demo.asd
+++ b/app/demo/scopes-demo.asd
@@ -6,7 +6,7 @@
   :version "0.0.1"
   :homepage "https://www.cyberconcepts.org"
   :description ""
-  :depends-on (:scopes :lparallel :trivial-signal)
+  :depends-on (:scopes)
   :components ((:file "main"))
   :build-operation "program-op"
   :build-pathname "bin/demo"
diff --git a/core/core.lisp b/core/core.lisp
index a57a1ba..d689225 100644
--- a/core/core.lisp
+++ b/core/core.lisp
@@ -9,8 +9,8 @@
                     (:alx :alexandria))
   (:export #:action-spec #:define-actions
            #:*root* #:default-setup #:default-actions 
-           #:find-service #:setup-services
-           #:base-context #:context #:add-action #:config #:name #:send #:shutdown
+           #:find-service #:run-services #:setup-services #:shutdown
+           #:base-context #:context #:add-action #:config #:name #:send
            #:handle-message
            #:do-print #:echo))
 
@@ -52,10 +52,15 @@
     (if (equal (pattern a) pat)
       (return-from find-action a))))
 
-;;;; context
+;;;; context, services
 
 (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 ()
    ((actions :accessor actions :initform nil)
     (default-actions :reader default-actions :initform nil)))
@@ -75,12 +80,21 @@
 
 (defun setup-services (&optional (cfg config:*root*))
   (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)))
     (add-service *root* c)))
 
 (defun shutdown ()
   (dolist (ctx (alx:hash-table-values (services *root*)))
     (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)
   (let* ((acts (actions ctx))
diff --git a/scopes-core.asd b/scopes-core.asd
index 7f6d46b..359aa7c 100644
--- a/scopes-core.asd
+++ b/scopes-core.asd
@@ -7,7 +7,8 @@
   :homepage "https://www.cyberconcepts.org"
   :description "Core packages of the scopes project."
   :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"))
                (:file "core/core" 
                       :depends-on ("core/message" "config" 
diff --git a/web/server.lisp b/web/server.lisp
index 5ce01e7..a5738d2 100644
--- a/web/server.lisp
+++ b/web/server.lisp
@@ -59,7 +59,8 @@
     ctx))
 
 (defun stop (ctx)
-  (clack:stop (listener ctx)))
+  (clack:stop (listener ctx))
+  (util:lgi))
 
 (defun select-app (ctx env)
   (let ((path (cdr (str:split "/" (getf env :path-info)))))