From 10415e960ac74f2c07f693295b063c586ccc608f Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Sat, 18 Dec 2021 10:39:28 -0600 Subject: [PATCH] Formalize errors and error handling --- src/main/base.lisp | 3 +++ src/main/cli.lisp | 51 ++++++++++++++++++++++++++++--------------- src/main/package.lisp | 4 +++- src/main/server.lisp | 18 +++++++-------- 4 files changed, 48 insertions(+), 28 deletions(-) diff --git a/src/main/base.lisp b/src/main/base.lisp index 42518ae..871da36 100644 --- a/src/main/base.lisp +++ b/src/main/base.lisp @@ -2,6 +2,9 @@ (defvar *candle-dir*) +(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) ; Status here is: diff --git a/src/main/cli.lisp b/src/main/cli.lisp index fe36dfb..fb38f58 100644 --- a/src/main/cli.lisp +++ b/src/main/cli.lisp @@ -2,8 +2,12 @@ (defgeneric execute-command (command args)) +(defun error-and-exit (str &rest args) + (apply #'format *error-output* str args) + (sb-ext:exit :code 1)) + (defmethod execute-command (command args) - (format *error-output* "Unknown command '~(~A~)'. See 'candle --help'.~%" command)) + (error-and-exit "Unknown command '~(~A~)'. See 'candle --help'.~%" command)) (defun job-info->line (job-info) (format nil "~A (~A) ~A" @@ -23,10 +27,11 @@ ((opera:option-present :help parsed-options) (format t "~A" ,(if (eql usage :default) `(opera:usage ,cmd ,options-in) usage))) ((eql error :unknown-option) - (format *error-output* "Unknown option: ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) + (error-and-exit "Unknown option: ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) ((eql error :required-argument-missing) - (format *error-output* "Missing argument for ~A. See '~A --help'.~%" (car remaining-args) ,cmd)) - ((and ,remaining-args-required (not remaining-args)) (format *error-output* "~A required. See 'candle --help'.~%" ,remaining-args-required)) + (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)))) @@ -34,17 +39,27 @@ (defun run () (standard-cli "candle" (main-options) (cdr sb-ext:*posix-argv*) (main-usage) "Command" - (if - (and (opera:option-present :port parsed-options) (not (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t))) - (format *error-output* "--port requires a number. See 'candle -h'~%") - (let - ((communication:*query-port* - (or - (and - (opera:option-present :port parsed-options) - (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t)) - 25004))) - (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))) + (handler-case + (if + (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* + (or + (and + (opera:option-present :port parsed-options) + (parse-integer (opera:option-argument :port parsed-options) :junk-allowed t)) + 25004))) + (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))) + (candle:candle-error (e) + (case (candle:candle-error-reason e) + (:project-does-not-exist (error-and-exit "Project does not exist~%")) + (:job-does-not-exist (error-and-exit "Job does not exist~%")) + (:invalid-project-name (error-and-exit "Project name invalid~%")) + (:invalid-project-uri (error-and-exit "Project uri invalid~%")) + (:project-name-taken (error-and-exit "Project name already taken~%")) + (:project-failed-to-get-branches (error-and-exit "Unable to retrieve branches from server~%")) + (t (error-and-exit "Unknown error occurred: ~(~S~)~%" (candle:candle-error-reason e)))))))) (defun main-options () '((:name :help :short "h" :long "help" :description "Print this usage.") @@ -101,7 +116,7 @@ ((project-definition (car remaining-args)) (pos (position #\: project-definition))) (cond - ((not pos) (format *error-output* "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)) @@ -210,7 +225,7 @@ (multiple-value-bind (project-name sha) (decompose-job-definition (car remaining-args)) (if project-name (format t "~A" (communication:query `(candle:get-job-log ,project-name ,sha))) - (format *error-output* "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) + (error-and-exit "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) (defun retry-job (args) (let @@ -223,7 +238,7 @@ (progn (communication:query `(candle:retry-job ,project-name ,sha)) (format t "Retrying job ~A~%" (car remaining-args))) - (format *error-output* "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) + (error-and-exit "Job definition ~A is not valid. See 'candle job log --help'.~%" (car remaining-args))))))) ;;; Section for ./candle run diff --git a/src/main/package.lisp b/src/main/package.lisp index f9a1d70..9d04cea 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -3,7 +3,9 @@ #:server #:add-project #:delete-project #:refresh-project #:list-projects #:project-branch-information #:run #:*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 + + #:candle-error #:candle-error-reason)) (defpackage #:candle-cli (:use :cl) (:export :run)) (defpackage #:candle-aws (:use :cl)) diff --git a/src/main/server.lisp b/src/main/server.lisp index ffd6e82..035ba4c 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -47,13 +47,13 @@ (defun add-project (name src) (when (not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name)) - (error "Name contains invalid characters")) + (raise-candle-error :invalid-project-name)) (when (not (git nil "ls-remote" src)) - (error "Project uri is not a valid git repository")) + (raise-candle-error :invalid-project-uri)) (when (find name *all-project* :test #'string= :key #'project-name) - (error "Project name already taken")) + (raise-candle-error :project-name-taken)) (let ((project (make-project :name name :src src))) (ensure-directories-exist (project-dir project)) @@ -68,7 +68,7 @@ (git project "fetch" "origin" "--prune") (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*") (declare (ignore code err)) - (when (not success) (error "Failed to get branches")) + (when (not success) (raise-candle-error :project-failed-to-get-branches)) (mapcar (lambda (branch) (set-branch-in-git branch nil)) branches) (mapcar (lambda (line) @@ -90,7 +90,7 @@ (defun delete-project (name) (let ((project (find name *all-project* :test #'string= :key #'project-name))) - (when (not project) (error "Project does not exist")) + (when (not project) (raise-candle-error :project-does-not-exist)) (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)) @@ -102,7 +102,7 @@ (defun project-branch-information (name) (let ((project (find name *all-project* :test #'string= :key #'project-name))) - (when (not project) (error "Project does not exist")) + (when (not project) (raise-candle-error :project-does-not-exist)) (mapcar (lambda (branch) (list @@ -113,7 +113,7 @@ (defun project-job-information (name) (let ((project (when name (find name *all-project* :test #'string= :key #'project-name)))) - (when (and name (not project)) (error "Project does not exist")) + (when (and name (not project)) (raise-candle-error :project-does-not-exist)) (mapcar #'job->job-information (if project (find-job-by-project project) @@ -129,8 +129,8 @@ (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) (error "Project does not exist")) - (when (not job) (error "Job does not exist")) + (when (not project) (raise-candle-error :project-does-not-exist)) + (when (not job) (raise-candle-error :job-does-not-exist)) job)) (defun get-job-log (project-name sha) -- 2.25.1