Add job processing, local disk processing

diff --git a/bin/candle-server b/bin/candle-server
index 5422abedb3e58ee833d97c7caa07dd1d7a307f67..8c4d0cb9a9f1d0f04097aa74638b3d2ea905996f 100755 (executable)
--- 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 55de87568555b846f55afadd265b0494eabbe7dd..f4675115431dd556394e3acd2546f96ab6d5e65b 100644 (file)
--- 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 cdceda1c34fb48ea10f5993d1874080c329fe39e..42518ae434797fd906ea329b3eadf571acdf4deb 100644 (file)
--- 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 (file)
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 1078e78996f44a49b8c24694643ff6c73919e11c..65a708296587ce2ae40015a2e50950cefe7c8345 100644 (file)
--- 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 (file)
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 07d6213876f5bb10f96b41c59d759279a3c8aaad..a97c1f56778f6eb364ce993cd5658045b8a4c8e6 100644 (file)
--- 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