From 09ef79e902dcf475d6cd9dc34bc74a46b39150c3 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 10:47:36 -0600 Subject: [PATCH 01/16] Failures handles invalid project name gracefully --- src/main/server.lisp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/main/server.lisp b/src/main/server.lisp index 035ba4c..f086aa2 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -149,10 +149,10 @@ *all-project*)) (defun failures (project-name) - (length - (remove-if-not - (lambda (branch) (eql :failed (job-status (branch-job branch)))) - (if project-name - (find-branch-by-project - (find project-name *all-project* :test #'string= :key #'project-name)) - *all-branch*)))) + (let + ((project (when project-name (find project-name *all-project* :test #'string= :key #'project-name)))) + (when (and project-name (not project)) (raise-candle-error :project-does-not-exist)) + (length + (remove-if-not + (lambda (branch) (eql :failed (job-status (branch-job branch)))) + (if project (find-branch-by-project project) *all-branch*))))) -- 2.25.1 From 1f486261df0bbc1d8c10265e4736356934aa1b57 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 10:57:53 -0600 Subject: [PATCH 02/16] Refactor project not exist error --- src/main/server.lisp | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/main/server.lisp b/src/main/server.lisp index f086aa2..320ffbd 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -44,6 +44,12 @@ (sb-thread:join-thread save-thread)) sb-ext:*exit-hooks*))) +(defun find-project-by-name-or-die (name) + (when name + (or + (find name *all-project* :test #'string= :key #'project-name) + (raise-candle-error :project-does-not-exist)))) + (defun add-project (name src) (when (not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name)) @@ -63,7 +69,7 @@ (defun refresh-project (name) (let* - ((project (find name *all-project* :test #'string= :key #'project-name)) + ((project (find-project-by-name-or-die name)) (branches (find-branch-by-project project))) (git project "fetch" "origin" "--prune") (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*") @@ -89,8 +95,7 @@ (defun delete-project (name) (let - ((project (find name *all-project* :test #'string= :key #'project-name))) - (when (not project) (raise-candle-error :project-does-not-exist)) + ((project (find-project-by-name-or-die name))) (sb-ext:delete-directory (project-dir project) :recursive t) (mapcar #'nremove-job (find-job-by-project project)) (mapcar #'nremove-branch (find-branch-by-project project)) @@ -101,8 +106,7 @@ (defun project-branch-information (name) (let - ((project (find name *all-project* :test #'string= :key #'project-name))) - (when (not project) (raise-candle-error :project-does-not-exist)) + ((project (find-project-by-name-or-die name))) (mapcar (lambda (branch) (list @@ -112,8 +116,7 @@ (defun project-job-information (name) (let - ((project (when name (find name *all-project* :test #'string= :key #'project-name)))) - (when (and name (not project)) (raise-candle-error :project-does-not-exist)) + ((project (find-project-by-name-or-die name))) (mapcar #'job->job-information (if project (find-job-by-project project) @@ -129,7 +132,6 @@ (and (<= (length sha) (length job-sha)) (string= sha (subseq job-sha 0 (length sha))))) (find-job-by-project project) :key #'job-sha)))) - (when (not project) (raise-candle-error :project-does-not-exist)) (when (not job) (raise-candle-error :job-does-not-exist)) job)) @@ -145,13 +147,13 @@ (lambda (project) (list (project-name project) - (project-src project))) + (project-src project) + (failures (project-name project)))) *all-project*)) (defun failures (project-name) (let - ((project (when project-name (find project-name *all-project* :test #'string= :key #'project-name)))) - (when (and project-name (not project)) (raise-candle-error :project-does-not-exist)) + ((project (find-project-by-name-or-die project-name))) (length (remove-if-not (lambda (branch) (eql :failed (job-status (branch-job branch)))) -- 2.25.1 From d0f4cf618b95cf5b815cbfc0eb8949bc0324a504 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 10:58:08 -0600 Subject: [PATCH 03/16] Include branch failing information in project list --- src/main/cli.lisp | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/src/main/cli.lisp b/src/main/cli.lisp index fb38f58..b5fc298 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -159,7 +159,14 @@ (format t "Refreshed project ~A~%" (car remaining-args))))) (defun list-projects () - (format t "~{~{~A ~A~}~%~}" (communication:query `(candle:list-projects)))) + (format t "~{~A~%~}" + (mapcar + (lambda (info) + (format nil "~A ~A~A" + (car info) + (cadr info) + (if (zerop (caddr info)) "" (format nil " (~A branches ~c[1;31mfailing~c[0m)" (caddr info) #\Esc #\Esc)))) + (communication:query `(candle:list-projects))))) (defun project-failures (args) (let -- 2.25.1 From 2a45e9d6f9b421e06095281ad47c127db3b8b476 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 11:03:11 -0600 Subject: [PATCH 04/16] Include projectname in job output --- src/main/cli.lisp | 13 +++++++------ src/main/server.lisp | 2 +- 2 files changed, 8 insertions(+), 7 deletions(-) diff --git a/src/main/cli.lisp b/src/main/cli.lisp index b5fc298..bacd1e3 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -10,11 +10,12 @@ (error-and-exit "Unknown command '~(~A~)'. See 'candle --help'.~%" command)) (defun job-info->line (job-info) - (format nil "~A (~A) ~A" - (subseq (first job-info) 0 8) + (format nil "~A:~A (~A) ~A" + (first job-info) + (subseq (second job-info) 0 8) (format nil "~{~2,,,'0@A/~2,,,'0@A/~A ~2,,,'0@A:~2,,,'0@A~}" - (utils:time-as-list (third job-info) :month :date :year :hr :min)) - (case (second job-info) + (utils:time-as-list (fourth job-info) :month :date :year :hr :min)) + (case (third job-info) (:succeeded (format nil "~c[1;32mPassed~c[0m" #\Esc #\Esc)) (:failed (format nil "~c[1;31mFailed~c[0m" #\Esc #\Esc)) (:queued "In queue") @@ -147,7 +148,7 @@ (format t (format nil "~~~A@A: ~~A~~%" width) (first branch-info) (job-info->line (second branch-info)))) - (sort branch-infos #'< :key (lambda (branch-info) (third (second branch-info))))))))) + (sort branch-infos #'< :key (lambda (branch-info) (fourth (second branch-info))))))))) (defun refresh-project (args) (let @@ -212,7 +213,7 @@ (format t "~{~A~%~}" (mapcar #'job-info->line - (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'third)))))) + (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'fourth)))))) (defun decompose-job-definition (job-definition) (let diff --git a/src/main/server.lisp b/src/main/server.lisp index 320ffbd..3df97f8 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -102,7 +102,7 @@ (nremove-project project))) (defun job->job-information (job) - (list (job-sha job) (job-status job) (job-create-date job))) + (list (project-name (job-project job)) (job-sha job) (job-status job) (job-create-date job))) (defun project-branch-information (name) (let -- 2.25.1 From d7f08bad7f5d32edb80f2e1468eff32c50166a94 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 11:09:07 -0600 Subject: [PATCH 05/16] Move server cli into repository with its own file --- bin/candle-server | 49 +--------------------------------------- candle.asd | 3 ++- src/main/package.lisp | 1 + src/main/server-cli.lisp | 48 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 52 insertions(+), 49 deletions(-) create mode 100644 src/main/server-cli.lisp diff --git a/bin/candle-server b/bin/candle-server index 60a847c..5a14859 100755 --- a/bin/candle-server +++ b/bin/candle-server @@ -8,53 +8,6 @@ ((*error-output* (make-broadcast-stream))) (asdf:load-system :candle)) -(defpackage #:candle-server-cli (:use #:common-lisp)) -(in-package #:candle-server-cli) - -(defvar *options* - '((: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 :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" - (opera:usage - "candle-server" - *options* - "Starts a candle continuous integration server. Use 'candle' to interact with the server."))) - -(multiple-value-bind (options remaining-args error) (opera:process-arguments *options* (cdr sb-ext:*posix-argv*)) - (cond - ((opera:option-present :help options) (usage)) - (remaining-args - (format *error-output* "Don't understand ~A. See 'candle-server -h'~%" (car remaining-args)) - (sb-ext:exit :code 1)) - ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) - (format *error-output* "--port requires a number. See 'candle-server -h'~%")) - (t - (let - ((port (or (and - (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)) - (let - ((*error-output* (make-broadcast-stream))) - (case candle:*job-system* - (:aws (asdf:load-system :candle-aws)) - (:local (asdf:load-system :candle-local)))) - (setf candle:*candle-dir* - (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))))) +(candle-server-cli:run) ; vim:ft=lisp diff --git a/candle.asd b/candle.asd index 30a6da3..77493d2 100644 --- a/candle.asd +++ b/candle.asd @@ -11,7 +11,8 @@ (:file "run") (:file "processor") (:file "server") - (:file "cli")) + (:file "cli") + (:file "server-cli")) :depends-on (:herbie-utility :opera)) (asdf:defsystem candle-aws diff --git a/src/main/package.lisp b/src/main/package.lisp index 9d04cea..7545b28 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -8,5 +8,6 @@ #:candle-error #:candle-error-reason)) (defpackage #:candle-cli (:use :cl) (:export :run)) +(defpackage #:candle-server-cli (:use :cl) (:export :run)) (defpackage #:candle-aws (:use :cl)) (defpackage #:candle-local (:use :cl)) diff --git a/src/main/server-cli.lisp b/src/main/server-cli.lisp new file mode 100644 index 0000000..8947727 --- /dev/null +++ b/src/main/server-cli.lisp @@ -0,0 +1,48 @@ +(in-package #:candle-server-cli) + +(defvar *options* + '((: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 :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" + (opera:usage + "candle-server" + *options* + "Starts a candle continuous integration server. Use 'candle' to interact with the server."))) + +(defun run () + (multiple-value-bind (options remaining-args error) (opera:process-arguments *options* (cdr sb-ext:*posix-argv*)) + (cond + ((opera:option-present :help options) (usage)) + (remaining-args + (format *error-output* "Don't understand ~A. See 'candle-server -h'~%" (car remaining-args)) + (sb-ext:exit :code 1)) + ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) + (format *error-output* "--port requires a number. See 'candle-server -h'~%")) + (t + (let + ((port (or (and + (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)) + (let + ((*error-output* (make-broadcast-stream))) + (case candle:*job-system* + (:aws (asdf:load-system :candle-aws)) + (:local (asdf:load-system :candle-local)))) + (setf candle:*candle-dir* + (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)))))) -- 2.25.1 From ee77eb54acee4492045d4b5885bc5df332f58566 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 11:25:35 -0600 Subject: [PATCH 06/16] Use utils logging --- src/main/aws/aws.lisp | 4 ++-- src/main/processor.lisp | 4 ++-- src/main/server-cli.lisp | 1 - src/main/server.lisp | 13 +++++++++---- 4 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/main/aws/aws.lisp b/src/main/aws/aws.lisp index 2913d32..4182c67 100644 --- a/src/main/aws/aws.lisp +++ b/src/main/aws/aws.lisp @@ -26,7 +26,7 @@ (values-list retn)))) (defun start-shutdown-thread () - (format t "Starting AWS shutdown thread~%") + (log:info "Starting AWS shutdown thread") (sb-thread:make-thread (lambda () (loop @@ -42,7 +42,7 @@ :name "AWS Shutdown Thread")) (defmethod candle:shutdown-system ((job-system (eql :aws))) - (format t "Shutting down AWS box for exit~%") + (log:info "Shutting down AWS box for exit") ; If there's a job going, we need to wait for it to finish (sb-thread:with-mutex (*aws-mutex*)) (stop-aws-box)) diff --git a/src/main/processor.lisp b/src/main/processor.lisp index 0d6ec1e..5e33639 100644 --- a/src/main/processor.lisp +++ b/src/main/processor.lisp @@ -8,7 +8,7 @@ (defgeneric shutdown-system (job-system)) (defun start-processor-thread () - (format t "Starting processor in ~(~A~) mode~%" *job-system*) + (log:info "Starting processor in ~(~A~) mode" *job-system*) (let* ((active t) (processor-thread @@ -28,7 +28,7 @@ :name "Processor"))) (push (lambda () - (format t "Shutting down processor thread~%") + (log:info "Shutting down processor thread") (setf active nil) (awaken-processor-thread) (sb-thread:join-thread processor-thread) diff --git a/src/main/server-cli.lisp b/src/main/server-cli.lisp index 8947727..b0c378b 100644 --- a/src/main/server-cli.lisp +++ b/src/main/server-cli.lisp @@ -44,5 +44,4 @@ (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/src/main/server.lisp b/src/main/server.lisp index 3df97f8..bdf8d77 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -3,17 +3,22 @@ (defun server (port &optional (background t)) (when (not *candle-dir*) (error "Need a candle dir")) (let* - ((data-dir (format nil "~Adata" *candle-dir*))) + ((data-dir (format nil "~Adata" *candle-dir*)) + (log-dir (format nil "~Alogs/" *candle-dir*))) (ensure-directories-exist *candle-dir*) (ensure-directories-exist data-dir) + (ensure-directories-exist log-dir) + (setf log-utils:*log-dir* log-dir) + (log:add-appender #'log-utils:file-appender) + (log:info "Starting server on port ~A" port) (lame-db:load-known-dbs data-dir) - (format t "Starting processor in ~(~A~) mode~%" *job-system*) + (log:info "Starting processor in ~(~A~) mode" *job-system*) (start-save-thread data-dir) (start-processor-thread) (communication:start-listener port background))) (defun start-save-thread (data-dir) - (format t "Starting Save Thread~%") + (log:info "Starting Save Thread") (let* ((mutex (sb-thread:make-mutex)) (waitq (sb-thread:make-waitqueue)) @@ -37,7 +42,7 @@ :name "Save Thread Trigger") (push (lambda () - (format t "Shutting down save thread~%") + (log:info "Shutting down save thread") (sb-thread:with-mutex (mutex) (setf active nil) (sb-thread:condition-broadcast waitq)) -- 2.25.1 From 4c3171e265788043aba57ac742ecd232a1c6ffdf Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 12:19:39 -0600 Subject: [PATCH 07/16] Fix save thread not actually saving, increase to 5 minutes --- src/main/server.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/main/server.lisp b/src/main/server.lisp index bdf8d77..7d7af0b 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -30,13 +30,13 @@ :while active :do (sb-thread:with-mutex (mutex) - (sb-thread:condition-wait waitq mutex))) - (lame-db:save-known-dbs data-dir)) + (sb-thread:condition-wait waitq mutex) + (lame-db:save-known-dbs data-dir)))) :name "Save Thread"))) (sb-thread:make-thread (lambda () (loop - (sleep (* 1 60)) + (sleep (* 5 60)) (sb-thread:with-mutex (mutex) (sb-thread:condition-broadcast waitq)))) :name "Save Thread Trigger") -- 2.25.1 From 195548f7ebbaccfed84fff8e9558745f59f156ec Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 14:19:40 -0600 Subject: [PATCH 08/16] Fix bug where inactive branches were counted as failures --- src/main/server.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/server.lisp b/src/main/server.lisp index 7d7af0b..338516b 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -161,5 +161,5 @@ ((project (find-project-by-name-or-die project-name))) (length (remove-if-not - (lambda (branch) (eql :failed (job-status (branch-job branch)))) + (lambda (branch) (and (branch-in-git branch) (eql :failed (job-status (branch-job branch))))) (if project (find-branch-by-project project) *all-branch*))))) -- 2.25.1 From 4aa3c53883d919803cac77f47ad16ce33047f6ce Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 15:00:55 -0600 Subject: [PATCH 09/16] Satisfy style checker --- src/main/aws/aws.lisp | 52 ++++++++++++------------ src/main/cli.lisp | 85 ++++++++++++++++++++++++---------------- src/main/server-cli.lisp | 32 ++++++++------- src/main/server.lisp | 8 ++-- 4 files changed, 99 insertions(+), 78 deletions(-) diff --git a/src/main/aws/aws.lisp b/src/main/aws/aws.lisp index 4182c67..ad224af 100644 --- a/src/main/aws/aws.lisp +++ b/src/main/aws/aws.lisp @@ -49,13 +49,13 @@ (defun aws-command (cmd &rest args) (with-output-to-string (out) - (sb-ext:run-program - *aws-exec* - (append - (list "ec2" cmd) - args) - :output out - :error *error-output*))) + (sb-ext:run-program + *aws-exec* + (append + (list "ec2" cmd) + args) + :output out + :error *error-output*))) (defun describe-property (property) (read-from-string @@ -102,22 +102,22 @@ (let* ((out nil) (code nil)) - (setf out - (with-output-to-string (out-str) - (setf code - (sb-ext:process-exit-code - (sb-ext:run-program - *ssh-exec* - (list - "-o" - "StrictHostKeyChecking=no" - "-o" - "UserKnownHostsFile=/dev/null" - "-i" - *aws-keyfile* - (describe-property "PublicIpAddress") - (format nil "cd ~A ; ~A run" *remote-work-dir* *remote-candle-location*)) - :output out-str - :error out-str - :wait t))))) - (values (zerop code) out))) + (setf out + (with-output-to-string (out-str) + (setf code + (sb-ext:process-exit-code + (sb-ext:run-program + *ssh-exec* + (list + "-o" + "StrictHostKeyChecking=no" + "-o" + "UserKnownHostsFile=/dev/null" + "-i" + *aws-keyfile* + (describe-property "PublicIpAddress") + (format nil "cd ~A ; ~A run" *remote-work-dir* *remote-candle-location*)) + :output out-str + :error out-str + :wait t))))) + (values (zerop code) out))) diff --git a/src/main/cli.lisp b/src/main/cli.lisp index bacd1e3..1fff398 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -23,18 +23,18 @@ (:in-progress "In progress")))) (defmacro standard-cli (cmd options-in args usage remaining-args-required &rest success) -`(multiple-value-bind (parsed-options remaining-args error) (opera:process-arguments ,options-in ,args) - (cond - ((opera:option-present :help parsed-options) - (format t "~A" ,(if (eql usage :default) `(opera:usage ,cmd ,options-in) usage))) - ((eql error :unknown-option) - (error-and-exit "Unknown option: ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) - ((eql error :required-argument-missing) - (error-and-exit "Missing argument for ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) - ((and ,remaining-args-required (not remaining-args)) - (error-and-exit "~A required. See 'candle --help'.~%" ,remaining-args-required)) - (t - ,@success)))) + `(multiple-value-bind (parsed-options remaining-args error) (opera:process-arguments ,options-in ,args) + (cond + ((opera:option-present :help parsed-options) + (format t "~A" ,(if (eql usage :default) `(opera:usage ,cmd ,options-in) usage))) + ((eql error :unknown-option) + (error-and-exit "Unknown option: ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) + ((eql error :required-argument-missing) + (error-and-exit "Missing argument for ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) + ((and ,remaining-args-required (not remaining-args)) + (error-and-exit "~A required. See 'candle --help'.~%" ,remaining-args-required)) + (t + ,@success)))) ;;; Section for ./candle @@ -42,7 +42,9 @@ (standard-cli "candle" (main-options) (cdr sb-ext:*posix-argv*) (main-usage) "Command" (handler-case (if - (and (opera:option-present :port parsed-options) (not (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t))) + (and + (opera:option-present :port parsed-options) + (not (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t))) (error-and-exit "--port requires a number. See 'candle -h'~%") (let ((communication:*query-port* @@ -110,14 +112,21 @@ (defun add-project (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional ":" :description " is the name of the project, which must be alphanumeric (hyphens are allowed), while is the location of the repository for cloning. This location must be accessible by the machine running candle.")))) + `((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional ":" + :description + ,(format nil "~{~A~}" + (list + " is the name of the project, which must be alphanumeric (hyphens are allowed), while is the " + "location of the repository for cloning. This location must be accessible by the machine running candle." + "")))))) (standard-cli "candle project add" options args :default ":" (let* ((project-definition (car remaining-args)) (pos (position #\: project-definition))) (cond - ((not pos) (error-and-exit "Project definition ~A is not valid. See 'candle project add --help'.~%" project-definition)) + ((not pos) + (error-and-exit "Project definition ~A is not valid. See 'candle project add --help'.~%" project-definition)) (t (let* ((name (subseq project-definition 0 pos)) @@ -128,17 +137,17 @@ (defun delete-project (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional "" :description " is the name of the project to delete")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional "" :description " is the name of the project to delete")))) (standard-cli "candle project delete" options args :default "" - (communication:query `(candle:delete-project ,(car remaining-args))) - (format t "Removed project ~A~%" (car remaining-args))))) + (communication:query `(candle:delete-project ,(car remaining-args))) + (format t "Removed project ~A~%" (car remaining-args))))) (defun show-project (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional "" :description " is the name of the project to show")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional "" :description " is the name of the project to show")))) (standard-cli "candle project show" options args :default "" (let* ((branch-infos (communication:query `(candle:project-branch-information ,(car remaining-args)))) @@ -153,8 +162,8 @@ (defun refresh-project (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional "" :description " is the name of the project to refresh")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional "" :description " is the name of the project to refresh")))) (standard-cli "candle project refresh" options args :default "" (communication:query `(candle:refresh-project ,(car remaining-args))) (format t "Refreshed project ~A~%" (car remaining-args))))) @@ -172,12 +181,15 @@ (defun project-failures (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:name :project :long "project" :variable-name "PROJECT" :takes-argument t :description "Restrict failures to project named by PROJECT")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :project :long "project" :variable-name "PROJECT" :takes-argument t + :description "Restrict failures to project named by PROJECT")))) (standard-cli "candle project failures" options args :default nil (format t "~A" (communication:query - `(candle:failures ,(when (opera:option-present :project parsed-options) (opera:option-argument :project parsed-options)))))))) + `(candle:failures + ,(when (opera:option-present :project parsed-options) + (opera:option-argument :project parsed-options)))))))) ;;; Section for ./candle job @@ -207,13 +219,16 @@ (defun job-list (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:name :project :long "project" :variable-name "PROJECT" :takes-argument t :description "Restrict jobs to project named by PROJECT")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :project :long "project" :variable-name "PROJECT" :takes-argument t + :description "Restrict jobs to project named by PROJECT")))) (standard-cli "candle job list" options args :default nil (format t "~{~A~%~}" (mapcar #'job-info->line - (sort (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) #'< :key #'fourth)))))) + (sort + (communication:query `(candle:project-job-information ,(opera:option-argument :project parsed-options))) + #'< :key #'fourth)))))) (defun decompose-job-definition (job-definition) (let @@ -227,8 +242,9 @@ (defun job-log (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional ":" :description " is the name of the project, while is the sha of the job in question.")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional ":" + :description " is the name of the project, while is the sha of the job in question.")))) (standard-cli "candle job log" options args :default ":" (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args)) (if project-name @@ -238,8 +254,9 @@ (defun retry-job (args) (let ((options - '((:name :help :short "h" :long "help" :description "Print this usage.") - (:positional ":" :description " is the name of the project, while is the sha of the job in question.")))) + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:positional ":" + :description " is the name of the project, while is the sha of the job in question.")))) (standard-cli "candle job retry" options args :default ":" (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args)) (if project-name diff --git a/src/main/server-cli.lisp b/src/main/server-cli.lisp index b0c378b..6a6fd06 100644 --- a/src/main/server-cli.lisp +++ b/src/main/server-cli.lisp @@ -23,7 +23,9 @@ (remaining-args (format *error-output* "Don't understand ~A. See 'candle-server -h'~%" (car remaining-args)) (sb-ext:exit :code 1)) - ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) + ((and + (opera:option-present :port options) + (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) (format *error-output* "--port requires a number. See 'candle-server -h'~%")) (t (let @@ -31,17 +33,17 @@ (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)) - (let - ((*error-output* (make-broadcast-stream))) - (case candle:*job-system* - (:aws (asdf:load-system :candle-aws)) - (:local (asdf:load-system :candle-local)))) - (setf candle:*candle-dir* - (if (opera:option-present :dir options) - (opera:option-argument :dir options) - "/opt/candle/")) - (candle:server port nil)))))) + (setf candle:*job-system* + (if (opera:option-present :system options) + (intern (string-upcase (opera:option-argument :system options)) :keyword) + :local)) + (let + ((*error-output* (make-broadcast-stream))) + (case candle:*job-system* + (:aws (asdf:load-system :candle-aws)) + (:local (asdf:load-system :candle-local)))) + (setf candle:*candle-dir* + (if (opera:option-present :dir options) + (opera:option-argument :dir options) + "/opt/candle/")) + (candle:server port nil)))))) diff --git a/src/main/server.lisp b/src/main/server.lisp index 338516b..3f022f3 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -77,7 +77,9 @@ ((project (find-project-by-name-or-die name)) (branches (find-branch-by-project project))) (git project "fetch" "origin" "--prune") - (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*") + (multiple-value-bind + (success code out err) + (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*") (declare (ignore code err)) (when (not success) (raise-candle-error :project-failed-to-get-branches)) (mapcar (lambda (branch) (set-branch-in-git branch nil)) branches) @@ -135,8 +137,8 @@ (find-if (lambda (job-sha) (and (<= (length sha) (length job-sha)) (string= sha (subseq job-sha 0 (length sha))))) - (find-job-by-project project) - :key #'job-sha)))) + (find-job-by-project project) + :key #'job-sha)))) (when (not job) (raise-candle-error :job-does-not-exist)) job)) -- 2.25.1 From a50fef6f3bacc24a838e81092104f3082b15bad4 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 16:18:37 -0600 Subject: [PATCH 10/16] Add documentation for all the exported symbols --- src/main/base.lisp | 69 +++++++++++++++++- src/main/package.lisp | 7 +- src/main/processor.lisp | 53 +++++++++++++- src/main/run.lisp | 10 +++ src/main/server.lisp | 150 +++++++++++++++++++++++++++++++++++++++- 5 files changed, 282 insertions(+), 7 deletions(-) diff --git a/src/main/base.lisp b/src/main/base.lisp index 871da36..f5995a4 100644 --- a/src/main/base.lisp +++ b/src/main/base.lisp @@ -1,8 +1,50 @@ (in-package #:candle) -(defvar *candle-dir*) +(defvar *candle-dir* nil + "*CANDLE-DIR* + +VALUE TYPE: + + A pathname or pathstring + +INITIAL VALUE: + + NIL + +DESCRIPTION: + + The main directory for all candle work to be done in. When the server is running + in local mode, this is also the place that builds are built in") + +(define-condition candle-error (error) + ((reason :initarg :reason :reader candle-error-reason)) + (:documentation + "An error on the server that needs to be handled in the client. + +This error is usually because some input was incorrect. The response will +have a reason that is a keyword that must be handled. The current used keywords +are: + +- :project-does-not-exist - if the project isn't in the database +- :invalid-project-name - the specified name doesn't match the requirements +- :invlides-project-uri - the uri isn't reachable by git +- :project-name-taken - name is a duplicate +- :project-failed-to-get-branches - when refreshing fails +- :job-does-not-exist - the specified job can't be found")) + +(setf (documentation 'candle-error-reason 'function) + "CANDLE-ERROR-REASON CANDLE-ERROR => REASON + +ARGUMENTS AND VALUES: + + CANDLE-ERROR: the error for the reason + REASON: a keyword representing the reason + +DESCRIPTION: + + Returns the reason for this candle error. See the documentation of + the candle-error condition for possible values") -(define-condition candle-error (error) ((reason :initarg :reason :reader candle-error-reason))) (defun raise-candle-error (reason) (error (make-instance 'candle-error :reason reason))) (lame-db:defdbstruct project name src) @@ -15,9 +57,32 @@ ; - :in-progress - job is running (lame-db:defdbstruct job status sha create-date log (project :join project)) +(setf (documentation 'job-project 'function) + "JOB-PROJECT JOB => PROJECT + +ARGUMENTS AND VALUES: + + JOB: a job + PROJECT: the project for this job + +DESCRIPTION: + + Returns the project for the job in question.") + ; 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 (lame-db:defdbstruct branch name in-git (project :join project) (job :join job)) (defun project-dir (project) + "PROJECT-DIR PROJECT => DIR + +ARGUMENTS AND VALUES: + + PROJECT: the project + DIR: the working directory for the project + +DESCRIPTION: + + Returns the checked out directory for this project, specifically for use + in candle. Resides in the *CANDLE-DIR*." (format nil "~Arepos/~A/" *candle-dir* (project-name project))) diff --git a/src/main/package.lisp b/src/main/package.lisp index 7545b28..6365450 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -5,7 +5,12 @@ #:project-job-information #:get-job-log #:retry-job #:job-project #:project-dir #:process-job-in-system #:shutdown-system - #:candle-error #:candle-error-reason)) + #:candle-error #:candle-error-reason) + (:documentation "Main candle package. + +Candle is continuous integration server and command line utility for common +lisp projects. The package is mainly accessed through the command line +scripts in the bin directory.")) (defpackage #:candle-cli (:use :cl) (:export :run)) (defpackage #:candle-server-cli (:use :cl) (:export :run)) diff --git a/src/main/processor.lisp b/src/main/processor.lisp index 5e33639..5a37777 100644 --- a/src/main/processor.lisp +++ b/src/main/processor.lisp @@ -3,9 +3,56 @@ (defvar *mutex* (sb-thread:make-mutex)) (defvar *waitq* (sb-thread:make-waitqueue)) -(defvar *job-system*) -(defgeneric process-job-in-system (job-system job)) -(defgeneric shutdown-system (job-system)) +(defvar *job-system* nil + "*JOB-SYSTEM* + +VALUE TYPE: + + A keyword + +INITIAL VALUE: + + NIL + +DESCRIPTION: + + The job system the server is running under. When implementing a job + system, the generics PROCESS-JOB-IN-SYSTEM and SHUTDOWN-SYSTEM must + be implemented. Is set by the command line when the server is started.") + +(defgeneric process-job-in-system (job-system job) + (:documentation + "PROCESS-JOB-IN-SYSTEM JOB-SYSTEM JOB => SUCCESS, LOG + +ARGUMENTS AND VALUES: + + JOB-SYSTEM: a keyword representing an installed system + JOB: A job to be run + SUCCESS: A boolean, whether the job was successful + LOG: The log from the job + +DESCRIPTION: + + Runs a job in the specified system. The code will be checked out, + so any defining system should copy the code from the job's project's + code dir to wherever it will run, and then ran `candle run` inside + that directory, capturing the output.")) + +(defgeneric shutdown-system (job-system) + (:documentation + "SHUTDOWN-SYSTEM JOB-SYSTEM => UNUSED + +ARGUMENTS AND VALUES: + + JOB-SYSTEM: a keyword representing an installed system + UNUSED: the result is unused + +DESCRIPTION: + + Shuts down the specified system. Sometimes this will be an empty + method, as the system requires no special shutdown instructions. + This is run when the candle server is shutdown for the job system + that's specified.")) (defun start-processor-thread () (log:info "Starting processor in ~(~A~) mode" *job-system*) diff --git a/src/main/run.lisp b/src/main/run.lisp index d6b963c..d979735 100644 --- a/src/main/run.lisp +++ b/src/main/run.lisp @@ -11,6 +11,16 @@ (format t "~c[1;31m- ~:(~A~) Failed!~c[0m~%" #\Esc (getf task :name) #\Esc))) (defun run () + "RUN => RESULT + +ARGUMENTS AND VALUES: + + RESULT: a boolean, whether the process was successful + +DESCRIPTION: + + Runs the script specified by the .candle file in the current directory. + When completed, the boolean will be returned if it was successful or not." (if (not (probe-file ".candle")) :dot-candle-absent diff --git a/src/main/server.lisp b/src/main/server.lisp index 3f022f3..e1b8cb6 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -1,6 +1,23 @@ (in-package #:candle) (defun server (port &optional (background t)) + "SERVER PORT &optional BACKGROUND => UNUSED + +ARGUMENTS AND VALUES: + + PORT: the port to start the communication server on + BACKGROUND: a boolean, defaulting to T + UNUSED: the result is unused + +DESCRIPTION: + + Starts the server, listening for commands from the client on PORT. + + If BACKGROUND is T, then the communication thread starts in the background, + which is useful when starting the server from an already running process. + Generally, if running from a script, you'll want BACKGROUND to be NIL, + so that the process doesn't exit immediately." + (when (not *candle-dir*) (error "Need a candle dir")) (let* ((data-dir (format nil "~Adata" *candle-dir*)) @@ -56,6 +73,23 @@ (raise-candle-error :project-does-not-exist)))) (defun add-project (name src) + "ADD-PROJECT NAME SRC => RESULT + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + SRC: a pathname, or pathstring, holding the location of the project + RESULT: if no error generated, returns t + +DESCRIPTION: + + Creates and adds a project to the database. NAME must be a + unique alphanumeric (hyphens allowed) string. SRC must be a git + accessible location for the running user, requiring keys to be set + up or it be located on the local disk. + + In addition to adding to the database, it will also clone the project + and analyze it intially (calling REFRESH-PROJECT)." (when (not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name)) (raise-candle-error :invalid-project-name)) @@ -73,6 +107,19 @@ t) (defun refresh-project (name) + "REFRESH-PROJECT NAME => RESULT + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + RESULT: unused + +DESCRIPTION: + + Refreshes the project from git's origin. Fetches, and then + analysis all branches available to create jobs for any new + commits that those branches are set to. Then wakes up the + processor thread to start working through those jobs." (let* ((project (find-project-by-name-or-die name)) (branches (find-branch-by-project project))) @@ -101,6 +148,17 @@ (awaken-processor-thread)) (defun delete-project (name) + "DELETE-PROJECT NAME => RESULT + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + RESULT: unused + +DESCRIPTION: + + Removes a project from the database and the disk. NAME must + be an existing project." (let ((project (find-project-by-name-or-die name))) (sb-ext:delete-directory (project-dir project) :recursive t) @@ -112,6 +170,26 @@ (list (project-name (job-project job)) (job-sha job) (job-status job) (job-create-date job))) (defun project-branch-information (name) + "PROJECT-BRANCH-INFORMATION NAME => BRANCHES-INFORMATION + + BRANCHES-INFORMATION: BRANCH-INFORMATION* + BRANCH-INFORMATION: (BRANCH-NAME JOB-INFORMATION) + JOB-INFORMATION: (JOB-PROJECT-NAME SHA STATUS CREATED-DATE) + STATUS: :queued | :failed | :succeeded | :no-candle-file | :in-progress + +ARGUMENTS AND VALUES: + + NAME: a string, the project for which we want information + BRANCH-NAME: a string, the name of the branch + JOB-PROJECT-NAME: a string, the project name for the attached job + SHA: a string, the sha for this job + CREATED-DATE: a universal time, the moment the job was first created + +DESCRIPTION: + + Returns the information for all the branches in the given project, + which includes the job information for the commit that the branch + is currently pointing to." (let ((project (find-project-by-name-or-die name))) (mapcar @@ -122,6 +200,22 @@ (remove-if-not #'branch-in-git (find-branch-by-project project))))) (defun project-job-information (name) + "PROJECT-JOB-INFORMATION NAME => JOBS-INFORMATION + + JOBS-INFORMATION: JOB-INFORMATION* + JOB-INFORMATION: (JOB-PROJECT-NAME SHA STATUS CREATED-DATE) + STATUS: :queued | :failed | :succeeded | :no-candle-file | :in-progress + +ARGUMENTS AND VALUES: + + NAME: a string, the project for which we want information + JOB-PROJECT-NAME: a string, the project name for the attached job + SHA: a string, the sha for this job + CREATED-DATE: a universal time, the moment the job was first created + +DESCRIPTION: + + Returns the information for all the jobs in the given project." (let ((project (find-project-by-name-or-die name))) (mapcar #'job->job-information @@ -143,13 +237,56 @@ job)) (defun get-job-log (project-name sha) + "GET-JOB-LOG PROJECT-NAME SHA => LOG + +ARGUMENTS AND VALUES: + + PROJECT-NAME: a string, representing the name of the project + SHA: a string, the commit sha for the job + LOG: the log from the run process + +DESCRIPTION: + + Returns the log for the job specified. When the job wasn't run + (for instance, if no candle file), just returns NIL. The SHA + can be truncated, and if there are collisions, one of them will be + returned." (job-log (find-job-by-project-and-sha project-name sha))) (defun retry-job (project-name sha) + "RETRY-JOB PROJECT-NAME SHA => UNUSED + +ARGUMENTS AND VALUES: + + PROJECT-NAME: a string, representing the name of the project + SHA: a string, the commit sha for the job + UNUSED: the result is unused + +DESCRIPTION: + + Sets the job specified by PROJECT-NAME and SHA to :queued, which will + then be run. Also awakes the processor thread to process it immediately + if available." (set-job-status (find-job-by-project-and-sha project-name sha) :queued) (awaken-processor-thread)) (defun list-projects () + "LIST-PROJECTS => PROJECTS-INFORMATION + + PROJECTS-INFORMATION: PROJECT-INFORMATION* + PROJECT-INFORMATION: (NAME SRC FAILURES) + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + SRC: the git origin remote location + FAILURES: the number of failing branches + +DESCRIPTION: + + Returns the information for all the projects in the system, as + is needed by the cli. Returns it as a list of lists, as specified + above." (mapcar (lambda (project) (list @@ -158,7 +295,18 @@ (failures (project-name project)))) *all-project*)) -(defun failures (project-name) +(defun failures (&optional project-name) + "FAILURES &optional NAME => NUM-FAILURES + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + NUM-FAILURES: the number of failures + +DESCRIPTION: + + Returns the number of failing branches. When NAME is specified, + the branches are limited to the project it refers to." (let ((project (find-project-by-name-or-die project-name))) (length -- 2.25.1 From 571c7a6df55ba7190cc9c20fd2ad500e6b09c182 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 16:18:50 -0600 Subject: [PATCH 11/16] Add .candle file --- .candle | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 .candle diff --git a/.candle b/.candle new file mode 100644 index 0000000..6f5c6bb --- /dev/null +++ b/.candle @@ -0,0 +1,8 @@ +(:packages :candle :style-checker :docgen) +(:name :candle + :tasks + ((:name :checkstyle :directions + (syntax-checker:pretty-print-check-directory "src")) + (:name :docgen :directions + (docgen:pretty-print-validate-packages :candle)))) +; vim:ft=lisp -- 2.25.1 From ec3c4dac8416e025e186501842723852b16cab4e Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 16:26:53 -0600 Subject: [PATCH 12/16] Update documentation a little --- README.md | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) diff --git a/README.md b/README.md index cb78e45..14a6262 100644 --- a/README.md +++ b/README.md @@ -27,30 +27,15 @@ Only one can be running at a time. = Usage = * Run bin/candle-server on a server somewhere, so that the candle client can connect to it -* Add projects via `bin/candle project --add`, see `--help` for more information -* Remove projects via `bin/candle project --delete`, see `--help` for more information -* Run `bin/candle project --show ` to show status of project +* Add projects via `bin/candle project add`, see `--help` for more information +* Remove projects via `bin/candle project delete`, see `--help` for more information +* Run `bin/candle project show ` to show status of project * Includes what branches are failing -* Run `bin/candle project --list` to show list all projects, and status -* Run `bin/candle job --log :` to see log +* Run `bin/candle project list` to show list all projects, and status +* Run `bin/candle project refresh` to refresh a project +* Run `bin/candle job log :` to see log +* Run `bin/candle job retry :` to retry the job == Local == * Run `bin/candle run` from a candle enabled project - -= General Design = - -For all projects added, a watcher thread runs `git fetch origin` to see if there's any -new SHAs for which jobs need to be run. - -When a previously unknown SHA shows up in the git directory, a job is created for that -SHA, which then clones the repository into the right place and runs `candle` for that location, -if there's a .candle file. - -A project is failing if any branches are failing, that is to say that the current sha -for that branch is failing. - -== Edge Cases == - -* For SHAs that hang, or get into infinite loops, there's a timeout before the server is killed - and marked as failure. -- 2.25.1 From 5c21748c18e32bb9fe17bb4c23329be02edc23a2 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sun, 26 Dec 2021 16:58:28 -0600 Subject: [PATCH 13/16] Add specifying task to candle run --- src/main/cli.lisp | 17 ++++++++++++++--- src/main/package.lisp | 2 +- src/main/run.lisp | 35 +++++++++++++++++++++++++++++++---- 3 files changed, 46 insertions(+), 8 deletions(-) diff --git a/src/main/cli.lisp b/src/main/cli.lisp index 1fff398..75ecd40 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -269,6 +269,17 @@ (defmethod execute-command ((command (eql :run)) args) (let - ((options '((:name :help :short "h" :long "help" :description "Print this usage.")))) - (standard-cli "run" options args :default nil - (when (not (candle:run)) (sb-ext:exit :code 1))))) + ((options + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :task :long "task" :variable-name "TASK" :takes-argument t :description "Run TASK")))) + (standard-cli "candle run" options args :default nil + (cond + ((opera:option-present :task parsed-options) + (let + ((tasks (candle:list-tasks)) + (specified-task (intern (string-upcase (opera:option-argument :task parsed-options)) :keyword))) + (if + (not (find specified-task (candle:list-tasks))) + (error-and-exit "Task ~(~A~) does not exist in .candle file" specified-task) + (candle:run specified-task)))) + (t (when (not (candle:run)) (sb-ext:exit :code 1))))))) diff --git a/src/main/package.lisp b/src/main/package.lisp index 6365450..fe0bc70 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,7 +1,7 @@ (defpackage #:candle (:use :cl) (:export #:server #:add-project #:delete-project #:refresh-project #:list-projects - #:project-branch-information #:run #:*candle-dir* #:*job-system* #:*candle-dir* #:failures + #:project-branch-information #:run #:list-tasks #:*candle-dir* #:*job-system* #:*candle-dir* #:failures #:project-job-information #:get-job-log #:retry-job #:job-project #:project-dir #:process-job-in-system #:shutdown-system diff --git a/src/main/run.lisp b/src/main/run.lisp index d979735..659beed 100644 --- a/src/main/run.lisp +++ b/src/main/run.lisp @@ -10,17 +10,40 @@ (progn (format t "~c[1;32m- ~:(~A~) Passed!~c[0m~%" #\Esc (getf task :name) #\Esc) t) (format t "~c[1;31m- ~:(~A~) Failed!~c[0m~%" #\Esc (getf task :name) #\Esc))) -(defun run () - "RUN => RESULT +(defun list-tasks () + "LIST-TASKS => TASKS + + TASKS: TASK* ARGUMENTS AND VALUES: + TASK: a keyword, representing a task that can be run + +DESCRIPTION: + + Get a list of tasks available in the current .candle file." + (if + (not (probe-file ".candle")) + :dot-candle-absent + (with-open-file (str ".candle") + (asdf:initialize-source-registry `(:source-registry (:tree ,(car (directory "."))) :INHERIT-CONFIGURATION)) + (mapcar #'import-package (cdr (read str))) + (mapcar (lambda (task) (getf task :name)) (getf (read str) :tasks))))) + +(defun run (&optional specified-task) + "RUN &optional SPECIFIED-TASK => RESULT + +ARGUMENTS AND VALUES: + + SPECIFIED-TASK: a keyword, the task to run RESULT: a boolean, whether the process was successful DESCRIPTION: Runs the script specified by the .candle file in the current directory. - When completed, the boolean will be returned if it was successful or not." + When completed, the boolean will be returned if it was successful or not. + + If SPECIFIED-TASK exists, only that task is run." (if (not (probe-file ".candle")) :dot-candle-absent @@ -30,4 +53,8 @@ DESCRIPTION: (let ((candle-definition (read str))) (format t "Running tasks for ~(~A~)~%" (getf candle-definition :name)) - (every #'identity (mapcar #'run-task (getf candle-definition :tasks))))))) + (every #'identity + (mapcar #'run-task + (remove-if + (lambda (task) (and specified-task (not (eql (getf task :name) specified-task)))) + (getf candle-definition :tasks)))))))) -- 2.25.1 From 21b721064ff5d76ed21602ae254e1765cc5e8cfd Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Mon, 27 Dec 2021 12:39:25 -0600 Subject: [PATCH 14/16] Exclude .git directory when transferring over files for aws --- src/main/aws/aws.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/main/aws/aws.lisp b/src/main/aws/aws.lisp index ad224af..c149985 100644 --- a/src/main/aws/aws.lisp +++ b/src/main/aws/aws.lisp @@ -97,6 +97,8 @@ "--delete" "-e" (format nil "ssh -o StrictHostKeyChecking=no -o UserKnownHostsFile=/dev/null -i ~A" *aws-keyfile*) + "--exclude" + ".git" (candle:project-dir (candle:job-project job)) (format nil "~A@~A:~A" *aws-username* (describe-property "PublicIpAddress") *remote-work-dir*))) (let* -- 2.25.1 From 22bc93248268f84257732f90fd383848ed262ca4 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Mon, 27 Dec 2021 12:40:20 -0600 Subject: [PATCH 15/16] Add environments for running --- src/main/aws/aws.lisp | 2 +- src/main/base.lisp | 16 ++++++++++++++++ src/main/cli.lisp | 6 +++++- src/main/package.lisp | 2 +- 4 files changed, 23 insertions(+), 3 deletions(-) diff --git a/src/main/aws/aws.lisp b/src/main/aws/aws.lisp index c149985..c7fb21d 100644 --- a/src/main/aws/aws.lisp +++ b/src/main/aws/aws.lisp @@ -118,7 +118,7 @@ "-i" *aws-keyfile* (describe-property "PublicIpAddress") - (format nil "cd ~A ; ~A run" *remote-work-dir* *remote-candle-location*)) + (format nil "cd ~A ; ~A run --env aws" *remote-work-dir* *remote-candle-location*)) :output out-str :error out-str :wait t))))) diff --git a/src/main/base.lisp b/src/main/base.lisp index f5995a4..793841a 100644 --- a/src/main/base.lisp +++ b/src/main/base.lisp @@ -16,6 +16,22 @@ DESCRIPTION: The main directory for all candle work to be done in. When the server is running in local mode, this is also the place that builds are built in") +(defvar *environment* :local + "*ENVIRONMENT* + +VALUE TYPE: + + A keyword + +INITIAL VALUE: + + :LOCAL + +DESCRIPTION: + + The environment that candle is currently running. Useful to do switching in tests + or in the .candle file to do extra boot up processing.") + (define-condition candle-error (error) ((reason :initarg :reason :reader candle-error-reason)) (:documentation diff --git a/src/main/cli.lisp b/src/main/cli.lisp index 75ecd40..697fb42 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -271,8 +271,12 @@ (let ((options '((:name :help :short "h" :long "help" :description "Print this usage.") - (:name :task :long "task" :variable-name "TASK" :takes-argument t :description "Run TASK")))) + (:name :task :long "task" :variable-name "TASK" :takes-argument t :description "Run TASK") + (:name :env :long "env" :variable-name "ENV" :takes-argument t + :description "Runs candle with *candle-environment* set to ENV as a keyword.")))) (standard-cli "candle run" options args :default nil + (when (opera:option-present :env parsed-options) + (setf candle:*environment* (intern (string-upcase (opera:option-argument :env parsed-options)) :keyword))) (cond ((opera:option-present :task parsed-options) (let diff --git a/src/main/package.lisp b/src/main/package.lisp index fe0bc70..90819d0 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -3,7 +3,7 @@ #:server #:add-project #:delete-project #:refresh-project #:list-projects #:project-branch-information #:run #:list-tasks #:*candle-dir* #:*job-system* #:*candle-dir* #:failures #:project-job-information #:get-job-log #:retry-job #:job-project #:project-dir #:process-job-in-system - #:shutdown-system + #:shutdown-system #:*environment* #:candle-error #:candle-error-reason) (:documentation "Main candle package. -- 2.25.1 From f2c8eef308265b5072dc7e9e41d70d72badad32b Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Mon, 27 Dec 2021 13:14:18 -0600 Subject: [PATCH 16/16] Docgen, checkstyle project renames --- .candle | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/.candle b/.candle index 6f5c6bb..37ca9f6 100644 --- a/.candle +++ b/.candle @@ -1,8 +1,8 @@ -(:packages :candle :style-checker :docgen) +(:packages :candle :wolf :sheep) (:name :candle :tasks - ((:name :checkstyle :directions - (syntax-checker:pretty-print-check-directory "src")) - (:name :docgen :directions - (docgen:pretty-print-validate-packages :candle)))) + ((:name :wolf :directions + (wolf:pretty-print-check-directory "src")) + (:name :sheep :directions + (sheep:pretty-print-validate-packages :candle)))) ; vim:ft=lisp -- 2.25.1