From caadc892e49cb63689a9dbee1378cc0170259ce9 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Mon, 22 Jul 2024 11:56:29 +0200 Subject: [PATCH] * lisp/net/kubed.el: Develop some more --- lisp/net/kubed.el | 148 +++++++++++++++++++++++++++++++++------------- 1 file changed, 107 insertions(+), 41 deletions(-) diff --git a/lisp/net/kubed.el b/lisp/net/kubed.el index 27900ba0ac0..785c2aecfd9 100644 --- a/lisp/net/kubed.el +++ b/lisp/net/kubed.el @@ -42,7 +42,6 @@ ;;; TODO: -;; - Annotate completion candidates in `kubed-read-*' functions. ;; - Add a way to filter resources lists. ;; - Add `kubed-create-*' commands for more resource types. @@ -83,7 +82,7 @@ by default it is `yaml-ts-mode'." 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) +(defcustom kubed-name-column '("Name" 48 t) "Specification of name column in Kubernetes resource list buffers." :type '(list string natnum boolean)) @@ -114,15 +113,20 @@ interacting with Kubernetes RESOURCEs: 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. +PROPERTIES is a list of elements (PROPERTY JSON-PATH WIDTH SORT . ATTRS) +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, SORT and ATTRS are optional and can be omitted. +WIDTH is used as the default width of the column corresponding to +PROPERTY in RESOURCEs list buffers; SORT is sort predicate, a function +that takes two values of PROPERTY as strings and return non-nil if the +first should sort before the second; ATTRS is a plist of additional +attributes of the PROPERTY column, see `tabulated-list-format' for +available attributes. For example, (phase \".status.phase\" 10) says +that RESOURCE has a `phase' property at JSONPath \".status.phase\" whose +values are typically 10 columns wide. The first property in PROPERTIES, +is used to annotate completion candidates when prompting for a RESOURCE. COMMANDS is a list of elements (COMMAND KEYS DOC-PREFIX . BODY) that define commands for RESOURCE list buffers. COMMAND is a symbol @@ -169,6 +173,7 @@ namespaceless resource type, put `:namespaced nil' before COMMANDS: (buff-fun (intern (format "kubed-%Ss-buffer" resource))) (frmt-fun (intern (format "kubed-%Ss-format" resource))) (desc-fun (intern (format "kubed-%S-description-buffer" resource))) + (affx-fun (intern (format "kubed-%Ss-affixation" 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))) @@ -221,16 +226,23 @@ namespaceless resource type, put `:namespaced nil' before COMMANDS: :command (list kubed-kubectl-executable "get" ,(format "%Ss" resource) - (concat "--all-namespaces=" - (if kubed-all-namespaces-mode "true" "false")) + ,@(when namespaced + `((concat "--all-namespaces=" + (if kubed-all-namespaces-mode "true" "false")))) "--no-headers=true" (format "--output=custom-columns=%s" (string-join (cons "NAME:.metadata.name" - (append - (when kubed-all-namespaces-mode - (list "NAMESPACE:.metadata.namespace")) - ',(mapcar (lambda (p) + ,(if namespaced + `(append + (when kubed-all-namespaces-mode + '("NAMESPACE:.metadata.namespace")) + ',(mapcar (lambda (p) + (concat (upcase (symbol-name (car p))) + ":" + (cadr p))) + properties)) + (mapcar (lambda (p) (concat (upcase (symbol-name (car p))) ":" (cadr p))) @@ -260,13 +272,24 @@ namespaceless resource type, put `:namespaced nil' before COMMANDS: (display-buffer ,err-name)))))) (minibuffer-message ,(format "Updating Kubernetes %Ss..." resource))) + (defun ,affx-fun (,plrl-var) + ,(format "Return Kubernetes %s with completion affixations." + (upcase (symbol-name plrl-var))) + (let ((max (seq-max (cons 0 (mapcar #'string-width ,plrl-var))))) + (mapcar (lambda (,resource) + (list ,resource "" + (concat (make-string (1+ (- max (string-width ,resource))) ?\s) + (propertize (or (cadr (assoc ,resource ,list-var)) "") + 'face 'completions-annotations)))) + ,plrl-var))) + (defun ,read-fun (prompt &optional default multi) ,(format "Prompt with PROMPT for a Kubernetes %S name. 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) +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)) (funcall @@ -275,7 +298,9 @@ instead of just one." resource plrl-var) (lambda (s p a) (if (eq a 'metadata) '(metadata - (category . ,(intern (format "kubernetes-%S" resource)))) + (category . ,(intern (format "kubernetes-%S" resource))) + ,@(when properties + `((affixation-function . ,affx-fun)))) (while (and (process-live-p ,proc-var) (null ,list-var)) (accept-process-output ,proc-var 1)) @@ -290,7 +315,7 @@ Optional argument DEFAULT is the minibuffer default argument." resource) ,(if namespaced `(defun ,desc-fun (,resource &optional k8sns) - ,(format "Return buffer with description of Kubernetes %S %s" + ,(format "Return buffer describing Kubernetes %S %s" resource (upcase (symbol-name resource))) (let ((buf (get-buffer-create ,buf-name))) (with-current-buffer buf @@ -423,7 +448,7 @@ Optional argument DEFAULT is the minibuffer default argument." resource) (defvar-local ,ents-var nil) (defun ,ents-fun () - ,(format "Format `%S' for display as `tabulated-list-entries'." ents-var) + ,(format "`tabulated-list-entries' function for `%s'." mod-name) (mapcar (lambda (c) (list ,(if namespaced `(if kubed-all-namespaces-mode @@ -654,20 +679,36 @@ Optional argument DEFAULT is the minibuffer default argument." resource) commands)) (defvar ,frmt-var - ',(mapcar (lambda (p) - (list (capitalize (symbol-name (car p))) - (caddr p) - t)) - properties)) + ',(let ((i 0) + (res nil)) + (dolist (p properties) + (setq i (1+ i)) + (push + (append + (list (capitalize (symbol-name (car p))) + (caddr p) + (if-let ((sorter (cadddr p))) + `(lambda (l r) + ,(if namespaced + `(let ((c (+ ,i (if kubed-all-namespaces-mode 1 0)))) + (funcall ,sorter (aref (cadr l) c) (aref (cadr r) c))) + `(funcall ,sorter (aref (cadr l) ,i) (aref (cadr r) ,i)))) + + t)) + (nthcdr 4 p)) + res)) + (reverse res))) (defun ,frmt-fun () (apply #'vector (cons kubed-name-column - (append - (when kubed-all-namespaces-mode - (list kubed-namespace-column)) - ,frmt-var)))) + ,(if namespaced + `(append + (when kubed-all-namespaces-mode + (list kubed-namespace-column)) + ,frmt-var) + frmt-var)))) (define-derived-mode ,mod-name tabulated-list-mode (list ,(format "Kubernetes %ss" (capitalize (symbol-name resource))) @@ -733,6 +774,11 @@ Optional argument DEFAULT is the minibuffer default argument." resource) (kubed-define-resource pod ((phase ".status.phase" 10) (starttime ".status.startTime" 20)) (dired "C-d" "Start Dired in home directory of first container of" + ;; FIXME: This doesn't really make sense for other namespaces, + ;; we create the Dired buffer using the correct namespace, but + ;; all subsequent operations in that buffer are outside the + ;; scope of the let-binding and thus use the wrong namespace. + ;; Ideally, we'd like to hardcode the namespace into filename. (let ((tramp-kubernetes-namespace k8sns)) (dired (concat "/kubernetes:" pod ":")))) (shell "S" "Start shell in home directory of first container of" @@ -755,6 +801,12 @@ Optional argument DEFAULT is the minibuffer default argument." resource) ;;;###autoload (autoload 'kubed-list-namespaces "kubed" nil t) (kubed-define-resource namespace () :namespaced nil) +;;;###autoload (autoload 'kubed-display-persistentvolume "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-persistentvolume "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-persistentvolumes "kubed" nil t) +;;;###autoload (autoload 'kubed-list-persistentvolumes "kubed" nil t) +(kubed-define-resource persistentvolume () :namespaced nil) + ;;;###autoload (autoload 'kubed-display-service "kubed" nil t) ;;;###autoload (autoload 'kubed-edit-service "kubed" nil t) ;;;###autoload (autoload 'kubed-delete-services "kubed" nil t) @@ -781,6 +833,30 @@ Optional argument DEFAULT is the minibuffer default argument." resource) ;;;###autoload (autoload 'kubed-list-deployments "kubed" nil t) (kubed-define-resource deployment) +;;;###autoload (autoload 'kubed-display-replicaset "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-replicaset "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-replicasets "kubed" nil t) +;;;###autoload (autoload 'kubed-list-replicasets "kubed" nil t) +(kubed-define-resource replicaset + ((reps ".status.replicas" 4 + (lambda (l r) (< (string-to-number l) (string-to-number r))) + :right-align t) + (ownerkind ".metadata.ownerReferences[0].kind" 12) + (ownername ".metadata.ownerReferences[0].name" 16) + (creationtimestamp ".metadata.creationTimestamp" 20))) + +;;;###autoload (autoload 'kubed-display-statefulset "kubed" nil t) +;;;###autoload (autoload 'kubed-edit-statefulset "kubed" nil t) +;;;###autoload (autoload 'kubed-delete-statefulsets "kubed" nil t) +;;;###autoload (autoload 'kubed-list-statefulsets "kubed" nil t) +(kubed-define-resource statefulset + ((reps ".status.replicas" 4 + (lambda (l r) (< (string-to-number l) (string-to-number r))) + :right-align t) + (ownerkind ".metadata.ownerReferences[0].kind" 12) + (ownername ".metadata.ownerReferences[0].name" 16) + (creationtimestamp ".metadata.creationTimestamp" 20))) + (defun kubed-contexts () "Return list of Kubernetes contexts." (process-lines kubed-kubectl-executable "config" "get-contexts" "-o" "name")) @@ -978,15 +1054,5 @@ one port-forwarding process, stop that process without prompting." (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