emacs.d/elpa/kubernetes-20200114.436/kubernetes-overview.el
2020-02-03 19:45:34 +01:00

455 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