From 116554ad7fe82bf7df08be4ee8732e306eac38f1 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Thu, 18 Dec 2025 15:03:55 -0700 Subject: [INF-18465] Create an unhealthy targetgroup report --- lisp/aws/aws.lisp | 102 +++++++++++++++++++++ lisp/service/menu-service.lisp | 1 + .../octopus-projects-with-roles-service.lisp | 4 +- lisp/service/unhealthy-targetgroups-service.lisp | 50 ++++++++++ lisp/snow.asd | 1 + lisp/webapps/snow/clojurescript/snow/src/core.cljs | 67 ++++++++++++++ lisp/webapps/snow/site.lisp | 12 +++ 7 files changed, 236 insertions(+), 1 deletion(-) create mode 100644 lisp/service/unhealthy-targetgroups-service.lisp (limited to 'lisp') diff --git a/lisp/aws/aws.lisp b/lisp/aws/aws.lisp index f5d6b93..ab6dcc8 100644 --- a/lisp/aws/aws.lisp +++ b/lisp/aws/aws.lisp @@ -81,6 +81,48 @@ :accessor passphrase)) (:documentation "")) +(defclass aws-targetgroup (aws) + ((name :initarg :name + :initform nil + :accessor name) + (arn :initarg :arn + :initform nil + :accessor arn) + (protocol :initarg :protocol + :initform nil + :accessor protocol) + (port :initarg :port + :initform nil + :accessor port) + (healthy-p :initarg :healthy-p + :initform nil + :accessor healthy-p) + (stdout :initarg :stdout + :initform nil + :accessor stdout) + (filter :initarg :filter + :initform nil + :accessor filter) + (targets :initarg :targets + :initform nil + :accessor targets)) + (:documentation "")) + +(defclass aws-target () + ((instance-id :initarg :instance-id + :initform nil + :accessor instance-id) + (port :initarg :port + :initform nil + :accessor port) + (state :initarg :state + :initform nil + :accessor state) + (healthy-p :initarg :healthy-p + :initform nil + :accessor healthy-p)) + (:documentation "")) + (defclass aws-ssm-parameter (aws) ((name :initarg :name :initform nil @@ -130,6 +172,66 @@ :instances (loop for instance in (cdr (assoc :*instances asg)) collect (cdr (assoc :*instance-id instance))))))) +(defmethod get-targetgroups ((aws-targetgroup aws-targetgroup)) + (let ((command "aws elbv2 describe-target-groups")) + (sort (loop for targetgroup in (cdar (run-aws-cli aws-targetgroup command)) + when (org-ckons-core::match-it (if (string= (filter aws-targetgroup) "all") + "" + (filter aws-targetgroup)) + (cdr (assoc :*target-group-name targetgroup))) + collect (let ((targetgroup (make-instance 'aws-targetgroup + :profile (profile aws-targetgroup) + :region (region aws-targetgroup) + :name (cdr (assoc :*target-group-name targetgroup)) + :arn (cdr (assoc :*target-group-arn targetgroup)) + :protocol (cdr (assoc :*protocol targetgroup)) + :port (cdr (assoc :*port targetgroup))))) + (setf (targets targetgroup) (get-targets targetgroup)) + (setf (healthy-p targetgroup) (get-targetgroup-health targetgroup)) + targetgroup)) + (lambda (x y) (string< (name x) (name y)))))) + +(defmethod get-targets ((aws-targetgroup aws-targetgroup)) + (let ((command (format nil + "aws elbv2 describe-target-health --target-group-arn ~a" + (arn aws-targetgroup)))) + (loop for target in (cdar (run-aws-cli aws-targetgroup command)) + collect (make-instance 'aws-target + :instance-id (cdr (assoc :*id (cdr (assoc :*target target)))) + :port (cdr (assoc :*port (cdr (assoc :*target target)))) + :state (cdr (assoc :*state (cdr (assoc :*target-health target)))) + :healthy-p (string= (cdr (assoc :*state (cdr (assoc :*target-health target)))) "healthy"))))) + +(defmethod get-targetgroup-health ((aws-targetgroup aws-targetgroup)) + (let ((states (loop for target in (targets aws-targetgroup) + collect (healthy-p target)))) + (= (length states) + (length (remove-if 'null states))))) + +(defmethod get-aws-unhealthy-targetgroups ((aws-targetgroup aws-targetgroup)) + (enqueue *queue-aws* aws-targetgroup)) + +(defmethod bg-perform ((aws-targetgroup aws-targetgroup)) + (let ((output (make-array '(0) :element-type 'character :fill-pointer 0 :adjustable t)) + (targetgroups (get-targetgroups aws-targetgroup))) + (with-output-to-string (stream output) + (loop for targetgroup in targetgroups + when (not (healthy-p targetgroup)) + do (format stream + "~a~t~a~t~a~%" + (name targetgroup) + (arn targetgroup) + (port targetgroup)) + (loop for target in (targets targetgroup) + when (not (healthy-p target)) + do (format stream + "~t~a~t~a~%" + (instance-id target) + (state target))) + (format stream "~%"))) + (with-open-file (stream (stdout aws-targetgroup) :direction :output :if-exists :append :if-does-not-exist :create) + (format stream output)))) + (defmethod get-certificates ((aws aws) &optional filter) (sort (loop for cert in (cdr (assoc :*certificate-summary-list (run-aws-cli aws "aws acm list-certificates"))) when (or (and (null filter) diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp index 7911e32..1c50f3d 100644 --- a/lisp/service/menu-service.lisp +++ b/lisp/service/menu-service.lisp @@ -6,6 +6,7 @@ (defparameter *menu-config* '((:id "a_menu_home" :label "Home" :handler "/home" :permissions "t") (:id "a_menu_git_update" :label "Git Update" :handler "/git-update" :permissions "t") (:id "a_menu_asg_recycle" :label "ASG Recycle" :handler "/asg-recycle" :permissions "t") + (:id "a_menu_unhealthy_targetgroups" :label "Find Unhealthy Targetgroups" :handler "/unhealthy-targetgroups" :permissions "t") (:id "a_menu_tfcloud_apply" :label "TFCloud Apply" :handler "/tfcloud-apply" :permissions "t") (: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") diff --git a/lisp/service/octopus-projects-with-roles-service.lisp b/lisp/service/octopus-projects-with-roles-service.lisp index c3d9a67..627f346 100644 --- a/lisp/service/octopus-projects-with-roles-service.lisp +++ b/lisp/service/octopus-projects-with-roles-service.lisp @@ -38,7 +38,9 @@ (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 (remove-if (lambda (x) + (org-ckons-core::null-or-empty-p x)) + (cl-ppcre:split "[, ]" roles)) :stdout (pathname f))) (setf (stdout instance) (uiop:native-namestring (pathname f)))) (setf (session-value :octopus-roles) roles))) diff --git a/lisp/service/unhealthy-targetgroups-service.lisp b/lisp/service/unhealthy-targetgroups-service.lisp new file mode 100644 index 0000000..578fe9c --- /dev/null +++ b/lisp/service/unhealthy-targetgroups-service.lisp @@ -0,0 +1,50 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- +(declaim (optimize (speed 0) (safety 3) (debug 3))) + +(in-package :snow) + +(defclass unhealthy-targetgroups-service (rest-service) + () + (:documentation "")) + +(defun unhealthy-targetgroups-json () + (with-noauth (instance unhealthy-targetgroups-service) + t)) + +(defclass unhealthy-targetgroups/view-service (unhealthy-targetgroups-service) + ((form :initarg :form + :initform nil + :accessor form) + (location-p :initform nil)) + (:documentation "")) + +(defun unhealthy-targetgroups-view-json () + (with-noauth (instance unhealthy-targetgroups/view-service) + (setf (form instance) + (make-form "unhealthy-targetgroups-form" + nil + t + `((:name "profile" :label "Profile" :field-type "text" :required "required" :value ,(or (session-value :profile) "")) + (:name "region" :label "Region" :field-type "text" :required "required" :value ,(or (session-value :region) (region *webapp*))) + (:name "filter" :label "Filter" :field-type "text" :required "required" :value ,(or (session-value :unhealthy-targetgroup-filter) "")) + (:label "Find Unhealthy Targetgroups" :field-type "button" :onclick "on_unhealthy_targetgroups_results_clicked()")))))) + +(defclass unhealthy-targetgroups/results-service (unhealthy-targetgroups/view-service) + ((stdout :initarg :stdout + :initform nil + :accessor stdout) + (location-p :initform nil)) + (:documentation "")) + +(defun unhealthy-targetgroups-results-json (profile region filter) + (with-noauth (instance unhealthy-targetgroups/results-service) + (cl-fad:with-output-to-temporary-file (f :template "/tmp/snow/temp-%") + (get-aws-unhealthy-targetgroups (make-instance 'aws-targetgroup + :profile profile + :region region + :filter filter + :stdout (pathname f))) + (setf (stdout instance) (uiop:native-namestring (pathname f)))) + (setf (session-value :profile) profile) + (setf (session-value :region) region) + (setf (session-value :unhealthy-targetgroup-filter) filter))) diff --git a/lisp/snow.asd b/lisp/snow.asd index b8624c3..e9bc646 100644 --- a/lisp/snow.asd +++ b/lisp/snow.asd @@ -62,6 +62,7 @@ (:file "home-service" :depends-on ("auth-service")) (:file "git-update-service" :depends-on ("auth-service")) (:file "asg-recycle-service" :depends-on ("auth-service")) + (:file "unhealthy-targetgroups-service" :depends-on ("auth-service")) (:file "tfcloud-apply-service" :depends-on ("auth-service")) (:file "octopus-machines-with-roles-service" :depends-on ("auth-service")) (:file "octopus-environments-with-roles-service" :depends-on ("auth-service")) diff --git a/lisp/webapps/snow/clojurescript/snow/src/core.cljs b/lisp/webapps/snow/clojurescript/snow/src/core.cljs index 304e5ec..922df5a 100644 --- a/lisp/webapps/snow/clojurescript/snow/src/core.cljs +++ b/lisp/webapps/snow/clojurescript/snow/src/core.cljs @@ -50,6 +50,16 @@ (declare template-asg-recycle-results-submit) (declare handler-asg-recycle-results-submit) (declare render-asg-recycle-results-submit) +(declare template-unhealthy-targetgroups) +(declare handler-unhealthy-targetgroups) +(declare render-unhealthy-targetgroups) +(declare template-unhealthy-targetgroups-view) +(declare handler-unhealthy-targetgroups-view) +(declare render-unhealthy-targetgroups-view) +(declare on-unhealthy-targetgroups-results-clicked) +(declare template-unhealthy-targetgroups-results) +(declare handler-unhealthy-targetgroups-results) +(declare render-unhealthy-targetgroups-results) (declare template-tfcloud-apply) (declare handler-tfcloud-apply) (declare render-tfcloud-apply) @@ -247,6 +257,7 @@ (hiccups/defhtml template-asg-recycle [jsonobj] [:h3 {:style "text-align: center"} "Recycle the ASGs matching the filter."] + [:h5 {:style "text-align: center"} "For all ASGs please specify `all` for the filter."] [:div {:id "content"}] [:div {:id "results-submit-ack"}] [:div {:id "results-submit"}] @@ -325,6 +336,61 @@ :params {:howmany howmany} :handler handler-asg-recycle-results-submit})) +;; unhealthy-targetgroups + +(hiccups/defhtml template-unhealthy-targetgroups [jsonobj] + [:h3 {:style "text-align: center"} "Find all unhealthy targetgroups matching the filter."] + [:h5 {:style "text-align: center"} "For all targetgroups please specify `all` for the filter."] + [:div {:id "content"}] + [:div {:id "results"}]) + +(defn handler-unhealthy-targetgroups [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#body) (template-unhealthy-targetgroups jsonobj)) + (render-unhealthy-targetgroups-view))) + +(defn render-unhealthy-targetgroups [] + (GET "/unhealthy-targetgroups" {:handler handler-unhealthy-targetgroups})) + +;; unhealthy-targetgroups-view + +(hiccups/defhtml template-unhealthy-targetgroups-view [jsonobj] + (ck-form/template-generic-form (get jsonobj "form") (namespace ::x))) + +(defn handler-unhealthy-targetgroups-view [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#content) (template-unhealthy-targetgroups-view jsonobj)))) + +(defn render-unhealthy-targetgroups-view [] + (GET "/unhealthy-targetgroups/view" {:handler handler-unhealthy-targetgroups-view})) + +;; unhealthy-targetgroups-results + +(defn on-unhealthy-targetgroups-results-clicked [] + (when (-> (jquery "#unhealthy-targetgroups-form") + (.get "0") + (.checkValidity)) + (dommy/set-html! (dommy/sel1 :#results) (template-generic-wait)) + (render-unhealthy-targetgroups-results))) + +(hiccups/defhtml template-unhealthy-targetgroups-results [jsonobj] + [:h5 {:style "text-align: center"} + "Process started in background. See the output at " [:code (get jsonobj "stdout")]]) + +(defn handler-unhealthy-targetgroups-results [response] + (let [jsonobj (js->clj (js/JSON.parse response))] + (notifications jsonobj) + (dommy/set-html! (dommy/sel1 :#results) (template-unhealthy-targetgroups-results jsonobj)))) + +(defn render-unhealthy-targetgroups-results [] + (POST "/unhealthy-targetgroups/results" {:format :raw + :params {:profile (dommy/value (dommy/sel1 :#profile)) + :region (dommy/value (dommy/sel1 :#region)) + :filter (dommy/value (dommy/sel1 :#filter))} + :handler handler-unhealthy-targetgroups-results})) + ;; tfcloud-apply (hiccups/defhtml template-tfcloud-apply [jsonobj] @@ -676,6 +742,7 @@ (cond (= handler "/home") (render-home)) (cond (= handler "/git-update") (render-git-update)) (cond (= handler "/asg-recycle") (render-asg-recycle)) + (cond (= handler "/unhealthy-targetgroups") (render-unhealthy-targetgroups)) (cond (= handler "/tfcloud-apply") (render-tfcloud-apply)) (cond (= handler "/octopus-machines-with-roles") (render-octopus-machines-with-roles)) (cond (= handler "/octopus-environments-with-roles") (render-octopus-environments-with-roles)) diff --git a/lisp/webapps/snow/site.lisp b/lisp/webapps/snow/site.lisp index 868a188..d1091ad 100644 --- a/lisp/webapps/snow/site.lisp +++ b/lisp/webapps/snow/site.lisp @@ -68,6 +68,15 @@ (defmacro .asg-recycle-results-submit () `(asg-recycle-results-submit-json howmany)) +(defmacro .unhealthy-targetgroups () + `(unhealthy-targetgroups-json)) + +(defmacro .unhealthy-targetgroups-view () + `(unhealthy-targetgroups-view-json)) + +(defmacro .unhealthy-targetgroups-results () + `(unhealthy-targetgroups-results-json profile region filter)) + (defmacro .tfcloud-apply () `(tfcloud-apply-json)) @@ -137,6 +146,9 @@ (define-endpoint :get "/asg-recycle/view" () .asg-recycle-view) (define-endpoint :post "/asg-recycle/results" ((profile :parameter-type 'string) (region :parameter-type 'string) (filter :parameter-type 'string)) .asg-recycle-results) (define-endpoint :post "/asg-recycle/results/submit" ((howmany :parameter-type 'string)) .asg-recycle-results-submit) +(define-endpoint :get "/unhealthy-targetgroups" () .unhealthy-targetgroups) +(define-endpoint :get "/unhealthy-targetgroups/view" () .unhealthy-targetgroups-view) +(define-endpoint :post "/unhealthy-targetgroups/results" ((profile :parameter-type 'string) (region :parameter-type 'string) (filter :parameter-type 'string)) .unhealthy-targetgroups-results) (define-endpoint :get "/tfcloud-apply" () .tfcloud-apply) (define-endpoint :get "/tfcloud-apply/view" () .tfcloud-apply-view) (define-endpoint :post "/tfcloud-apply/results" ((filter :parameter-type 'string)) .tfcloud-apply-results) -- cgit v1.3 From 16e45f92cc92bc1e61659be66567131de18a9a96 Mon Sep 17 00:00:00 2001 From: ckonstanski Date: Thu, 18 Dec 2025 15:11:29 -0700 Subject: menu text change --- lisp/service/menu-service.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp') diff --git a/lisp/service/menu-service.lisp b/lisp/service/menu-service.lisp index 1c50f3d..ba6e934 100644 --- a/lisp/service/menu-service.lisp +++ b/lisp/service/menu-service.lisp @@ -6,7 +6,7 @@ (defparameter *menu-config* '((:id "a_menu_home" :label "Home" :handler "/home" :permissions "t") (:id "a_menu_git_update" :label "Git Update" :handler "/git-update" :permissions "t") (:id "a_menu_asg_recycle" :label "ASG Recycle" :handler "/asg-recycle" :permissions "t") - (:id "a_menu_unhealthy_targetgroups" :label "Find Unhealthy Targetgroups" :handler "/unhealthy-targetgroups" :permissions "t") + (:id "a_menu_unhealthy_targetgroups" :label "Unhealthy Targetgroups" :handler "/unhealthy-targetgroups" :permissions "t") (:id "a_menu_tfcloud_apply" :label "TFCloud Apply" :handler "/tfcloud-apply" :permissions "t") (: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") -- cgit v1.3