From bc28eaf008efd45992280d79a29857fa8924653f Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 19 Jul 2024 19:23:41 +0200 Subject: [PATCH] kubed.el: New file. --- lisp/net/kubed.el | 391 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 391 insertions(+) create mode 100644 lisp/net/kubed.el diff --git a/lisp/net/kubed.el b/lisp/net/kubed.el new file mode 100644 index 00000000000..93f7df8c4ec --- /dev/null +++ b/lisp/net/kubed.el @@ -0,0 +1,391 @@ +;;; kubed.el --- Kubernetes interface -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Eshel Yaron + +;; Author: Eshel Yaron +;; Keywords: tools + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; TODO: + +;; - Minibuffer export to tabulated list. +;; - Annotate completion candidates. + +;;; Code: + +(defgroup kubed nil + "Kubernetes interface." + :group 'tools) + +(defcustom kubed-update-hook nil + "List of functions that `kubed-update-all' runs." + :type 'hook) + +(defcustom kubed-kubectl-executable "kubectl" + "Name of `kubectl' executable." + :type 'string) + +;;;###autoload +(defun kubed-update-all () + "Update all Kuberenetes resource lists." + (interactive) + (run-hooks 'kubed-update-hook)) + +(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.") + +(defmacro kubed-define-resource (resource &optional properties &rest commands) + "Define Kubernetes RESOURCE with PROPERTIES and associated COMMANDS." + (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))) + (hook-var (intern (format "kubed-update-%Ss-hook" resource))) + (proc-var (intern (format "kubed-%Ss-process" resource))) + (plrl-var (intern (format "%Ss" resource))) + (read-fun (intern (format "kubed-read-%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))) + (updt-cmd (intern (format "kubed-update-%Ss" resource))) + (list-cmd (intern (format "kubed-list-%Ss" 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))) + (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))) + (mod-name (intern (format "kubed-%Ss-mode" resource))) + (cmd-doc (format "Describe Kubernetes %S %s." resource (upcase (symbol-name resource))))) + `(progn + (defvar ,hist-var nil + ,(format "History list for `%S'." read-fun)) + (defvar ,list-var nil + ,(format "List of Kubernetes resources of type `%S'." resource)) + (defvar ,hook-var nil + ,(format "List of functions to run after updating `%S'." list-var)) + (defvar ,proc-var nil + ,(format "Process that updates Kubernetes resources of type `%S'." resource)) + + (defun ,sure-fun () + ,(format "Populate `%S', if not already populated." list-var) + (unless (or ,list-var (process-live-p ,proc-var)) + (,updt-cmd))) + + (defun ,updt-cmd () + ,(format "Update `%S'." list-var) + (interactive) + (with-current-buffer (get-buffer-create ,out-name) + (erase-buffer)) + (setq ,proc-var + (make-process + :name ,(format "*kubed-get-%Ss*" resource) + :buffer ,out-name + :stderr ,err-name + :command (list + kubed-kubectl-executable + "get" ,(format "%Ss" resource) + "--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)) + ","))) + :sentinel (lambda (_proc status) + (cond + ((string= status "finished\n") + (let (new) + (with-current-buffer ,out-name + (goto-char (point-min)) + (while (not (eobp)) + (let ((line (buffer-substring + (point) + (progn + (forward-line 1) + (1- (point)))))) + (push (split-string line " " t) new)))) + (setq ,list-var new) + (run-hooks ',hook-var) + (message ,(format "Updated Kubernetes %Ss." resource)))) + ((string= status "exited abnormally with code 1\n") + (with-current-buffer ,err-name + (goto-char (point-max)) + (insert "\n" status)) + (display-buffer ,err-name)))))) + (minibuffer-message ,(format "Updating Kubernetes %Ss..." resource))) + + (defun ,read-fun (prompt &optional default) + ,(format "Prompt with PROMPT for a Kubernetes %S name. + +Optional argument DEFAULT is the minibuffer default argument." resource) + (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)) + + (defun ,cmd-name (,resource) + ,cmd-doc + (interactive (list (,read-fun "Describe"))) + (display-buffer (,desc-fun ,resource))) + + (put ',cmd-name 'minibuffer-action "describe") + + (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) + + (defun ,ents-fun () + ,(format "Format `%S' for display as `tabulated-list-entries'." alst-var) + (mapcar + (lambda (c) (list (car c) (apply #'vector c))) + ,alst-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)) + (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)) + (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)) + (user-error ,(format "No Kubernetes %S at point" resource)))) + + (defun ,desc-cmd () + ,(format "Describe Kubernetes %S at point." resource) + (interactive "" ,mod-name) + (if-let ((,resource (tabulated-list-get-id))) + (display-buffer (,desc-fun ,resource)) + (user-error ,(format "No Kubernetes %S at point" resource)))) + + ,@(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) + (user-error ,(format "No Kubernetes %S at point" resource))))) + commands) + + (defvar-keymap ,(intern (format "kubed-%Ss-mode-map" resource)) + :doc ,(format "Keymap for `%S" mod-name) + "RET" #',slct-cmd + "o" #',othr-cmd + "C-o" #',desc-cmd + "G" #',updt-cmd + "D" #',dlt-cmd + ,@(mapcan + (pcase-lambda (`(,suffix ,key ,_desc . ,_body)) + (list key `#',(intern (format "kubed-%Ss-%S" resource suffix)))) + commands)) + + (define-derived-mode ,mod-name tabulated-list-mode + ,(format "Kubernetes %ss" (capitalize (symbol-name resource))) + ,(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))) + (setq tabulated-list-entries #',ents-fun) + (setq tabulated-list-padding 2) + (tabulated-list-init-header)) + + (defun ,buff-fun (,plrl-var &optional buffer frozen) + (with-current-buffer (or buffer (get-buffer-create ,list-buf)) + (,mod-name) + (let* ((buf (current-buffer)) + (fun (lambda () + (when (buffer-live-p buf) + (with-current-buffer buf + (unless kubed-frozen + (setq ,alst-var ,list-var) + (tabulated-list-print t t))))))) + (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) + (tabulated-list-print) + (current-buffer))) + + (defun ,list-cmd () + ,(format "List Kubernetes %Ss." resource) + (interactive) + (,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) +;;;###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 ":"))) + (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) +;;;###autoload (autoload 'kubed-list-namespaces "kubed" nil t) +(kubed-define-resource namespace) + +;;;###autoload (autoload 'kubed-describe-service "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-service "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-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-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-list-deployments "kubed" nil t) +(kubed-define-resource deployment) + +(defun kubed-contexts () + "Return list of Kubernetes contexts." + (process-lines kubed-kubectl-executable "config" "get-contexts" "-o" "name")) + +(defun kubed-current-context () + "Return current Kubernetes context." + (car (process-lines kubed-kubectl-executable "config" "current-context"))) + +(defvar kubed-context-history nil + "History list for `kubed-read-context'.") + +(defun kubed-read-context (prompt &optional default) + "Prompt with PROMPT for a Kubernetes context. + +Optional argument DEFAULT is the minibuffer default argument." + (completing-read (format-prompt prompt default) + (kubed-contexts) + nil 'confirm nil 'kubed-context-history default)) + +;;;###autoload +(defun kubed-use-context (context) + "Set current Kubernetes context to CONTEXT." + (interactive + (list (kubed-read-context "Use context" (kubed-current-context)))) + (unless (zerop + (call-process + kubed-kubectl-executable nil nil nil + "config" "use-context" context)) + (user-error "Failed to use Kubernetes context `%s'" context)) + (message "Now using Kubernetes context `%s'." context) + (kubed-update-all)) + +(defun kubed-current-namespace () + "Return current Kubernetes namespace." + (car (process-lines kubed-kubectl-executable "config" "view" "-o" "jsonpath={..namespace}"))) + +;;;###autoload +(defun kubed-set-namespace (ns) + "Set current Kubernetes namespace to NS." + (interactive + (list (kubed-read-namespace "Set namespace" (kubed-current-namespace)))) + (unless (zerop + (call-process + kubed-kubectl-executable nil nil nil + "config" "set-context" "--current" "--namespace" ns)) + (user-error "Failed to set Kubernetes namespace to `%s'" ns)) + (message "Kubernetes namespace is now `%s'." ns) + (kubed-update-all)) + +;;;###autoload +(defun kubed-create-pod (definition) + "Create Kubernetes pod with definition DEFINITION." + (interactive (list (read-file-name "Pod definition file: "))) + (message "Creating pod with definition `%s'..." definition) + (message "Creating pod with definition `%s'... Done. New pod name is `%s'." + definition (car (process-lines kubed-kubectl-executable + "create" "-f" + (expand-file-name definition) + "-o" "jsonpath={.metadata.name}")))) + +(keymap-set kubed-pods-mode-map "+" #'kubed-create-pod) + +(provide 'kubed) +;;; kubed.el ends here -- 2.39.5