diff options
Diffstat (limited to 'lisp/octopus/octopus.lisp')
| -rw-r--r-- | lisp/octopus/octopus.lisp | 142 |
1 files changed, 84 insertions, 58 deletions
diff --git a/lisp/octopus/octopus.lisp b/lisp/octopus/octopus.lisp index 88712a3..a0b6d3d 100644 --- a/lisp/octopus/octopus.lisp +++ b/lisp/octopus/octopus.lisp @@ -136,16 +136,16 @@ as an input filter are stored here for the ride through the queue.") :accessor stdout)) (:documentation "")) -(defclass octopus-ode-deploy-release (octopus) +(defclass octopus-deploy-release (octopus) ((project-name :initarg :project-name :initform nil :accessor project-name) - (ode-names :initarg :ode-names - :initform nil - :accessor ode-names) (version :initarg :version :initform nil :accessor version) + (environment-name :initarg :environment-name + :initform nil + :accessor environment-name) (environment :initarg :environment :initform nil :accessor environment) @@ -160,6 +160,12 @@ as an input filter are stored here for the ride through the queue.") :accessor stdout)) (:documentation "")) +(defclass octopus-ode-deploy-release (octopus-deploy-release) + ((ode-names :initarg :ode-names + :initform nil + :accessor ode-names)) + (:documentation "")) + (defclass octopus-latest-deployment () ((deployment-id :initarg :deployment-id :initform nil @@ -230,27 +236,30 @@ as an input filter are stored here for the ride through the queue.") (define-octopus-api-call (get-octopus-items-process-steps-impl) (cdr (assoc :*steps response))) -(defmethod get-octopus-environments ((octopus octopus) &key ode-only-p filter) +(defmacro filter-match-p (filter &body body) + `(or (null ,filter) + (string= "all" (car ,filter)) + (intersection (loop for f in ,filter + when (not (string= "all" f)) + collect f) + ,@body + :test (lambda (x y) (org-ckons-core::match-it x y))))) + +(defmethod get-octopus-environments ((octopus octopus) &key ode-only-p environment-filter) (sort (loop for environment in (get-octopus-items-default-impl octopus "environments" :method :get :params `(("name" . ,(if ode-only-p "OnDemand-" "")))) - when (or (null filter) - (string= "all" (car filter)) - (intersection (loop for f in filter - when (not (string= "all" f)) - collect f) - `(,(cdr (assoc :*name environment))) - :test (lambda (x y) (org-ckons-core::match-it x y)))) + when (filter-match-p environment-filter `(,(cdr (assoc :*name environment)))) collect (make-instance 'octopus-environment :id (cdr (assoc :*id environment)) :name (cdr (assoc :*name environment)))) (lambda (x y) (string< (name x) (name y))))) -(defmethod get-octopus-ode-environments ((octopus octopus) &key filter) +(defmethod get-octopus-ode-environments ((octopus octopus) &key environment-filter) (get-octopus-environments octopus :ode-only-p t - :filter (if (string= "all" (car filter)) - filter - (loop for f in filter - collect (format nil "OnDemand-~a" f))))) + :environment-filter (if (string= "all" (car environment-filter)) + environment-filter + (loop for f in environment-filter + collect (format nil "OnDemand-~a" f))))) (defmethod get-octopus-projects ((octopus octopus)) (sort (loop for project in (get-octopus-items-default-impl octopus "projects" :method :get) @@ -319,14 +328,14 @@ as an input filter are stored here for the ride through the queue.") (lambda (x y) (string< (name x) (name y)))) :test (lambda (x y) (string= (name x) (name y)))))) -(defmethod do-octopus-deployment ((octopus-ode-deploy-release octopus-ode-deploy-release)) - (let ((deployment (get-octopus-items-raw-impl octopus-ode-deploy-release +(defmethod do-octopus-deployment ((octopus-deploy-release octopus-deploy-release)) + (let ((deployment (get-octopus-items-raw-impl octopus-deploy-release "deployments" :method :post :params (json:encode-json-alist-to-string - `((:*environment-id . ,(id (environment octopus-ode-deploy-release))) - (:*project-id . ,(id (project octopus-ode-deploy-release))) - (:*release-id . ,(id (release octopus-ode-deploy-release))) + `((:*environment-id . ,(id (environment octopus-deploy-release))) + (:*project-id . ,(id (project octopus-deploy-release))) + (:*release-id . ,(id (release octopus-deploy-release))) (:*use-guided-failure . nil) (:*force-package-download . t) (:*force-package-redeployment . t)))))) @@ -334,9 +343,9 @@ as an input filter are stored here for the ride through the queue.") (make-instance 'octopus-deployment :id (cdr (assoc :*id deployment)) :task-id (cdr (assoc :*task-id deployment)) - :environment (environment octopus-ode-deploy-release) - :project (project octopus-ode-deploy-release) - :release (release octopus-ode-deploy-release))))) + :environment (environment octopus-deploy-release) + :project (project octopus-deploy-release) + :release (release octopus-deploy-release))))) (defmethod get-octopus-task ((octopus octopus) task-id) (let ((task (get-octopus-items-raw-impl octopus (format nil "tasks/~a" task-id) :method :get))) @@ -364,58 +373,78 @@ as an input filter are stored here for the ride through the queue.") (defmethod get-octopus-projects-with-roles ((octopus-process-step octopus-process-step)) (enqueue *queue-octopus-fast* octopus-process-step)) -(defmethod bg-perform ((octopus-ode-deploy-release octopus-ode-deploy-release)) +(defmethod bg-perform ((octopus-deploy-release octopus-deploy-release)) (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)) - (deployment (do-octopus-deployment octopus-ode-deploy-release)) + (deployment (do-octopus-deployment octopus-deploy-release)) task) (with-output-to-string (stream output) (format stream "Deployed ~a ~a ~a ~a to ~a ~a~%" - (name (project octopus-ode-deploy-release)) - (id (project octopus-ode-deploy-release)) - (id (release octopus-ode-deploy-release)) + (name (project octopus-deploy-release)) + (id (project octopus-deploy-release)) + (id (release octopus-deploy-release)) (task-id deployment) - (id (environment octopus-ode-deploy-release)) - (name (environment octopus-ode-deploy-release))) + (id (environment octopus-deploy-release)) + (name (environment octopus-deploy-release))) (loop while (or (not task) (not (completed-p task))) do (sleep 15) - (setf task (get-octopus-task octopus-ode-deploy-release (task-id deployment)))) + (setf task (get-octopus-task octopus-deploy-release (task-id deployment)))) (when (not (successful-p task)) (format stream " ~a failed: ~a~%" (id task) (error-message task))) (format stream "~%")) - (with-open-file (stream (stdout octopus-ode-deploy-release) :direction :output :if-exists :append :if-does-not-exist :create) + (with-open-file (stream (stdout octopus-deploy-release) :direction :output :if-exists :append :if-does-not-exist :create) (format stream output)))) +(defmethod do-octopus-enqueue-deploy-release ((octopus-deploy-release octopus-deploy-release)) + (let ((job (make-instance 'octopus-deploy-release + :project-name (project-name octopus-deploy-release) + :version (version octopus-deploy-release) + :project (project octopus-deploy-release) + :release (release octopus-deploy-release) + :environment (environment octopus-deploy-release) + :stdout (stdout octopus-deploy-release)))) + (cond ((or (string= "Platform Database Release" (project-name octopus-deploy-release)) + (string= "Platform Release" (project-name octopus-deploy-release)) + (string= "Dispatch V2" (project-name octopus-deploy-release))) + (enqueue *queue-octopus-slow* job)) + (t + (enqueue *queue-octopus-fast* job))))) + +(defmethod do-octopus-deploy-release ((octopus-deploy-release octopus-deploy-release)) + (let* ((project (get-octopus-project octopus-deploy-release (project-name octopus-deploy-release))) + (release (get-octopus-release octopus-deploy-release project (version octopus-deploy-release))) + (environment (car (get-octopus-environments octopus-deploy-release :environment-filter `(,(environment-name octopus-deploy-release)))))) + (do-octopus-enqueue-deploy-release (make-instance 'octopus-deploy-release + :project-name (project-name octopus-deploy-release) + :version (version octopus-deploy-release) + :project project + :release release + :environment environment + :stdout (stdout octopus-deploy-release))))) + (defmethod do-octopus-ode-deploy-release ((octopus-ode-deploy-release octopus-ode-deploy-release)) (let* ((project (get-octopus-project octopus-ode-deploy-release (project-name octopus-ode-deploy-release))) (release (get-octopus-release octopus-ode-deploy-release project (version octopus-ode-deploy-release)))) (when (and project release) (loop for environment in (remove-if (lambda (x) (or (string= "OnDemand-oid" (name x)) (string= "OnDemand-verify" (name x)))) - (get-octopus-ode-environments octopus-ode-deploy-release :filter (ode-names octopus-ode-deploy-release))) - do (let ((job (make-instance 'octopus-ode-deploy-release - :project-name (project-name octopus-ode-deploy-release) - :ode-names (ode-names octopus-ode-deploy-release) - :version (version octopus-ode-deploy-release) - :project project - :release release - :environment environment - :stdout (stdout octopus-ode-deploy-release)))) - (cond ((or (string= "Platform Database Release" (project-name octopus-ode-deploy-release)) - (string= "Platform Release" (project-name octopus-ode-deploy-release)) - (string= "Dispatch V2" (project-name octopus-ode-deploy-release))) - (enqueue *queue-octopus-slow* job)) - (t - (enqueue *queue-octopus-fast* job)))))))) + (get-octopus-ode-environments octopus-ode-deploy-release :environment-filter (ode-names octopus-ode-deploy-release))) + do (do-octopus-enqueue-deploy-release (make-instance 'octopus-deploy-release + :project-name (project-name octopus-ode-deploy-release) + :version (version octopus-ode-deploy-release) + :project project + :release release + :environment environment + :stdout (stdout octopus-ode-deploy-release))))))) (defmethod get-octopus-deployments-successful ((octopus octopus)) (loop for deployment in (get-octopus-items-default-impl octopus "dashboard/dynamic" :method :get) when (string= (cdr (assoc :*state deployment)) "Success") collect deployment)) -(defmethod get-octopus-deployments ((octopus octopus) &key ode-only-p) - (let ((environments (get-octopus-environments octopus :ode-only-p ode-only-p :filter '("all"))) +(defmethod get-octopus-deployments ((octopus octopus) &key ode-only-p (environment-filter '("all")) (project-filter '("all"))) + (let ((environments (get-octopus-environments octopus :ode-only-p ode-only-p :environment-filter environment-filter)) (projects (get-octopus-projects octopus))) (sort (loop for deployment in (get-octopus-deployments-successful octopus) for environment = (find-if (lambda (x) @@ -424,7 +453,8 @@ as an input filter are stored here for the ride through the queue.") for project = (find-if (lambda (x) (string= (id x) (cdr (assoc :*project-id deployment)))) projects) - when (and environment project) + when (and (and environment project) + (filter-match-p project-filter `(,(name project)))) collect (make-instance 'octopus-deployment :id (cdr (assoc :*id deployment)) :task-id (cdr (assoc :*task-id deployment)) @@ -434,17 +464,13 @@ as an input filter are stored here for the ride through the queue.") :project project)) (lambda (x y) (string> (completed-time x) (completed-time y)))))) -(defmethod get-octopus-latest-deployments ((octopus octopus) &key ode-only-p) +(defmethod get-octopus-latest-deployments ((octopus octopus) &key ode-only-p (environment-filter '("all")) (project-filter '("all"))) (labels ((deployment-included-p (deployment deploy-hash) (and (not (intersection '("Feature Flags for Pipeline" "Channel Resource Release") `(,(name (project deployment))) :test 'string=)) - (not (org-ckons-core::match-it ".*-rc$" (release-version deployment))) - (not (org-ckons-core::match-it ".*-main$" (release-version deployment))) - (not (org-ckons-core::match-it "EKS" (name (project deployment)))) - (not (org-ckons-core::match-it "YARP" (name (project deployment)))) (or (not (gethash (name (environment deployment)) deploy-hash)) (string> (completed-time deployment) (completed-time (gethash (name (environment deployment)) deploy-hash))))))) (let ((deploy-hash (make-hash-table :test 'equal))) - (loop for deployment in (get-octopus-deployments octopus :ode-only-p ode-only-p) + (loop for deployment in (get-octopus-deployments octopus :ode-only-p ode-only-p :environment-filter environment-filter :project-filter project-filter) when (deployment-included-p deployment deploy-hash) do (let ((release (get-octopus-release octopus (project deployment) (release-version deployment)))) (when (version-control-reference release) |