From a5fd76880291ea8135ee6b9a433082ed7fd11564 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Tue, 6 Jan 2026 18:56:24 -0700 Subject: [INF-18492] Automate Queue Retry and Log Streaming Retry octopus fix --- lisp/octopus/octopus.lisp | 142 +++++++++++++++++++++++++++------------------- 1 file changed, 84 insertions(+), 58 deletions(-) (limited to 'lisp/octopus') 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) -- cgit v1.3 From 96f33568bde918fc6012a413bc14188e88658652 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Wed, 7 Jan 2026 10:17:16 -0700 Subject: simplify deployment API call --- lisp/octopus/octopus.lisp | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'lisp/octopus') diff --git a/lisp/octopus/octopus.lisp b/lisp/octopus/octopus.lisp index a0b6d3d..3d933f5 100644 --- a/lisp/octopus/octopus.lisp +++ b/lisp/octopus/octopus.lisp @@ -335,10 +335,7 @@ as an input filter are stored here for the ride through the queue.") :params (json:encode-json-alist-to-string `((:*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)))))) + (:*release-id . ,(id (release octopus-deploy-release)))))))) (when deployment (make-instance 'octopus-deployment :id (cdr (assoc :*id deployment)) -- cgit v1.3 From 03843a52caabbf1cadec152d464cf27031f55f36 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Wed, 7 Jan 2026 11:12:56 -0700 Subject: filter bug --- lisp/octopus/octopus.lisp | 1 + 1 file changed, 1 insertion(+) (limited to 'lisp/octopus') diff --git a/lisp/octopus/octopus.lisp b/lisp/octopus/octopus.lisp index 3d933f5..c242d54 100644 --- a/lisp/octopus/octopus.lisp +++ b/lisp/octopus/octopus.lisp @@ -451,6 +451,7 @@ as an input filter are stored here for the ride through the queue.") (string= (id x) (cdr (assoc :*project-id deployment)))) projects) when (and (and environment project) + (filter-match-p environment-filter `(,(name environment))) (filter-match-p project-filter `(,(name project)))) collect (make-instance 'octopus-deployment :id (cdr (assoc :*id deployment)) -- cgit v1.3 From da4f53c33fa1faf267a536bc0a2c5a8dd2871c5e Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Wed, 7 Jan 2026 17:28:03 -0700 Subject: Fix environment lookup --- lisp/octopus/octopus.lisp | 17 ++++++++++++++++- lisp/service/octopus-qrs-lsrs-redeploy-service.lisp | 2 +- 2 files changed, 17 insertions(+), 2 deletions(-) (limited to 'lisp/octopus') diff --git a/lisp/octopus/octopus.lisp b/lisp/octopus/octopus.lisp index c242d54..61302bf 100644 --- a/lisp/octopus/octopus.lisp +++ b/lisp/octopus/octopus.lisp @@ -71,6 +71,9 @@ (version-control-reference :initarg :version-control-reference :initform nil :accessor version-control-reference) + (channel-id :initarg :channel-id + :initform nil + :accessor channel-id) (project :initarg :project :initform nil :accessor project)) @@ -89,6 +92,9 @@ (environment :initarg :environment :initform nil :accessor environment) + (channel-id :initarg :channel-id + :initform nil + :accessor channel-id) (project :initarg :project :initform nil :accessor project) @@ -176,6 +182,9 @@ as an input filter are stored here for the ride through the queue.") (release-version :initarg :release-version :initform nil :accessor release-version) + (channel-id :initarg :channel-id + :initform nil + :accessor channel-id) (git-commit :initarg :git-commit :initform nil :accessor git-commit) @@ -298,6 +307,7 @@ as an input filter are stored here for the ride through the queue.") :id (cdr (assoc :*id release)) :version (cdr (assoc :*version release)) :version-control-reference (cdr (assoc :*version-control-reference release)) + :channel-id (cdr (assoc :*channel-id release)) :project project)) (lambda (x y) (string< (version x) (version y))))) @@ -341,6 +351,7 @@ as an input filter are stored here for the ride through the queue.") :id (cdr (assoc :*id deployment)) :task-id (cdr (assoc :*task-id deployment)) :environment (environment octopus-deploy-release) + :channel-id (cdr (assoc :*channel-id deployment)) :project (project octopus-deploy-release) :release (release octopus-deploy-release))))) @@ -411,7 +422,9 @@ as an input filter are stored here for the ride through the queue.") (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)))))) + (environment (car (remove-if-not (lambda (x) + (string= (name x) (environment-name octopus-deploy-release))) + (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) @@ -457,6 +470,7 @@ as an input filter are stored here for the ride through the queue.") :id (cdr (assoc :*id deployment)) :task-id (cdr (assoc :*task-id deployment)) :release-version (cdr (assoc :*release-version deployment)) + :channel-id (cdr (assoc :*channel-id deployment)) :completed-time (local-time:to-rfc3339-timestring (local-time:parse-timestring (cdr (assoc :*completed-time deployment)))) :environment environment :project project)) @@ -479,6 +493,7 @@ as an input filter are stored here for the ride through the queue.") :deployment-id (id deployment) :task-id (task-id deployment) :release-version (release-version deployment) + :channel-id (channel-id deployment) :git-commit (cdr (assoc :*git-commit (version-control-reference (release deployment)))) :completed-time (completed-time deployment) :environment-name (name (environment deployment)) diff --git a/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp b/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp index a2d4a18..4796754 100644 --- a/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp +++ b/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp @@ -67,6 +67,6 @@ do (do-octopus-deploy-release (make-instance 'octopus-deploy-release :project-name (project-name deployment) :version (release-version deployment) - :environment-name (session-value :octopus-environment) + :environment-name (environment-name deployment) :stdout (pathname f))) (setf (stdout instance) (uiop:native-namestring (pathname f))))))) -- cgit v1.3