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

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