From: Frank Duncan Date: Sun, 12 Dec 2021 12:02:45 +0000 (-0600) Subject: Add job processing, local disk processing X-Git-Url: https://code.consxy.com/gitweb/?a=commitdiff_plain;h=60ff10e07aacdca433315c1115cbfed21cc44bfe;p=candle Add job processing, local disk processing --- 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