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/service/menu-service.lisp | 5 +- .../octopus-environments-with-roles-service.lisp | 4 +- .../octopus-latest-deployments-service.lisp | 13 +++- .../octopus-machines-with-roles-service.lisp | 2 +- .../octopus-ode-deploy-release-service.lisp | 2 +- .../octopus-projects-with-roles-service.lisp | 4 +- .../service/octopus-qrs-lsrs-redeploy-service.lisp | 72 ++++++++++++++++++++++ lisp/service/rest-service.lisp | 3 + 8 files changed, 92 insertions(+), 13 deletions(-) create mode 100644 lisp/service/octopus-qrs-lsrs-redeploy-service.lisp (limited to 'lisp/service') diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp index ba6e934..ae9fca5 100644 --- a/lisp/service/menu-service.lisp +++ b/lisp/service/menu-service.lisp @@ -11,8 +11,9 @@ (:id "a_menu_octopus_machines_with_roles" :label "Octo Machines With Roles" :handler "/octopus-machines-with-roles" :permissions "t") (:id "a_menu_octopus_environments_with_roles" :label "Octo Envs With Roles" :handler "/octopus-environments-with-roles" :permissions "t") (:id "a_menu_octopus_projects_with_roles" :label "Octo Projects With Roles" :handler "/octopus-projects-with-roles" :permissions "t") - (:id "a_menu_octopus_ode_deploy_release" :label "Deploy Octo Release to ODEs" :handler "/octopus-ode-deploy-release" :permissions "t") - (:id "a_menu_octopus_latest_deployments" :label "Octo Latest Deployments" :handler "/octopus-latest-deployments" :permissions "t"))) + (:id "a_menu_octopus_ode_deploy_release" :label "Octo Deploy Release to ODEs" :handler "/octopus-ode-deploy-release" :permissions "t") + (:id "a_menu_octopus_latest_deployments" :label "Octo Latest Deployments" :handler "/octopus-latest-deployments" :permissions "t") + (:id "a_menu_octopus_qrs_lsrs_redeploy" :label "Octo QRS/LSRS Redeploy" :handler "/octopus-qrs-lsrs-redeploy" :permissions "t"))) (defclass menuitem () ((id :initarg :id diff --git a/lisp/service/octopus-environments-with-roles-service.lisp b/lisp/service/octopus-environments-with-roles-service.lisp index 8cd494e..588d32d 100644 --- a/lisp/service/octopus-environments-with-roles-service.lisp +++ b/lisp/service/octopus-environments-with-roles-service.lisp @@ -40,8 +40,6 @@ (with-octopus (octopus) (let ((environments (get-octopus-environments-with-roles octopus :ode-only-p (string= "true" ode_only_p) - :roles (remove-if (lambda (x) - (org-ckons-core::null-or-empty-p x)) - (cl-ppcre:split "[, ]" roles))))) + :roles (split-text-input roles)))) (setf (results instance) environments) (setf (session-value :octopus-roles) roles))))) diff --git a/lisp/service/octopus-latest-deployments-service.lisp b/lisp/service/octopus-latest-deployments-service.lisp index 4b786bd..63a163d 100644 --- a/lisp/service/octopus-latest-deployments-service.lisp +++ b/lisp/service/octopus-latest-deployments-service.lisp @@ -25,6 +25,8 @@ nil t `((:name "ode_only_p" :label "ODE only?" :field-type "checkbox") + (:name "environment" :label "Environment" :field-type "text" :value ,(or (session-value :octopus-environment) "")) + (:name "project" :label "Project" :field-type "text" :value ,(or (session-value :octopus-project) "")) (:label "Find Latest Deployments" :field-type "button" :onclick "on_octopus_latest_deployments_results_clicked()")))))) (defclass octopus-latest-deployments/results-service (octopus-latest-deployments/view-service) @@ -34,8 +36,13 @@ (location-p :initform nil)) (:documentation "")) -(defun octopus-latest-deployments-results-json (ode_only_p) +(defun octopus-latest-deployments-results-json (ode_only_p environment project) (with-noauth (instance octopus-latest-deployments/results-service) (with-octopus (octopus) - (let ((deployments (get-octopus-latest-deployments octopus :ode-only-p (string= "true" ode_only_p)))) - (setf (results instance) deployments))))) + (let ((deployments (get-octopus-latest-deployments octopus + :ode-only-p (string= "true" ode_only_p) + :environment-filter `(,environment) + :project-filter `(,project)))) + (setf (results instance) deployments) + (setf (session-value :octopus-environment) environment) + (setf (session-value :octopus-project) project))))) diff --git a/lisp/service/octopus-machines-with-roles-service.lisp b/lisp/service/octopus-machines-with-roles-service.lisp index b9bf74f..e20d55f 100644 --- a/lisp/service/octopus-machines-with-roles-service.lisp +++ b/lisp/service/octopus-machines-with-roles-service.lisp @@ -37,6 +37,6 @@ (defun octopus-machines-with-roles-results-json (roles) (with-noauth (instance octopus-machines-with-roles/results-service) (with-octopus (octopus) - (let ((machines (get-octopus-machines-with-roles octopus (remove-if (lambda (x) (org-ckons-core::null-or-empty-p x)) (cl-ppcre:split "[, ]" roles))))) + (let ((machines (get-octopus-machines-with-roles octopus (split-text-input roles)))) (setf (results instance) (loop for machine in machines collect (sanitize machine))) (setf (session-value :octopus-roles) roles))))) diff --git a/lisp/service/octopus-ode-deploy-release-service.lisp b/lisp/service/octopus-ode-deploy-release-service.lisp index 411fc15..924eddd 100644 --- a/lisp/service/octopus-ode-deploy-release-service.lisp +++ b/lisp/service/octopus-ode-deploy-release-service.lisp @@ -42,7 +42,7 @@ (do-octopus-ode-deploy-release (make-instance 'octopus-ode-deploy-release :project-name project_name :version version - :ode-names (cl-ppcre:split "[, ]" ode_names) + :ode-names (split-text-input ode_names) :stdout (pathname f))) (setf (stdout instance) (uiop:native-namestring (pathname f)))) (setf (session-value :octopus-project-name) project_name) diff --git a/lisp/service/octopus-projects-with-roles-service.lisp b/lisp/service/octopus-projects-with-roles-service.lisp index 627f346..ee55782 100644 --- a/lisp/service/octopus-projects-with-roles-service.lisp +++ b/lisp/service/octopus-projects-with-roles-service.lisp @@ -38,9 +38,7 @@ (with-noauth (instance octopus-projects-with-roles/results-service) (cl-fad:with-output-to-temporary-file (f :template "/tmp/snow/temp-%") (get-octopus-projects-with-roles (make-instance 'octopus-process-step - :target-roles (remove-if (lambda (x) - (org-ckons-core::null-or-empty-p x)) - (cl-ppcre:split "[, ]" roles)) + :target-roles (split-text-input roles) :stdout (pathname f))) (setf (stdout instance) (uiop:native-namestring (pathname f)))) (setf (session-value :octopus-roles) roles))) diff --git a/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp b/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp new file mode 100644 index 0000000..a2d4a18 --- /dev/null +++ b/lisp/service/octopus-qrs-lsrs-redeploy-service.lisp @@ -0,0 +1,72 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :snow) + +(defclass octopus-qrs-lsrs-redeploy-service (rest-service) + () + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-json () + (with-noauth (instance octopus-qrs-lsrs-redeploy-service) + t)) + +(defclass octopus-qrs-lsrs-redeploy/view-service (octopus-qrs-lsrs-redeploy-service) + ((form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-view-json () + (with-noauth (instance octopus-qrs-lsrs-redeploy/view-service) + (setf (form instance) + (make-form "octopus-qrs-lsrs-redeploy-form" + nil + t + `((:name "environment" :label "Environment" :field-type "text" :required "required" :value ,(or (session-value :octopus-environment) "")) + (:label "Find Latest QRS/LSRS in Environment" :field-type "button" :onclick "on_octopus_qrs_lsrs_redeploy_results_clicked()")))))) + +(defclass octopus-qrs-lsrs-redeploy/results-service (octopus-qrs-lsrs-redeploy/view-service) + ((results :initarg :results + :initform nil + :accessor results) + (location-p :initform nil)) + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-results-json (environment) + (with-noauth (instance octopus-latest-deployments/results-service) + (with-octopus (octopus) + (let* ((projects '("Queue Retry Service" "Log Streaming Retry Service")) + (deployments (org-ckons-core::flatten + (loop for project in projects + collect (get-octopus-latest-deployments octopus + :ode-only-p nil + :environment-filter `(,environment) + :project-filter `(,project)))))) + (setf (session-value :octopus-environment) environment) + (setf (session-value :octopus-qrs-lsrs-redeploy-deployments) deployments) + (setf (results instance) deployments) + (setf (form instance) + (make-form "octopus-qrs-lsrs-redeploy-submit-form" + nil + t + `((:label "Redeploy QRS/LSRS" :field-type "button" :onclick "on_octopus_qrs_lsrs_redeploy_results_submit_clicked()")))))))) + +(defclass octopus-qrs-lsrs-redeploy/results-submit-service (octopus-qrs-lsrs-redeploy-service) + ((stdout :initarg :stdout + :initform nil + :accessor stdout) + (location-p :initform nil)) + (:documentation "")) + +(defun octopus-qrs-lsrs-redeploy-results-submit-json () + (with-noauth (instance octopus-qrs-lsrs-redeploy/results-submit-service) + (cl-fad:with-output-to-temporary-file (f :template "/tmp/snow/temp-%") + (loop for deployment in (session-value :octopus-qrs-lsrs-redeploy-deployments) + 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) + :stdout (pathname f))) + (setf (stdout instance) (uiop:native-namestring (pathname f))))))) diff --git a/lisp/service/rest-service.lisp b/lisp/service/rest-service.lisp index a060863..7941630 100644 --- a/lisp/service/rest-service.lisp +++ b/lisp/service/rest-service.lisp @@ -34,3 +34,6 @@ (defun type-to-path (rest-type) (concatenate 'string "/" (ppcre:regex-replace "-service" (string-downcase (type-of rest-type)) "/"))) + +(defun split-text-input (input) + (remove-if (lambda (x) (org-ckons-core::null-or-empty-p x)) (cl-ppcre:split "[, ]" input))) -- cgit v1.3