456 lines
20 KiB
EmacsLisp
456 lines
20 KiB
EmacsLisp
![]() |
;;; kubernetes-overview.el --- Utilities for managing the overview buffer. -*- lexical-binding: t; -*-
|
||
|
;;; Commentary:
|
||
|
;;; Code:
|
||
|
|
||
|
(require 'subr-x)
|
||
|
|
||
|
(require 'kubernetes-ast)
|
||
|
(require 'kubernetes-commands)
|
||
|
(require 'kubernetes-configmaps)
|
||
|
(require 'kubernetes-contexts)
|
||
|
(require 'kubernetes-deployments)
|
||
|
(require 'kubernetes-statefulsets)
|
||
|
(require 'kubernetes-nodes)
|
||
|
(require 'kubernetes-errors)
|
||
|
(require 'kubernetes-ingress)
|
||
|
(require 'kubernetes-jobs)
|
||
|
(require 'kubernetes-loading-container)
|
||
|
(require 'kubernetes-modes)
|
||
|
(require 'kubernetes-namespaces)
|
||
|
(require 'kubernetes-pods)
|
||
|
(require 'kubernetes-pod-line)
|
||
|
(require 'kubernetes-popups)
|
||
|
(require 'kubernetes-secrets)
|
||
|
(require 'kubernetes-services)
|
||
|
(require 'kubernetes-timers)
|
||
|
|
||
|
(autoload 'kubernetes-utils-up-to-existing-dir "kubernetes-utils")
|
||
|
|
||
|
|
||
|
;; Configmaps
|
||
|
|
||
|
(defun kubernetes-overview--referenced-configmaps (state pod)
|
||
|
(-let* (((&alist 'items configmaps) (kubernetes-state-configmaps state))
|
||
|
(configmaps (append configmaps nil))
|
||
|
((&alist 'spec (&alist 'volumes volumes 'containers containers)) pod)
|
||
|
|
||
|
(names-in-volumes
|
||
|
(->> volumes
|
||
|
(seq-mapcat
|
||
|
(lambda (volume)
|
||
|
(-when-let ((&alist 'configMap (&alist 'name name)) volume)
|
||
|
(list name))))))
|
||
|
|
||
|
(names-in-env
|
||
|
(->> containers
|
||
|
(seq-mapcat (-lambda ((&alist 'env env)) env))
|
||
|
(seq-mapcat
|
||
|
(lambda (env)
|
||
|
(-when-let ((&alist 'valueFrom (&alist 'configMapKeyRef (&alist 'name name))) env)
|
||
|
(list name))))))
|
||
|
|
||
|
(references (-uniq (-union names-in-volumes names-in-env))))
|
||
|
|
||
|
(seq-filter (-lambda ((&alist 'metadata (&alist 'name name)))
|
||
|
(member name references))
|
||
|
configmaps)))
|
||
|
|
||
|
(defun kubernetes-overview--configmaps-for-deployment (state pods)
|
||
|
(->> pods
|
||
|
(seq-mapcat (lambda (pod) (kubernetes-overview--referenced-configmaps state pod)))
|
||
|
-non-nil
|
||
|
-uniq
|
||
|
(seq-sort (lambda (s1 s2)
|
||
|
(string< (kubernetes-state-resource-name s1)
|
||
|
(kubernetes-state-resource-name s2))))))
|
||
|
|
||
|
(defun kubernetes-overview--configmaps-for-statefulset (state pods)
|
||
|
(->> pods
|
||
|
(seq-mapcat (lambda (pod) (kubernetes-overview--referenced-configmaps state pod)))
|
||
|
-non-nil
|
||
|
-uniq
|
||
|
(seq-sort (lambda (s1 s2)
|
||
|
(string< (kubernetes-state-resource-name s1)
|
||
|
(kubernetes-state-resource-name s2))))))
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-configmap-line (state configmap)
|
||
|
(-let* ((pending-deletion (kubernetes-state-configmaps-pending-deletion state))
|
||
|
(marked-configmaps (kubernetes-state-marked-configmaps state))
|
||
|
((&alist 'metadata (&alist 'name name )) configmap)
|
||
|
(line (cond
|
||
|
((member name pending-deletion)
|
||
|
`(propertize (face kubernetes-pending-deletion) ,name))
|
||
|
((member name marked-configmaps)
|
||
|
`(mark-for-delete ,name))
|
||
|
(t
|
||
|
name))))
|
||
|
`(section (,(intern (kubernetes-state-resource-name configmap)) t)
|
||
|
(nav-prop (:configmap-name ,name)
|
||
|
(copy-prop ,name (line ,line))))))
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-configmaps (state configmaps)
|
||
|
`(section (configmaps nil)
|
||
|
(heading "Configmaps")
|
||
|
(indent ,(--map `(aggregated-configmap-line ,state ,it) configmaps))
|
||
|
(padding)))
|
||
|
|
||
|
|
||
|
;; Secrets
|
||
|
|
||
|
(defun kubernetes-overview--referenced-secrets (secrets pod)
|
||
|
(-let* (((&alist 'spec (&alist 'volumes vols 'containers containers)) pod)
|
||
|
(combined-env (seq-mapcat (-lambda ((&alist 'env env))
|
||
|
env)
|
||
|
containers))
|
||
|
(names-in-volumes
|
||
|
(seq-mapcat
|
||
|
(lambda (volume)
|
||
|
(-when-let ((&alist 'secret (&alist 'secretName name)) volume)
|
||
|
(list name)))
|
||
|
vols))
|
||
|
|
||
|
(names-in-env
|
||
|
(seq-mapcat
|
||
|
(lambda (env)
|
||
|
(-when-let ((&alist 'valueFrom (&alist 'secretKeyRef (&alist 'name name))) env)
|
||
|
(list name)))
|
||
|
combined-env))
|
||
|
|
||
|
(references (-union names-in-volumes names-in-env))
|
||
|
(matches (seq-filter (lambda (secret)
|
||
|
(member (kubernetes-state-resource-name secret) references))
|
||
|
secrets)))
|
||
|
(seq-sort (lambda (s1 s2)
|
||
|
(string< (kubernetes-state-resource-name s1)
|
||
|
(kubernetes-state-resource-name s2)))
|
||
|
matches)))
|
||
|
|
||
|
(defun kubernetes-overview--secrets-for-deployment (state pods)
|
||
|
(-let* (((&alist 'items secrets) (kubernetes-state-secrets state))
|
||
|
(secrets (append secrets nil)))
|
||
|
(-non-nil (-uniq (seq-mapcat (lambda (pod)
|
||
|
(kubernetes-overview--referenced-secrets secrets pod))
|
||
|
pods)))))
|
||
|
|
||
|
(defun kubernetes-overview--secrets-for-statefulset (state pods)
|
||
|
(-let* (((&alist 'items secrets) (kubernetes-state-secrets state))
|
||
|
(secrets (append secrets nil)))
|
||
|
(-non-nil (-uniq (seq-mapcat (lambda (pod)
|
||
|
(kubernetes-overview--referenced-secrets secrets pod))
|
||
|
pods)))))
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-secret-line (state secret)
|
||
|
(-let* ((pending-deletion (kubernetes-state-secrets-pending-deletion state))
|
||
|
(marked-secrets (kubernetes-state-marked-secrets state))
|
||
|
((&alist 'metadata (&alist 'name name )) secret)
|
||
|
(line (cond
|
||
|
((member name pending-deletion)
|
||
|
`(propertize (face kubernetes-pending-deletion) ,name))
|
||
|
((member name marked-secrets)
|
||
|
`(mark-for-delete ,name))
|
||
|
(t
|
||
|
name))))
|
||
|
`(section (,(intern (kubernetes-state-resource-name secret)) t)
|
||
|
(nav-prop (:secret-name ,name)
|
||
|
(copy-prop ,name (line ,line))))))
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-secrets (state secrets)
|
||
|
`(section (secrets nil)
|
||
|
(heading "Secrets")
|
||
|
(indent ,(--map `(aggregated-secret-line ,state ,it) secrets))
|
||
|
(padding)))
|
||
|
|
||
|
|
||
|
;; Pods
|
||
|
|
||
|
(defun kubernetes-overview--pods-for-deployment (state deployment)
|
||
|
(-let* (((&alist 'spec (&alist 'selector (&alist 'matchLabels selectors))) deployment)
|
||
|
((&alist 'items pods) (kubernetes-state-pods state))
|
||
|
(pods (append pods nil)))
|
||
|
(nreverse (seq-reduce
|
||
|
(lambda (acc pod)
|
||
|
(-let [(&alist 'metadata (&alist 'labels labels)) pod]
|
||
|
;; The labels present on the pod must contain all selector labels
|
||
|
(if (-all? (lambda (label) (-contains? labels label)) selectors)
|
||
|
(cons pod acc)
|
||
|
acc)))
|
||
|
pods
|
||
|
nil))))
|
||
|
|
||
|
(defun kubernetes-overview--pods-for-statefulset (state statefulset)
|
||
|
(-let* (((&alist 'spec (&alist 'selector (&alist 'matchLabels (&alist 'name selector-name)))) statefulset)
|
||
|
((&alist 'items pods) (kubernetes-state-pods state))
|
||
|
(pods (append pods nil)))
|
||
|
(nreverse (seq-reduce
|
||
|
(lambda (acc pod)
|
||
|
(if (equal selector-name (kubernetes-state-resource-label pod))
|
||
|
(cons pod acc)
|
||
|
acc))
|
||
|
pods
|
||
|
nil))))
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-pods (state deployment pods)
|
||
|
(-let [(&alist 'spec (&alist
|
||
|
'replicas replicas
|
||
|
'selector (&alist 'matchLabels
|
||
|
(&alist 'name selector-name
|
||
|
'component component-name)
|
||
|
'matchExpressions match-expressions)))
|
||
|
deployment]
|
||
|
`(section (pods nil)
|
||
|
(heading "Pods")
|
||
|
(indent
|
||
|
,(when selector-name
|
||
|
`(section (selector nil)
|
||
|
(nav-prop (:selector ,selector-name)
|
||
|
(key-value 12 "Selector" ,(propertize selector-name 'face 'kubernetes-selector)))))
|
||
|
,(when component-name
|
||
|
`(section (component nil)
|
||
|
(nav-prop (:component ,component-name)
|
||
|
(key-value 12 "Component" ,(propertize component-name 'face 'kubernetes-component)))))
|
||
|
,(when match-expressions
|
||
|
`(section (expressions nil)
|
||
|
(heading "Match Expressions")
|
||
|
(indent ,(kubernetes-yaml-render match-expressions))))
|
||
|
(key-value 12 "Replicas" ,(format "%s" (or replicas 1)))
|
||
|
(columnar-loading-container ,(kubernetes-state-pods state) nil
|
||
|
,@(seq-map (lambda (pod) `(pod-line ,state ,pod)) pods)))
|
||
|
(padding))))
|
||
|
|
||
|
;; Deployment
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-deployment-detail (deployment)
|
||
|
(-let [(&alist 'metadata (&alist 'namespace ns 'creationTimestamp time)
|
||
|
'spec (&alist
|
||
|
'paused paused
|
||
|
'strategy (&alist
|
||
|
'type strategy-type
|
||
|
'rollingUpdate rolling-update)))
|
||
|
deployment]
|
||
|
`(,(when paused `(line (propertize (face warning) "Deployment Paused")))
|
||
|
(section (namespace nil)
|
||
|
(nav-prop (:namespace-name ,ns)
|
||
|
(key-value 12 "Namespace" ,(propertize ns 'face 'kubernetes-namespace))))
|
||
|
,(-if-let ((&alist 'maxSurge surge 'maxUnavailable unavailable) rolling-update)
|
||
|
`(section (strategy t)
|
||
|
(heading (key-value 12 "Strategy" ,strategy-type))
|
||
|
(indent
|
||
|
((key-value 12 "Max Surge" ,(format "%s" surge))
|
||
|
(key-value 12 "Max Unavailable" ,(format "%s" unavailable)))))
|
||
|
`(key-value 12 "Strategy" ,strategy-type))
|
||
|
(key-value 12 "Created" ,time))))
|
||
|
|
||
|
;; Statefulset
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-statefulset-detail (statefulset)
|
||
|
(-let [(&alist 'metadata (&alist 'namespace ns 'creationTimestamp time)
|
||
|
'spec (&alist
|
||
|
'paused paused
|
||
|
'strategy (&alist
|
||
|
'type _strategy-type
|
||
|
'rollingUpdate _rolling-update)))
|
||
|
statefulset]
|
||
|
`(,(when paused `(line (propertize (face warning) "Statefulset Paused")))
|
||
|
(section (namespace nil)
|
||
|
(nav-prop (:namespace-name ,ns)
|
||
|
(key-value 12 "Namespace" ,(propertize ns 'face 'kubernetes-namespace))))
|
||
|
(key-value 12 "Created" ,time))))
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-deployment (state deployment)
|
||
|
(let* ((pods (kubernetes-overview--pods-for-deployment state deployment))
|
||
|
(configmaps (kubernetes-overview--configmaps-for-deployment state pods))
|
||
|
(secrets (kubernetes-overview--secrets-for-deployment state pods)))
|
||
|
`(section (,(intern (kubernetes-state-resource-name deployment)) t)
|
||
|
(heading (deployment-line ,state ,deployment))
|
||
|
(section (details nil)
|
||
|
(indent
|
||
|
(aggregated-deployment-detail ,deployment)
|
||
|
(padding)
|
||
|
(aggregated-pods ,state ,deployment ,pods)
|
||
|
,(when configmaps
|
||
|
`(aggregated-configmaps ,state ,configmaps))
|
||
|
,(when secrets
|
||
|
`(aggregated-secrets ,state ,secrets)))))))
|
||
|
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-statefulset (state statefulset)
|
||
|
(let* ((pods (kubernetes-overview--pods-for-statefulset state statefulset))
|
||
|
(configmaps (kubernetes-overview--configmaps-for-statefulset state pods))
|
||
|
(secrets (kubernetes-overview--secrets-for-statefulset state pods)))
|
||
|
`(section (,(intern (kubernetes-state-resource-name statefulset)) t)
|
||
|
(heading (statefulset-line ,state ,statefulset))
|
||
|
(section (details nil)
|
||
|
(indent
|
||
|
(aggregated-statefulset-detail ,statefulset)
|
||
|
(padding)
|
||
|
(aggregated-pods ,state ,statefulset ,pods)
|
||
|
,(when configmaps
|
||
|
`(aggregated-configmaps ,state ,configmaps))
|
||
|
,(when secrets
|
||
|
`(aggregated-secrets ,state ,secrets)))))))
|
||
|
|
||
|
|
||
|
;; Main Components
|
||
|
|
||
|
(kubernetes-ast-define-component aggregated-view (state &optional hidden)
|
||
|
(-let [(state-set-p &as &alist 'items deployments) (kubernetes-state-deployments state)]
|
||
|
(-let (((state-set-p &as &alist 'items statefulsets)
|
||
|
(kubernetes-state-statefulsets state))
|
||
|
([fmt0 labels0] kubernetes-statefulsets--column-heading)
|
||
|
([fmt1 labels1] kubernetes-deployments--column-heading))
|
||
|
`(section (ubercontainer, nil)
|
||
|
(section (overview-container ,hidden)
|
||
|
(header-with-count "Statefulsets" ,statefulsets)
|
||
|
(indent
|
||
|
(columnar-loading-container
|
||
|
,statefulsets
|
||
|
,(propertize
|
||
|
(apply #'format fmt0 (split-string labels0 "|"))
|
||
|
'face
|
||
|
'magit-section-heading)
|
||
|
,@(--map `(aggregated-statefulset ,state ,it) statefulsets)))
|
||
|
(padding))
|
||
|
(section (overview-container ,hidden)
|
||
|
(header-with-count "Deployments" ,deployments)
|
||
|
(indent
|
||
|
(columnar-loading-container
|
||
|
,deployments
|
||
|
,(propertize
|
||
|
(apply #'format fmt1 (split-string labels1))
|
||
|
'face
|
||
|
'magit-section-heading)
|
||
|
,@(--map `(aggregated-deployment ,state ,it) deployments)))
|
||
|
(padding))))))
|
||
|
|
||
|
(defun kubernetes-overview-render (state)
|
||
|
(let ((sections (kubernetes-state-overview-sections state)))
|
||
|
`(section (root nil)
|
||
|
,(kubernetes-errors-render state)
|
||
|
,(when (member 'context sections)
|
||
|
(kubernetes-contexts-render state))
|
||
|
,(when (member 'configmaps sections)
|
||
|
`(configmaps-list ,state))
|
||
|
,(when (member 'deployments sections)
|
||
|
`(deployments-list ,state))
|
||
|
,(when (member 'statefulsets sections)
|
||
|
`(statefulsets-list ,state))
|
||
|
,(when (member 'ingress sections)
|
||
|
`(ingress-list ,state))
|
||
|
,(when (member 'jobs sections)
|
||
|
`(jobs-list ,state))
|
||
|
,(when (member 'overview sections)
|
||
|
`(aggregated-view ,state))
|
||
|
,(when (member 'pods sections)
|
||
|
`(pods-list ,state))
|
||
|
,(when (member 'secrets sections)
|
||
|
`(secrets-list ,state))
|
||
|
,(when (member 'services sections)
|
||
|
`(services-list ,state))
|
||
|
,(when (member 'nodes sections)
|
||
|
`(nodes-list ,state)))))
|
||
|
|
||
|
|
||
|
;; Overview buffer.
|
||
|
|
||
|
(defun kubernetes-overview--redraw-buffer ()
|
||
|
"Redraws the main buffer using the current state."
|
||
|
(when-let (buf (get-buffer kubernetes-overview-buffer-name))
|
||
|
(with-current-buffer buf
|
||
|
;; If a region is active, a redraw would affect the region in
|
||
|
;; unpredictable ways.
|
||
|
(unless (region-active-p)
|
||
|
;; Suppress redrawing if the overview is not selected. This prevents
|
||
|
;; point from jumping around when a magit popup is open.
|
||
|
(when (member (selected-window) (get-buffer-window-list buf))
|
||
|
(kubernetes-utils--save-window-state
|
||
|
(let ((inhibit-read-only t))
|
||
|
(erase-buffer)
|
||
|
(kubernetes-ast-eval (kubernetes-overview-render (kubernetes-state)))))
|
||
|
|
||
|
;; Force the section at point to highlight.
|
||
|
(magit-section-update-highlight))))))
|
||
|
|
||
|
(defun kubernetes-overview--poll (&optional verbose)
|
||
|
(kubernetes-configmaps-refresh verbose)
|
||
|
(kubernetes-contexts-refresh verbose)
|
||
|
(kubernetes-ingress-refresh verbose)
|
||
|
(kubernetes-jobs-refresh verbose)
|
||
|
(kubernetes-deployments-refresh verbose)
|
||
|
(kubernetes-statefulsets-refresh verbose)
|
||
|
(kubernetes-nodes-refresh verbose)
|
||
|
(kubernetes-namespaces-refresh verbose)
|
||
|
(kubernetes-pods-refresh verbose)
|
||
|
(kubernetes-secrets-refresh verbose)
|
||
|
(kubernetes-services-refresh verbose))
|
||
|
|
||
|
(defun kubernetes-overview--initialize-buffer ()
|
||
|
"Called the first time the overview buffer is opened to set up the buffer."
|
||
|
(let ((buf (get-buffer-create kubernetes-overview-buffer-name)))
|
||
|
(with-current-buffer buf
|
||
|
(kubernetes-overview-mode)
|
||
|
(add-hook 'kubernetes-redraw-hook #'kubernetes-overview--redraw-buffer)
|
||
|
(add-hook 'kubernetes-poll-hook #'kubernetes-overview--poll)
|
||
|
(kubernetes-timers-initialize-timers)
|
||
|
(kubernetes-overview--redraw-buffer)
|
||
|
(add-hook 'kill-buffer-hook (kubernetes-utils-make-cleanup-fn buf) nil t))
|
||
|
buf))
|
||
|
|
||
|
(defun kubernetes-overview-set-sections (sections)
|
||
|
"Set which sections are displayed in the overview.
|
||
|
|
||
|
SECTIONS is a list of sections to display. See
|
||
|
`kubernetes-overview-custom-views-alist' and
|
||
|
`kubernetes-overview-views-alist' for possible values."
|
||
|
(interactive
|
||
|
(let* ((views (append kubernetes-overview-custom-views-alist kubernetes-overview-views-alist))
|
||
|
(names (-uniq (--map (symbol-name (car it)) views)))
|
||
|
(choice (intern (completing-read "Overview view: " names nil t))))
|
||
|
(list (alist-get choice views))))
|
||
|
|
||
|
(kubernetes-state-update-overview-sections sections)
|
||
|
(kubernetes-state-trigger-redraw))
|
||
|
|
||
|
(defvar kubernetes-overview-mode-map
|
||
|
(let ((keymap (make-sparse-keymap)))
|
||
|
(define-key keymap (kbd "v") #'kubernetes-overview-set-sections)
|
||
|
keymap)
|
||
|
"Keymap for `kubernetes-overview-mode'.")
|
||
|
|
||
|
;;;###autoload
|
||
|
(define-derived-mode kubernetes-overview-mode kubernetes-mode "Kubernetes Overview"
|
||
|
"Mode for working with Kubernetes overview.
|
||
|
|
||
|
\\<kubernetes-overview-mode-map>\
|
||
|
Type \\[kubernetes-overview-set-sections] to choose which resources to display.
|
||
|
|
||
|
Type \\[kubernetes-mark-for-delete] to mark an object for deletion, and \\[kubernetes-execute-marks] to execute.
|
||
|
Type \\[kubernetes-unmark] to unmark the object at point, or \\[kubernetes-unmark-all] to unmark all objects.
|
||
|
|
||
|
Type \\[kubernetes-navigate] to inspect the object on the current line.
|
||
|
|
||
|
Type \\[kubernetes-copy-thing-at-point] to copy the thing at point.
|
||
|
|
||
|
Type \\[kubernetes-refresh] to refresh the buffer.
|
||
|
|
||
|
\\{kubernetes-overview-mode-map}"
|
||
|
:group 'kubernetes)
|
||
|
|
||
|
;;;###autoload
|
||
|
(defun kubernetes-overview ()
|
||
|
"Display an overview buffer for Kubernetes."
|
||
|
(interactive)
|
||
|
(let ((dir default-directory)
|
||
|
(buf (kubernetes-overview--initialize-buffer)))
|
||
|
(when kubernetes-default-overview-namespace
|
||
|
(kubernetes-set-namespace kubernetes-default-overview-namespace
|
||
|
(kubernetes-state)))
|
||
|
(kubernetes-commands-display-buffer buf)
|
||
|
(with-current-buffer buf
|
||
|
(cd (kubernetes-utils-up-to-existing-dir dir)))
|
||
|
(message (substitute-command-keys "\\<kubernetes-overview-mode-map>Type \\[kubernetes-overview-set-sections] to switch between resources, and \\[kubernetes-overview-popup] for usage."))))
|
||
|
|
||
|
|
||
|
(provide 'kubernetes-overview)
|
||
|
|
||
|
;;; kubernetes-overview.el ends here
|