From 0bd2029c832272a651a3d8ec261371499097fc61 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 21 Jul 2024 17:54:00 +0200 Subject: [PATCH] Evolve kubed.el --- lisp/net/kubed.el | 815 ++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 708 insertions(+), 107 deletions(-) diff --git a/lisp/net/kubed.el b/lisp/net/kubed.el index 93f7df8c4ec..27900ba0ac0 100644 --- a/lisp/net/kubed.el +++ b/lisp/net/kubed.el @@ -20,10 +20,31 @@ ;;; Commentary: +;; This library defines commands for interacting with Kubernetes +;; resources, such as Kuberenetes pods, services, deployments, and more. +;; +;; Use `kubed-display-pod' to display a Kuberenetes pod, +;; `kubed-edit-pod' to edit it, `kubed-delete-pods' to delete it, and +;; `kubed-list-pods' to see a menu of all pods. To update the list of +;; current pods, use `kubed-update-pods' or `kubed-update-all'. +;; +;; Similar commands are defined for other types of resources as well. +;; +;; This library interacts with Kuberenetes via `kubectl', and uses the +;; current `kubectl' context and namespace. To change your current +;; Kuberenetes context or namespace, use `kubed-use-context' and +;; `kubed-set-namespace'; all resource lists are updated automatically +;; after you do so. +;; +;; If you want to work with more or different types of Kubernetes +;; resources, use the macro `kubed-define-resource'. This macro defines +;; some common functions and commands that'll get you started with ease. + ;;; TODO: -;; - Minibuffer export to tabulated list. -;; - Annotate completion candidates. +;; - Annotate completion candidates in `kubed-read-*' functions. +;; - Add a way to filter resources lists. +;; - Add `kubed-create-*' commands for more resource types. ;;; Code: @@ -36,9 +57,20 @@ :type 'hook) (defcustom kubed-kubectl-executable "kubectl" - "Name of `kubectl' executable." + "Name of `kubectl' executable to use for interacting with Kubernetes." :type 'string) +(defcustom kubed-yaml-setup-hook '(yaml-ts-mode view-mode) + "List of functions to call in Kubernetes resource description YAML buffers. + +The first function in the list should normally be the major mode to use, +by default it is `yaml-ts-mode'." + :type 'hook) + +(defcustom kubed-logs-setup-hook '(view-mode) + "List of functions to call when setting up Kubernetes pod logs buffers." + :type 'hook) + ;;;###autoload (defun kubed-update-all () "Update all Kuberenetes resource lists." @@ -48,37 +80,118 @@ (defvar-local kubed-frozen nil "Whether the current buffer shows a frozen list of Kuberenetes resources. -If a resource lists is frozen then Emacs does not update it when -obtaining new information.") +If a resource lists is frozen, then Emacs does not update it when +obtaining new information from Kuberenetes clusters.") + +(defcustom kubed-name-column '("Name" 40 t) + "Specification of name column in Kubernetes resource list buffers." + :type '(list string natnum boolean)) + +(defcustom kubed-namespace-column '("Namespace" 12 t) + "Specification of namespace column in Kubernetes resource list buffers." + :type '(list string natnum boolean)) + +(define-minor-mode kubed-all-namespaces-mode + "Show Kubernetes resources from all namespaces, not just current namespace." + :global t + (message "Kubed \"all namespaces\" mode is now %s" + (if kubed-all-namespaces-mode "ON" "OFF")) + (kubed-update-all)) (defmacro kubed-define-resource (resource &optional properties &rest commands) - "Define Kubernetes RESOURCE with PROPERTIES and associated COMMANDS." + "Define Kubernetes RESOURCE with associated PROPERTIES and COMMANDS. + +RESOURCE is a symbol corresponding to a Kubernetes resource type, such +as `pod' or `service'. This macro defines the following commands for +interacting with Kubernetes RESOURCEs: + +- `kubed-display-RESROURCE': prompt for a RESOURCE and display its + description in YAML format. See also `kubed-yaml-setup-hook'. +- `kubed-edit-RESROURCE': prompt for a RESOURCE and edit it. +- `kubed-delete-RESROURCE': prompt for a RESOURCE and delete it. +- `kubed-list-RESROURCEs': display a buffer listing all RESOURCEs in the + current namespace. The RESOURCEs list buffer uses a dedicated major + mode, `kubed-RESOURCEs-mode', which is also defined by this macro. +- `kubed-update-RESROURCEs': update and repopulate RESOURCEs list. + +PROPERTIES is a list of elements (PROPERTY JSON-PATH [WIDTH]) that +specify properties of RESOURCEs. PROPERTY is the name of the property, +as a symbol; JSON-PATH is JSONPath expression that evaluates to the +value of PROPERTY when applied to the full JSON representation of a +RESOURCE. WIDTH is optional, when specified it is used as the default +width of the column corresponding to PROPERTY in RESOURCEs list buffers. +For example, an element (phase \".status.phase\" 10) says that RESOURCE +has a `phase' property at JSONPath \".status.phase\" whose values are +typically 10 columns wide. + +COMMANDS is a list of elements (COMMAND KEYS DOC-PREFIX . BODY) that +define commands for RESOURCE list buffers. COMMAND is a symbol +specifying the suffix of the command name, the full name of the command +is `kubed-RESOURCEs-COMMAND' (for example, `kubed-pods-shell'); KEYS is +either a string that specifies a key sequence to bind to the command in +`kubed-RESOURCEs-mode-map', or nil if the command should not be bound; +DOC-PREFIX is a string used to construct the docstring of the command, +this macro appends the string \" Kubernetes RESOURCE at point.\" to it +to obtain the final docstring; lastly, BODY is the body the command. +Within BODY, the variable RESOURCE is let-bound to the name of the +RESOURCE at point. If RESOURCE is namespaced, then also the variable +`k8sns' is let-bound to the namespace of the RESOURCE at point within +BODY when `kubed-all-namespaces-mode' is enabled. For example, if +RESOURCE is `pod', the following COMMANDS element defines a command +`kubed-pods-frob' and binds it to the key \"f\" in +`kubed-pods-mode-map': + + (frob \"f\" \"Frobnicate\" + (message \"Preparing...\") + (frobnicate-pod pod k8sns) + (message \"Done.\")) + +By default, this macro assumes that RESOURCE is namespaced. To define a +namespaceless resource type, put `:namespaced nil' before COMMANDS: + + (kubed-define-resource global-thingy (PROP1 PROP2 ...) :namespaced nil + CMD1 + CMD2 + ...)" (declare (indent 2)) (let ((hist-var (intern (format "kubed-%S-history" resource))) (list-var (intern (format "kubed-%Ss" resource))) - (alst-var (intern (format "kubed-%Ss-alist" resource))) + (ents-var (intern (format "kubed--%Ss-entries" resource))) (hook-var (intern (format "kubed-update-%Ss-hook" resource))) (proc-var (intern (format "kubed-%Ss-process" resource))) + (frmt-var (intern (format "kubed-%Ss-columns" resource))) (plrl-var (intern (format "%Ss" resource))) (read-fun (intern (format "kubed-read-%S" resource))) + (read-crm (intern (format "kubed-read-%Ss" resource))) + (read-nms (intern (format "kubed-read-namespaced-%S" resource))) (sure-fun (intern (format "kubed-ensure-%Ss" resource))) (ents-fun (intern (format "kubed-%Ss-entries" resource))) (buff-fun (intern (format "kubed-%Ss-buffer" resource))) - (desc-fun (intern (format "kubed-describe-%S-buffer" resource))) + (frmt-fun (intern (format "kubed-%Ss-format" resource))) + (desc-fun (intern (format "kubed-%S-description-buffer" resource))) (updt-cmd (intern (format "kubed-update-%Ss" resource))) (list-cmd (intern (format "kubed-list-%Ss" resource))) + (edit-cmd (intern (format "kubed-%Ss-edit" resource))) (slct-cmd (intern (format "kubed-%Ss-get" resource))) (othr-cmd (intern (format "kubed-%Ss-get-in-other-window" resource))) (desc-cmd (intern (format "kubed-%Ss-display" resource))) + (mark-cmd (intern (format "kubed-%Ss-mark-for-deletion" resource))) + (umrk-cmd (intern (format "kubed-%Ss-unmark" resource))) + (exec-cmd (intern (format "kubed-%Ss-execute" resource))) (dlt-cmd (intern (format "kubed-%Ss-delete" resource))) (list-buf (format "*kubed-%Ss*" resource)) (buf-name (format "*kubed-%S*" resource)) (out-name (format " *kubed-get-%Ss*" resource)) (err-name (format " *kubed-get-%Ss-stderr*" resource)) - (cmd-name (intern (format "kubed-describe-%S" resource))) - (dlt-name (intern (format "kubed-delete-%S" resource))) + (dlt-errb (format " *kubed-%Ss-execute-stderr*" resource)) + (cmd-name (intern (format "kubed-display-%S" resource))) + (edt-name (intern (format "kubed-edit-%S" resource))) + (dlt-name (intern (format "kubed-delete-%Ss" resource))) (mod-name (intern (format "kubed-%Ss-mode" resource))) - (cmd-doc (format "Describe Kubernetes %S %s." resource (upcase (symbol-name resource))))) + (namespaced t)) + (when (eq (car commands) :namespaced) + (pop commands) + (setq namespaced (pop commands))) `(progn (defvar ,hist-var nil ,(format "History list for `%S'." read-fun)) @@ -97,6 +210,7 @@ obtaining new information.") (defun ,updt-cmd () ,(format "Update `%S'." list-var) (interactive) + (when (process-live-p ,proc-var) (delete-process ,proc-var)) (with-current-buffer (get-buffer-create ,out-name) (erase-buffer)) (setq ,proc-var @@ -107,16 +221,21 @@ obtaining new information.") :command (list kubed-kubectl-executable "get" ,(format "%Ss" resource) + (concat "--all-namespaces=" + (if kubed-all-namespaces-mode "true" "false")) "--no-headers=true" - ,(format "--output=custom-columns=%s" - (string-join - (cons "NAME:.metadata.name" - (mapcar (lambda (p) - (concat (upcase (symbol-name (car p))) - ":" - (cadr p))) - properties)) - ","))) + (format "--output=custom-columns=%s" + (string-join + (cons "NAME:.metadata.name" + (append + (when kubed-all-namespaces-mode + (list "NAMESPACE:.metadata.namespace")) + ',(mapcar (lambda (p) + (concat (upcase (symbol-name (car p))) + ":" + (cadr p))) + properties))) + ","))) :sentinel (lambda (_proc status) (cond ((string= status "finished\n") @@ -130,7 +249,8 @@ obtaining new information.") (forward-line 1) (1- (point)))))) (push (split-string line " " t) new)))) - (setq ,list-var new) + (setq ,list-var new + ,proc-var nil) (run-hooks ',hook-var) (message ,(format "Updated Kubernetes %Ss." resource)))) ((string= status "exited abnormally with code 1\n") @@ -140,97 +260,379 @@ obtaining new information.") (display-buffer ,err-name)))))) (minibuffer-message ,(format "Updating Kubernetes %Ss..." resource))) - (defun ,read-fun (prompt &optional default) + (defun ,read-fun (prompt &optional default multi) ,(format "Prompt with PROMPT for a Kubernetes %S name. -Optional argument DEFAULT is the minibuffer default argument." resource) +Optional argument DEFAULT is the minibuffer default argument. + +Non-nil optional argument MULTI says to read and return a list of %S, +instead of just one." resource plrl-var) (minibuffer-with-setup-hook #',(intern (format "kubed-ensure-%Ss" resource)) - (completing-read (format-prompt prompt default) - (completion-table-dynamic - (lambda (_) ,list-var)) - nil 'confirm nil ',hist-var default)) ) - - (defun ,desc-fun (,resource) - ,(format "Return buffer with description of Kubernetes %S %s" - resource (upcase (symbol-name resource))) - (let ((buf (get-buffer-create ,buf-name))) - (with-current-buffer buf - (let ((inhibit-read-only t)) - (erase-buffer) - (unless (zerop - (call-process - kubed-kubectl-executable nil ,buf-name t "get" - ,(symbol-name resource) "--output=yaml" ,resource)) - (error ,(format "`kubectl get %S' failed" resource)))) - (goto-char (point-min)) - (yaml-ts-mode) - (view-mode)) - buf)) + (funcall + (if multi #'completing-read-multiple #'completing-read) + (format-prompt prompt default) + (lambda (s p a) + (if (eq a 'metadata) + '(metadata + (category . ,(intern (format "kubernetes-%S" resource)))) + (while (and (process-live-p ,proc-var) + (null ,list-var)) + (accept-process-output ,proc-var 1)) + (complete-with-action a ,list-var s p))) + nil 'confirm nil ',hist-var default)) ) + + (defun ,read-crm (prompt &optional default) + ,(format "Prompt with PROMPT for Kubernetes %S names. - (defun ,cmd-name (,resource) - ,cmd-doc - (interactive (list (,read-fun "Describe"))) - (display-buffer (,desc-fun ,resource))) - - (put ',cmd-name 'minibuffer-action "describe") +Optional argument DEFAULT is the minibuffer default argument." resource) + (,read-fun prompt default t)) + + ,(if namespaced + `(defun ,desc-fun (,resource &optional k8sns) + ,(format "Return buffer with description of Kubernetes %S %s" + resource (upcase (symbol-name resource))) + (let ((buf (get-buffer-create ,buf-name))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (unless (zerop + (call-process + kubed-kubectl-executable nil ,buf-name t "get" + (if k8sns + (concat "--namespace=" k8sns) + "--all-namespaces=false") + ,(symbol-name resource) "--output=yaml" ,resource)) + (error ,(format "`kubectl get %S' failed" resource)))) + (goto-char (point-min)) + (run-hooks 'kubed-yaml-setup-hook)) + buf)) + `(defun ,desc-fun (,resource) + ,(format "Return buffer with description of Kubernetes %S %s" + resource (upcase (symbol-name resource))) + (let ((buf (get-buffer-create ,buf-name))) + (with-current-buffer buf + (let ((inhibit-read-only t)) + (erase-buffer) + (unless (zerop + (call-process + kubed-kubectl-executable nil ,buf-name t "get" + ,(symbol-name resource) "--output=yaml" ,resource)) + (error ,(format "`kubectl get %S' failed" resource)))) + (goto-char (point-min)) + (run-hooks 'kubed-yaml-setup-hook)) + buf))) + + ,(when namespaced + `(defun ,read-nms (prompt &optional default multi) + (let* ((choice + (funcall + (if multi #'completing-read-multiple #'completing-read) + (format-prompt prompt default) + (lambda (s p a) + (if (eq a 'metadata) + '(metadata + (category + . ,(intern (format "kubernetes-namespaced-%S" resource)))) + (while (and (process-live-p ,proc-var) + (null ,list-var)) + (accept-process-output ,proc-var 1)) + (complete-with-action a (mapcar (pcase-lambda (`(,name ,space . ,_)) + (concat name " " space)) + ,list-var) + s p))) + nil 'confirm nil ',hist-var default)) + (split (mapcar (lambda (c) (split-string c " ")) (ensure-list choice)))) + (if multi split (car split))))) + + ,(if namespaced + `(defun ,cmd-name (,resource &optional k8sns) + ,(format "Display Kubernetes %S %s." resource (upcase (symbol-name resource))) + (interactive (if kubed-all-namespaces-mode + (,read-nms "Display") + (list (,read-fun "Display")))) + (display-buffer (,desc-fun ,resource k8sns))) + `(defun ,cmd-name (,resource) + ,(format "Display Kubernetes %S %s." resource (upcase (symbol-name resource))) + (interactive (list (,read-fun "Display"))) + (display-buffer (,desc-fun ,resource)))) (add-hook 'kubed-update-hook #',updt-cmd) - (defun ,dlt-name (,resource) - ,(format "Delete Kubernetes %S %s." resource (upcase (symbol-name resource))) - (interactive (list (,read-fun "Delete"))) - (message ,(concat "Deleting Kubernetes " (symbol-name resource) " `%s'...") ,resource) - (if (zerop (call-process kubed-kubectl-executable nil nil nil "delete" ,(format "%Ss" resource) ,resource)) - (message ,(concat "Deleting Kubernetes " (symbol-name resource) " `%s'... Done.") ,resource) - (error ,(concat "`kubectl delete " (symbol-name resource) "s %s' failed") ,resource))) - - (defvar-local ,alst-var nil) + ,(if namespaced + `(defun ,edt-name (,resource &optional k8sns) + ,(format "Edit Kubernetes %S %s." resource (upcase (symbol-name resource))) + (interactive (if kubed-all-namespaces-mode + (,read-nms "Edit") + (list (,read-fun "Edit")))) + (unless (bound-and-true-p server-process) (server-start)) + (let ((process-environment + (cons (concat "KUBE_EDITOR=" emacsclient-program-name) + process-environment))) + (start-process ,(format "*kubed-%S-edit*" plrl-var) nil + kubed-kubectl-executable "edit" + (if k8sns + (concat "--namespace=" k8sns) + "-o=yaml") + ,(symbol-name resource) ,resource))) + `(defun ,edt-name (,resource) + ,(format "Edit Kubernetes %S %s." resource (upcase (symbol-name resource))) + (interactive (list (,read-fun "Edit"))) + (unless (bound-and-true-p server-process) (server-start)) + (let ((process-environment + (cons (concat "KUBE_EDITOR=" emacsclient-program-name) + process-environment))) + (start-process ,(format "*kubed-%S-edit*" plrl-var) nil + kubed-kubectl-executable "edit" + ,(symbol-name resource) ,resource)))) + + ,(if namespaced + `(defun ,dlt-name (,plrl-var) + ,(format "Delete Kubernetes %S %s." plrl-var (upcase (symbol-name plrl-var))) + (interactive (if kubed-all-namespaces-mode + (,read-nms "Delete" nil t) + (list (,read-crm "Delete")))) + (unless ,plrl-var + (user-error ,(format "You didn't specify %S to delete" plrl-var))) + (if kubed-all-namespaces-mode + (pcase-dolist (`(,name ,space) ,plrl-var) + (message ,(concat "Deleting Kubernetes " (symbol-name resource) " `%s' in namespace `%s'...") name space) + (if (zerop (apply #'call-process + kubed-kubectl-executable nil nil nil + "delete" "--namespace" space ,(symbol-name plrl-var) name)) + (message ,(concat "Deleting Kubernetes " (symbol-name resource) " `%s' in namespace `%s'... Done.") name space) + (error ,(concat "Failed to delete Kubernetes" (symbol-name resource) " `%s' in namespace `%s'") name space)))) + (message ,(concat "Deleting Kubernetes " (symbol-name plrl-var) " `%s'...") (string-join ,plrl-var "', `")) + (if (zerop (apply #'call-process + kubed-kubectl-executable nil nil nil + "delete" ,(symbol-name plrl-var) ,plrl-var)) + (message ,(concat "Deleting Kubernetes " (symbol-name plrl-var) " `%s'... Done.") (string-join ,plrl-var "', `")) + (error ,(concat "Failed to delete Kubernetes" (symbol-name plrl-var) " `%s'") (string-join ,plrl-var "', `")))) + `(defun ,dlt-name (,plrl-var) + ,(format "Delete Kubernetes %S %s." plrl-var (upcase (symbol-name plrl-var))) + (interactive (list (,read-crm "Delete"))) + (unless ,plrl-var + (user-error ,(format "You didn't specify %S to delete" plrl-var))) + (message ,(concat "Deleting Kubernetes " (symbol-name plrl-var) " `%s'...") (string-join ,plrl-var "', `")) + (if (zerop (apply #'call-process + kubed-kubectl-executable nil nil nil + "delete" ,(symbol-name plrl-var) ,plrl-var)) + (message ,(concat "Deleting Kubernetes " (symbol-name plrl-var) " `%s'... Done.") (string-join ,plrl-var "', `")) + (error ,(concat "Failed to delete Kubernetes" (symbol-name plrl-var) " `%s'") (string-join ,plrl-var "', `"))))) + + (defvar-local ,ents-var nil) (defun ,ents-fun () - ,(format "Format `%S' for display as `tabulated-list-entries'." alst-var) + ,(format "Format `%S' for display as `tabulated-list-entries'." ents-var) (mapcar - (lambda (c) (list (car c) (apply #'vector c))) - ,alst-var)) + (lambda (c) (list ,(if namespaced + `(if kubed-all-namespaces-mode + (concat (car c) " " (cadr c)) + (car c)) + `(car c)) + (apply #'vector c))) + ,ents-var)) (defun ,dlt-cmd () ,(format "Delete Kubernetes %S at point." resource) (interactive "" ,mod-name) - (if-let ((,resource (tabulated-list-get-id))) - (when (y-or-n-p (format ,(concat "Delete Kubernetes " (symbol-name resource) " `%s'?") ,resource)) - (,dlt-name ,resource) - (tabulated-list-delete-entry) - (,updt-cmd)) + (if-let ,(if namespaced + `((k8sent (tabulated-list-get-entry)) + (,resource (aref k8sent 0))) + `(,resource (tabulated-list-get-id))) + ,(if namespaced + `(if-let ((k8sns (and kubed-all-namespaces-mode + (aref (tabulated-list-get-entry) 1)))) + (when (y-or-n-p (format ,(concat "Delete Kubernetes " (symbol-name resource) " `%s' in namespace `%s'?") ,resource k8sns)) + (,dlt-name (list (list ,resource k8sns)))) + (when (y-or-n-p (format ,(concat "Delete Kubernetes " (symbol-name resource) " `%s'?") ,resource)) + (,dlt-name (list ,resource)))) + `(when (y-or-n-p (format ,(concat "Delete Kubernetes " (symbol-name resource) " `%s'?") ,resource)) + (,dlt-name (list ,resource)))) (user-error ,(format "No Kubernetes %S at point" resource)))) (defun ,slct-cmd () ,(format "Switch to buffer showing description of Kubernetes %s at point." resource) (interactive "" ,mod-name) - (if-let ((,resource (tabulated-list-get-id))) - (switch-to-buffer (,desc-fun ,resource)) + (if-let ,(if namespaced + `((k8sent (tabulated-list-get-entry)) + (,resource (aref k8sent 0))) + `(,resource (tabulated-list-get-id))) + ,(if namespaced + `(let ((k8sns (when kubed-all-namespaces-mode + (aref (tabulated-list-get-entry) 1)))) + (switch-to-buffer (,desc-fun ,resource k8sns))) + `(switch-to-buffer (,desc-fun ,resource))) (user-error ,(format "No Kubernetes %S at point" resource)))) (defun ,othr-cmd () ,(format "Pop to buffer showing description of Kubernetes %s at point." resource) (interactive "" ,mod-name) - (if-let ((,resource (tabulated-list-get-id))) - (switch-to-buffer-other-window (,desc-fun ,resource)) + (if-let ,(if namespaced + `((k8sent (tabulated-list-get-entry)) + (,resource (aref k8sent 0))) + `(,resource (tabulated-list-get-id))) + ,(if namespaced + `(let ((k8sns (when kubed-all-namespaces-mode + (aref (tabulated-list-get-entry) 1)))) + (switch-to-buffer-other-window (,desc-fun ,resource k8sns))) + `(switch-to-buffer-other-window (,desc-fun ,resource))) (user-error ,(format "No Kubernetes %S at point" resource)))) (defun ,desc-cmd () - ,(format "Describe Kubernetes %S at point." resource) + ,(format "Display Kubernetes %S at point." resource) + (interactive "" ,mod-name) + (if-let ,(if namespaced + `((k8sent (tabulated-list-get-entry)) + (,resource (aref k8sent 0))) + `(,resource (tabulated-list-get-id))) + ,(if namespaced + `(let ((k8sns (when kubed-all-namespaces-mode + (aref (tabulated-list-get-entry) 1)))) + (display-buffer (,desc-fun ,resource k8sns))) + `(display-buffer (,desc-fun ,resource))) + (user-error ,(format "No Kubernetes %S at point" resource)))) + + (defun ,edit-cmd () + ,(format "Edit Kubernetes %S at point." resource) (interactive "" ,mod-name) - (if-let ((,resource (tabulated-list-get-id))) - (display-buffer (,desc-fun ,resource)) + (if-let ,(if namespaced + `((k8sent (tabulated-list-get-entry)) + (,resource (aref k8sent 0))) + `(,resource (tabulated-list-get-id))) + ,(if namespaced + `(let ((k8sns (when kubed-all-namespaces-mode + (aref (tabulated-list-get-entry) 1)))) + (,edt-name ,resource k8sns)) + `(,edt-name ,resource)) (user-error ,(format "No Kubernetes %S at point" resource)))) + (defun ,mark-cmd () + ,(format "Mark Kubernetes %S at point for deletion." resource) + (interactive "" ,mod-name) + (tabulated-list-put-tag + (propertize "D" 'help-echo "Marked for deletion") t)) + + (defun ,umrk-cmd () + ,(format "Remove mark from Kubernetes %S at point." resource) + (interactive "" ,mod-name) + (tabulated-list-put-tag " " t)) + + (defun ,exec-cmd () + ,(format "Delete marked Kubernetes %Ss." resource) + (interactive "" ,mod-name) + (let (delete-list) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (eq (char-after) ?D) + (push (tabulated-list-get-id) delete-list)) + (forward-line))) + (if delete-list + (when (y-or-n-p (format ,(concat "Delete %d marked Kubernetes " + (symbol-name plrl-var) "?") + (length delete-list))) + ,@(if namespaced + `((if kubed-all-namespaces-mode + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (member (tabulated-list-get-id) delete-list) + (tabulated-list-put-tag + (propertize "K" 'help-echo "Deletion in progress")) + (let* ((k8sent (tabulated-list-get-entry)) + (name (aref k8sent 0)) + (space (aref k8sent 1))) + (make-process + :name ,(format "*kubed-%Ss-execute*" resource) + :stderr ,dlt-errb + :command (list kubed-kubectl-executable + "delete" + "--namespace" space + ,(symbol-name plrl-var) + name) + :sentinel (lambda (_proc status) + (cond + ((string= status "finished\n") + (message (format ,(concat "Deleted Kubernetes " + (symbol-name resource) + " `%s' in namespace `%s'.") + name space)) + (,updt-cmd)) + ((string= status "exited abnormally with code 1\n") + (with-current-buffer ,dlt-errb + (goto-char (point-max)) + (insert "\n" status)) + (display-buffer ,dlt-errb))))))) + (forward-line))) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (member (tabulated-list-get-id) delete-list) + (tabulated-list-put-tag + (propertize "K" 'help-echo "Deletion in progress"))) + (forward-line))) + (make-process + :name ,(format "*kubed-%Ss-execute*" resource) + :stderr ,dlt-errb + :command (append + (list kubed-kubectl-executable + "delete" ,(symbol-name plrl-var)) + delete-list) + :sentinel (lambda (_proc status) + (cond + ((string= status "finished\n") + (message (format ,(concat "Deleted %d marked Kubernetes " + (symbol-name plrl-var) ".") + (length delete-list))) + (,updt-cmd)) + ((string= status "exited abnormally with code 1\n") + (with-current-buffer ,dlt-errb + (goto-char (point-max)) + (insert "\n" status)) + (display-buffer ,dlt-errb))))))) + `((save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (member (tabulated-list-get-id) delete-list) + (tabulated-list-put-tag + (propertize "K" 'help-echo "Deletion in progress"))) + (forward-line))) + (make-process + :name ,(format "*kubed-%Ss-execute*" resource) + :stderr ,dlt-errb + :command (append + (list kubed-kubectl-executable + "delete" ,(symbol-name plrl-var)) + delete-list) + :sentinel (lambda (_proc status) + (cond + ((string= status "finished\n") + (message (format ,(concat "Deleted %d marked Kubernetes " + (symbol-name plrl-var) ".") + (length delete-list))) + (,updt-cmd)) + ((string= status "exited abnormally with code 1\n") + (with-current-buffer ,dlt-errb + (goto-char (point-max)) + (insert "\n" status)) + (display-buffer ,dlt-errb)))))))) + (user-error ,(format "No Kubernetes %S marked for deletion" plrl-var))))) + ,@(mapcar (pcase-lambda (`(,suffix ,_key ,desc . ,body)) `(defun ,(intern (format "kubed-%Ss-%S" resource suffix)) () ,(format "%s Kubernetes %S at point." desc resource) (interactive "" ,mod-name) - (if-let ((,resource (tabulated-list-get-id))) - (progn ,@body) + (if-let ,(if namespaced + `((k8sent (tabulated-list-get-entry)) + (,resource (aref k8sent 0))) + `(,resource (tabulated-list-get-id))) + ,(if namespaced + `(let ((k8sns (when kubed-all-namespaces-mode + (aref (tabulated-list-get-entry) 1)))) + ,@body) + `(progn ,@body)) (user-error ,(format "No Kubernetes %S at point" resource))))) commands) @@ -240,24 +642,57 @@ Optional argument DEFAULT is the minibuffer default argument." resource) "o" #',othr-cmd "C-o" #',desc-cmd "G" #',updt-cmd + "d" #',mark-cmd + "x" #',exec-cmd + "u" #',umrk-cmd + "e" #',edit-cmd "D" #',dlt-cmd ,@(mapcan (pcase-lambda (`(,suffix ,key ,_desc . ,_body)) - (list key `#',(intern (format "kubed-%Ss-%S" resource suffix)))) + (when key + (list key `#',(intern (format "kubed-%Ss-%S" resource suffix))))) commands)) + (defvar ,frmt-var + ',(mapcar (lambda (p) + (list (capitalize (symbol-name (car p))) + (caddr p) + t)) + properties)) + + (defun ,frmt-fun () + (apply #'vector + (cons + kubed-name-column + (append + (when kubed-all-namespaces-mode + (list kubed-namespace-column)) + ,frmt-var)))) + (define-derived-mode ,mod-name tabulated-list-mode - ,(format "Kubernetes %ss" (capitalize (symbol-name resource))) + (list ,(format "Kubernetes %ss" (capitalize (symbol-name resource))) + (list ',proc-var + (list :propertize "[...]" 'help-echo "Updating..."))) ,(format "Major mode for listing Kubernetes %Ss." resource) :interactive nil - (setq tabulated-list-format - ,(apply #'vector - '("Name" 64 t) - (mapcar (lambda (p) - (list (capitalize (symbol-name (car p))) - (caddr p) - t)) - properties))) + (add-hook 'revert-buffer-restore-functions + (lambda () + (let (marks) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (eq (char-after) ?\s) + (push (cons (tabulated-list-get-id) (char-after)) marks)) + (forward-line))) + (lambda () + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when-let ((mark (alist-get (tabulated-list-get-id) marks nil nil #'equal))) + (tabulated-list-put-tag (char-to-string mark))) + (forward-line)))))) + nil t) + (setq tabulated-list-format (,frmt-fun)) (setq tabulated-list-entries #',ents-fun) (setq tabulated-list-padding 2) (tabulated-list-init-header)) @@ -270,14 +705,16 @@ Optional argument DEFAULT is the minibuffer default argument." resource) (when (buffer-live-p buf) (with-current-buffer buf (unless kubed-frozen - (setq ,alst-var ,list-var) - (tabulated-list-print t t))))))) + (setq ,ents-var ,list-var) + (setq tabulated-list-format (,frmt-fun)) + (tabulated-list-init-header) + (revert-buffer))))))) (add-hook ',hook-var fun) (add-hook 'kill-buffer-hook (lambda () (remove-hook ',hook-var fun)) nil t)) (setq kubed-frozen frozen) - (setq ,alst-var ,plrl-var) + (setq ,ents-var ,plrl-var) (tabulated-list-print) (current-buffer))) @@ -287,41 +724,60 @@ Optional argument DEFAULT is the minibuffer default argument." resource) (,sure-fun) (pop-to-buffer (,buff-fun ,list-var)))))) -;;;###autoload (autoload 'kubed-describe-pod "kubed" nil t) -;;;###autoload (autoload 'kubed-delete-pod "kubed" nil t) +(defvar tramp-kubernetes-namespace) + +;;;###autoload (autoload 'kubed-display-pod "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-pod "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-pods "kubed" nil t) ;;;###autoload (autoload 'kubed-list-pods "kubed" nil t) (kubed-define-resource pod ((phase ".status.phase" 10) (starttime ".status.startTime" 20)) (dired "C-d" "Start Dired in home directory of first container of" - (dired (concat "/kubernetes:" pod ":"))) + (let ((tramp-kubernetes-namespace k8sns)) + (dired (concat "/kubernetes:" pod ":")))) (shell "S" "Start shell in home directory of first container of" - (let ((default-directory (concat "/kubernetes:" pod ":"))) - (shell)))) - -;;;###autoload (autoload 'kubed-describe-namespace "kubed" nil t) -;;;###autoload (autoload 'kubed-delete-namespace "kubed" nil t) + (let ((tramp-kubernetes-namespace k8sns) + (default-directory (concat "/kubernetes:" pod ":"))) + (shell))) + (logs "l" "Show logs for a container of" + (kubed-logs pod (kubed-read-container pod "Container" t k8sns))) + (forward-port "F" "Forward local network port to remote port of" + (let ((local-port (read-number "Forward local port: "))) + (kubed-forward-port-to-pod + pod local-port + (read-number (format "Forward local port %d to remote port: " + local-port)) + k8sns)))) + +;;;###autoload (autoload 'kubed-display-namespace "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-namespace "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-namespaces "kubed" nil t) ;;;###autoload (autoload 'kubed-list-namespaces "kubed" nil t) -(kubed-define-resource namespace) +(kubed-define-resource namespace () :namespaced nil) -;;;###autoload (autoload 'kubed-describe-service "kubed" nil t) -;;;###autoload (autoload 'kubed-delete-service "kubed" nil t) +;;;###autoload (autoload 'kubed-display-service "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-service "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-services "kubed" nil t) ;;;###autoload (autoload 'kubed-list-services "kubed" nil t) (kubed-define-resource service) -;;;###autoload (autoload 'kubed-describe-secret "kubed" nil t) -;;;###autoload (autoload 'kubed-delete-secret "kubed" nil t) +;;;###autoload (autoload 'kubed-display-secret "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-secret "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-secrets "kubed" nil t) ;;;###autoload (autoload 'kubed-list-secrets "kubed" nil t) (kubed-define-resource secret ((type ".type" 32) (creationtimestamp ".metadata.creationTimestamp" 20))) -;;;###autoload (autoload 'kubed-describe-job "kubed" nil t) -;;;###autoload (autoload 'kubed-delete-job "kubed" nil t) +;;;###autoload (autoload 'kubed-display-job "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-job "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-jobs "kubed" nil t) ;;;###autoload (autoload 'kubed-list-jobs "kubed" nil t) (kubed-define-resource job ((status ".status.conditions[0].type" 10) (starttime ".status.startTime" 20))) -;;;###autoload (autoload 'kubed-describe-deployment "kubed" nil t) -;;;###autoload (autoload 'kubed-delete-deployment "kubed" nil t) +;;;###autoload (autoload 'kubed-display-deployment "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-deployment "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-deployments "kubed" nil t) ;;;###autoload (autoload 'kubed-list-deployments "kubed" nil t) (kubed-define-resource deployment) @@ -359,7 +815,8 @@ Optional argument DEFAULT is the minibuffer default argument." (defun kubed-current-namespace () "Return current Kubernetes namespace." - (car (process-lines kubed-kubectl-executable "config" "view" "-o" "jsonpath={..namespace}"))) + (car (process-lines kubed-kubectl-executable + "config" "view" "-o" "jsonpath={..namespace}"))) ;;;###autoload (defun kubed-set-namespace (ns) @@ -387,5 +844,149 @@ Optional argument DEFAULT is the minibuffer default argument." (keymap-set kubed-pods-mode-map "+" #'kubed-create-pod) +(defun kubed-pod-containers (pod &optional k8sns) + "Return list of containers in Kubernetes pod POD in namespace K8SNS." + (string-split + (car (process-lines + kubed-kubectl-executable "get" + (if k8sns (concat "--namespace=" k8sns) "--all-namespaces=false") + "pod" pod "-o" "jsonpath={.spec.containers[*].name}")) + " ")) + +(defun kubed-pod-default-container (pod &optional k8sns) + "Return default container of Kubernetes pod POD in namespace K8SNS, or nil." + (car (process-lines + kubed-kubectl-executable + "get" + (if k8sns (concat "--namespace=" k8sns) "--all-namespaces=false") + "pod" pod "-o" + "jsonpath={.metadata.annotations.kubectl\\.kubernetes\\.io/default-container}"))) + +(defun kubed-read-container (pod prompt &optional guess k8sns) + "Prompt with PROMPT for a container in POD and return its name. + +Non-nil optional argument GUESS says to try and guess which container to +use without prompting: if the pod has a +\"kubectl.kubernetes.id/default-container\" annotation, use the +container that this annotation specifes; if there's just one container, +use it; otherwise, fall back to prompting." + (let ((default (kubed-pod-default-container pod k8sns)) + (all 'unset)) + (or + ;; There's a default container, so that's our guess. + (and guess default) + ;; No default, but we're allowed to guess, so check if there's just + ;; one container, and if so that's our guess. + (and guess (setq all (kubed-pod-containers pod k8sns)) + (null (cdr all)) + (car all)) + ;; No guessing, prompt. + (completing-read (format-prompt prompt default) + (completion-table-dynamic + (lambda (_) + (if (eq all 'unset) + (setq all (kubed-pod-containers pod k8sns)) + all))) + nil t nil nil default)))) + +;;;###autoload +(defun kubed-logs (pod container &optional k8sns) + "Show logs for container CONTAINER in Kubernetes pod POD." + (interactive + (if kubed-all-namespaces-mode + (let* ((p-s (kubed-read-namespaced-pod "Show logs for pod")) + (p (car p-s)) + (s (cadr p-s))) + (list p (kubed-read-container p "Container" nil s) s)) + (let* ((p (kubed-read-pod "Show logs for pod")) + (c (kubed-read-container p "Container"))) + (list p c)))) + (let ((buf (generate-new-buffer (format "*kubed-logs %s[%s] in %s*" pod container + (or k8sns "current namespace"))))) + (with-current-buffer buf (run-hooks 'kubed-logs-setup-hook)) + (if k8sns + (message "Getting logs for container `%s' in pod `%s' in namespace `%s'..." container pod k8sns) + (message "Getting logs for container `%s' in pod `%s'..." container pod)) + (start-process "*kubed-logs*" buf + kubed-kubectl-executable "logs" + (if k8sns (concat "--namespace=" k8sns) "--tail=-1") + "-f" "-c" container pod) + (display-buffer buf))) + +(defvar kubed-port-forward-process-alist nil + "Alist of current port-forwarding descriptors and corresponding processes.") + +(defun kubed-port-forward-process-alist (&optional _ignored) + "Update and return value of variable `kubed-port-forward-process-alist'." + (setq kubed-port-forward-process-alist + (seq-filter (lambda (pair) + (process-live-p (cdr pair))) + kubed-port-forward-process-alist))) + +;;;###autoload +(defun kubed-forward-port-to-pod (pod local-port remote-port &optional k8sns) + "Forward LOCAL-PORT to REMOTE-PORT of Kubernetes pod POD." + (interactive + (if kubed-all-namespaces-mode + (let* ((p-s (kubed-read-namespaced-pod "Show logs for pod")) + (p (car p-s)) + (s (cadr p-s))) + (list p (read-number "Local port: ") (read-number "Remote port: ") s)) + (let* ((p (kubed-read-pod "Forward port to pod")) + (l (read-number "Local port: ")) + (r (read-number "Remote port: "))) + (list p l r)))) + (if k8sns + (message "Forwarding local port %d to remote port %d of pod `%s'..." + local-port remote-port pod) + (message "Forwarding local port %d to remote port %d of pod `%s' in namespace `%s'..." + local-port remote-port pod k8sns)) + (push + (cons + (format "pod %s %d:%d%s" + pod local-port remote-port + (if k8sns (concat " in " k8sns) "")) + (start-process "*kubed-port-forward*" nil + kubed-kubectl-executable "port-forward" + (if k8sns (concat "--namespace=" k8sns) "--address=localhost") + pod (format "%d:%d" local-port remote-port))) + kubed-port-forward-process-alist)) + +(defun kubed-stop-port-forward (descriptor) + "Stop Kubernetes port-forwarding with descriptor DESCRIPTOR. + +DESCRIPTOR is a string that says which port-forwarding process to stop, +it has the format \"pod POD LOCAL-PORT:REMOTE-PORT\", where POD is the +name of the pod that is the target of the port-forwarding, LOCAL-PORT is +the local port that is being forwarded, and REMOTE-PORT is the +correspoding remote port of POD. + +Interactively, prompt for DESCRIPTOR with completion. If there is only +one port-forwarding process, stop that process without prompting." + (interactive + (list + (cond + ((cdr (kubed-port-forward-process-alist)) + (completing-read "Stop port-forwarding: " + (completion-table-dynamic + #'kubed-port-forward-process-alist) + nil t)) + ((caar kubed-port-forward-process-alist)) + (t (user-error "No port-forwarding to Kubernetes in progress"))))) + (if-let ((pair (assoc descriptor kubed-port-forward-process-alist))) + (delete-process (cdr pair)) + (error "No port-forwarding for %s" descriptor)) + (message "Stopped port-forwarding for %s" descriptor)) + +(defun kubed-pods-affixation (pods) + "Return Kubernetes PODS with completion affixations." + (let ((max (seq-max (cons 0 (mapcar #'string-width pods))))) + (mapcar (lambda (pod) + (list pod "" + (concat (make-string (1+ (- max (string-width pod))) ?\s) + (propertize (or (cadr (assoc pod kubed-pods)) "") + 'face 'completions-annotations)))) + pods))) + (provide 'kubed) ;;; kubed.el ends here -- 2.39.5