From 60ff10e07aacdca433315c1115cbfed21cc44bfe Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@kank.net>
Date: Sun, 12 Dec 2021 06:02:45 -0600
Subject: [PATCH] Add job processing, local disk processing

---
 bin/candle-server       | 14 ++++++++++----
 candle.asd              |  9 ++++++++-
 src/main/base.lisp      |  2 +-
 src/main/local.lisp     | 20 ++++++++++++++++++++
 src/main/package.lisp   |  2 +-
 src/main/processor.lisp | 34 ++++++++++++++++++++++++++++++++++
 src/main/server.lisp    |  5 ++++-
 7 files changed, 78 insertions(+), 8 deletions(-)
 create mode 100644 src/main/local.lisp
 create mode 100644 src/main/processor.lisp

diff --git a/bin/candle-server b/bin/candle-server
index 5422abe..8c4d0cb 100755
--- a/bin/candle-server
+++ b/bin/candle-server
@@ -16,8 +16,10 @@
  '((:name :help :short "h" :long "help" :description "Print this usage.")
    (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT"
     :description "Port on which to listen for commands.  Defaults to 25004")
-   (:name :port :long "candle-dir" :takes-argument t :variable-name "DIR"
-    :description "Directory for candle related data.  Will be created if does not exist.  Defaults to /opt/candle/")))
+   (:name :dir :long "candle-dir" :takes-argument t :variable-name "DIR"
+    :description "Directory for candle related data.  Will be created if does not exist.  Defaults to /opt/candle/")
+   (:name :system :long "system" :takes-argument t :variable-name "SYSTEM"
+    :description "System on which to run jobs.  Currently available are local and aws.  Defaults to local.")))
 
 (defun usage ()
  (format t "~A"
@@ -40,9 +42,13 @@
                 (opera:option-present :port options)
                 (parse-integer (opera:option-argument :port options) :junk-allowed t))
             25004)))
+   (setf candle:*job-system*
+    (if (opera:option-present :system options)
+     (intern (string-upcase (opera:option-argument :system options)) :keyword)
+     :local))
    (setf candle:*candle-dir*
-    (if (opera:option-present :port options)
-     (opera:option-argument :port options)
+    (if (opera:option-present :dir options)
+     (opera:option-argument :dir options)
      "/opt/candle/"))
    (format t "Starting server on port ~A~%" port)
    (candle:server port nil)))))
diff --git a/candle.asd b/candle.asd
index 55de875..f467511 100644
--- a/candle.asd
+++ b/candle.asd
@@ -5,5 +5,12 @@
  :author "Frank Duncan (frank@consxy.com)"
  :serial t
  :pathname "src/main"
- :components ((:file "package") (:file "base") (:file "server") (:file "cli") (:file "git") (:file "run"))
+ :components ((:file "package")
+              (:file "base")
+              (:file "server")
+              (:file "cli")
+              (:file "git")
+              (:file "processor")
+              (:file "local")
+              (:file "run"))
  :depends-on (:herbie-utility :opera))
diff --git a/src/main/base.lisp b/src/main/base.lisp
index cdceda1..42518ae 100644
--- a/src/main/base.lisp
+++ b/src/main/base.lisp
@@ -10,7 +10,7 @@
 ; - :succeeded - job succeeded
 ; - :no-candle-file - no candle file was found
 ; - :in-progress - job is running
-(lame-db:defdbstruct job status sha create-date (project :join project))
+(lame-db:defdbstruct job status sha create-date log (project :join project))
 
 ; in-git here refers to whether the branch exists in git.  As branches get deleted,
 ; this will get set to nil but we keep them around for historical reference
diff --git a/src/main/local.lisp b/src/main/local.lisp
new file mode 100644
index 0000000..83b9815
--- /dev/null
+++ b/src/main/local.lisp
@@ -0,0 +1,20 @@
+(in-package #:candle)
+
+(defmethod process-job-in-system ((job-system (eql :local)) job)
+ (let
+  ((work-dir (format nil "~Awork/" *candle-dir*))
+   (result nil))
+  (sb-ext:run-program
+   "/bin/cp"
+   (list
+    "-ap"
+    (project-dir (job-project job))
+    work-dir))
+   (let*
+    ((*default-pathname-defaults* (pathname work-dir))
+     (*error-output* (make-broadcast-stream))
+     (output
+      (with-output-to-string (*standard-output*)
+       (setf result (run)))))
+    (sb-ext:delete-directory work-dir :recursive t)
+    (values result output))))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 1078e78..65a7082 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -1,4 +1,4 @@
 (defpackage #:candle (:use :cl)
- (:export #:server #:add-project #:delete-project #:refresh-project #:project-branch-information #:run #:*candle-dir*))
+ (:export #:server #:add-project #:delete-project #:refresh-project #:project-branch-information #:run #:*candle-dir* #:*job-system*))
 
 (defpackage #:candle-cli (:use :cl) (:export :run))
diff --git a/src/main/processor.lisp b/src/main/processor.lisp
new file mode 100644
index 0000000..af65aa0
--- /dev/null
+++ b/src/main/processor.lisp
@@ -0,0 +1,34 @@
+(in-package #:candle)
+
+(defvar *mutex* (sb-thread:make-mutex))
+(defvar *waitq* (sb-thread:make-waitqueue))
+
+(defvar *job-system*)
+(defgeneric process-job-in-system (job-system job))
+
+(defun start-processor-thread ()
+ (sb-thread:make-thread
+  (lambda ()
+   (loop
+    (let
+     ((job (find :queued *all-job* :key #'job-status)))
+     (if job
+      (process-job job)
+      ; We just wait here until the processor is released, which is usually done
+      ; when a project is refreshed.
+      (sb-thread:with-mutex (*mutex*)
+       (sb-thread:condition-wait *waitq* *mutex*))))))
+  :name "Processor"))
+
+(defun awaken-processor-thread ()
+ (sb-thread:with-mutex (*mutex*)
+  (sb-thread:condition-broadcast *waitq*)))
+
+(defun process-job (job)
+ (set-job-status job :in-progress)
+ (git (job-project job) "checkout" (job-sha job))
+ (if (not (probe-file (format nil "~A.candle" (project-dir (job-project job)))))
+  (set-job-status job :no-candle-file)
+  (multiple-value-bind (result log) (process-job-in-system *job-system* job)
+   (set-job-status job (if result :succeeded :failed))
+   (set-job-log job log))))
diff --git a/src/main/server.lisp b/src/main/server.lisp
index 07d6213..a97c1f5 100644
--- a/src/main/server.lisp
+++ b/src/main/server.lisp
@@ -14,6 +14,8 @@
       (sleep (* 5 60))
       (lame-db:save-known-dbs data-dir))))
    :name "Save Thread")
+  (format t "Starting processor in ~(~A~) mode~%" *job-system*)
+  (start-processor-thread)
   (communication:start-listener port background)))
 
 (defun add-project (name src)
@@ -56,7 +58,8 @@
           (make-branch :name branch-name :project project))))
        (set-branch-in-git branch t)
        (set-branch-job branch job))))
-    (cl-ppcre:split "\\n" out)))))
+    (cl-ppcre:split "\\n" out))))
+ (awaken-processor-thread))
 
 (defun delete-project (name)
  (let
-- 
2.25.1