code.consxy.com Git - candle/blob - src/main/processor.lisp

   1 (in-package #:candle)
   2
   3 (defvar *mutex* (sb-thread:make-mutex))
   4 (defvar *waitq* (sb-thread:make-waitqueue))
   5
   6 (defvar *job-system* nil
   7  "*JOB-SYSTEM*
   8
   9 VALUE TYPE:
  10
  11   A keyword
  12
  13 INITIAL VALUE:
  14
  15   NIL
  16
  17 DESCRIPTION:
  18
  19   The job system the server is running under.  When implementing a job
  20   system, the generics PROCESS-JOB-IN-SYSTEM and SHUTDOWN-SYSTEM must
  21   be implemented.  Is set by the command line when the server is started.")
  22
  23 (defgeneric process-job-in-system (job-system job)
  24  (:documentation
  25   "PROCESS-JOB-IN-SYSTEM JOB-SYSTEM JOB => SUCCESS, LOG
  26
  27 ARGUMENTS AND VALUES:
  28
  29   JOB-SYSTEM: a keyword representing an installed system
  30   JOB: A job to be run
  31   SUCCESS: A boolean, whether the job was successful
  32   LOG: The log from the job
  33
  34 DESCRIPTION:
  35
  36   Runs a job in the specified system.  The code will be checked out,
  37   so any defining system should copy the code from the job's project's
  38   code dir to wherever it will run, and then ran `candle run` inside
  39   that directory, capturing the output."))
  40
  41 (defgeneric shutdown-system (job-system)
  42  (:documentation
  43   "SHUTDOWN-SYSTEM JOB-SYSTEM => UNUSED
  44
  45 ARGUMENTS AND VALUES:
  46
  47   JOB-SYSTEM: a keyword representing an installed system
  48   UNUSED: the result is unused
  49
  50 DESCRIPTION:
  51
  52   Shuts down the specified system.  Sometimes this will be an empty
  53   method, as the system requires no special shutdown instructions.
  54   This is run when the candle server is shutdown for the job system
  55   that's specified."))
  56
  57 (defun start-processor-thread ()
  58  (log:info "Starting processor in ~(~A~) mode" *job-system*)
  59  (let*
  60   ((active t)
  61    (processor-thread
  62     (sb-thread:make-thread
  63      (lambda ()
  64       (loop
  65        :while active
  66        :do
  67        (let
  68         ((job (find :queued *all-job* :key #'job-status)))
  69         (if job
  70          (process-job job)
  71          ; We just wait here until the processor is released, which is usually done
  72          ; when a project is refreshed.
  73          (sb-thread:with-mutex (*mutex*)
  74           (sb-thread:condition-wait *waitq* *mutex*))))))
  75      :name "Processor")))
  76   (push
  77    (lambda ()
  78     (log:info "Shutting down processor thread")
  79     (setf active nil)
  80     (awaken-processor-thread)
  81     (sb-thread:join-thread processor-thread)
  82     (shutdown-system *job-system*))
  83    sb-ext:*exit-hooks*)))
  84
  85 (defun awaken-processor-thread ()
  86  (sb-thread:with-mutex (*mutex*)
  87   (sb-thread:condition-broadcast *waitq*)))
  88
  89 (defun process-job (job)
  90  (set-job-status job :in-progress)
  91  (git (job-project job) "checkout" (job-sha job))
  92  (if (not (probe-file (format nil "~A.candle" (project-dir (job-project job)))))
  93   (set-job-status job :no-candle-file)
  94   (multiple-value-bind (result log) (process-job-in-system *job-system* job)
  95    (set-job-status job (if result :succeeded :failed))
  96    (set-job-log job log))))