]> git.eshelyaron.com Git - kubed.git/commitdiff
Improve Tramp integration
authorEshel Yaron <me@eshelyaron.com>
Fri, 23 Aug 2024 11:20:41 +0000 (13:20 +0200)
committerEshel Yaron <me@eshelyaron.com>
Fri, 23 Aug 2024 11:20:41 +0000 (13:20 +0200)
* kubed-tramp.el: New file.
* kubed.el (kubed--static-if): No longer used, removed.
(kubed-edit-resource): Adapt.
(kubed-pods-dired, kubed-pods-shell): Use new Tramp method.
(kubed-remote-file-name-p): New function.
(kubed-local-context, kubed-local-namespace)
(kubed-local-context-and-namespace): Use it.

kubed-tramp.el [new file with mode: 0644]
kubed.el

diff --git a/kubed-tramp.el b/kubed-tramp.el
new file mode 100644 (file)
index 0000000..a3152a2
--- /dev/null
@@ -0,0 +1,107 @@
+;;; kubed-tramp.el --- Kubed Tramp integration   -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Free Software Foundation, Inc.
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Keywords: tools
+
+;;; Commentary:
+
+;; This library provides Tramp integration for Kubed.  This is similar
+;; to the built-in "kubernetes" Tramp method from tramp-container.el,
+;; except that the Kubed method always requires the container name and
+;; Kubernetes namespace to be specified, as well a `kubectl' context.
+;; In other words, the filename syntax of this method is fully explicit.
+;; An explicit syntax is useful when juggling between different contexts
+;; and namespaces with Kubed; on the other hand, for finding a remote
+;; file with C-x C-f, the concise syntax of the built-in "kubernetes"
+;; method is probably more convenient.
+
+;;; Code:
+
+(require 'kubed)
+(require 'tramp)
+
+(defun kubed-tramp--context (vec)
+  "Extract the context name from a kubernetes host name in VEC."
+  (or (when-let ((host (and vec (tramp-file-name-host vec))))
+        (nth 0 (split-string host "%")))
+      ""))
+
+(defun kubed-tramp--namespace (vec)
+  "Extract the namespace from a kubernetes host name in VEC."
+  (or (when-let ((host (and vec (tramp-file-name-host vec))))
+        (nth 1 (split-string host "%")))
+      ""))
+
+(defun kubed-tramp--pod (vec)
+  "Extract the pod name from a kubernetes host name in VEC."
+  (or (when-let ((host (and vec (tramp-file-name-host vec))))
+        (nth 2 (split-string host "%")))
+      ""))
+
+(defun kubed-tramp--container (vec)
+  "Extract the container name from a kubernetes host name in VEC."
+  (or (when-let ((host (and vec (tramp-file-name-host vec))))
+        (nth 3 (split-string host "%")))
+      ""))
+
+(defvar kubed-tramp-method "kubedv1"    ;Versioned, for compatibility.
+  ;; (find-file "/kubedv1:CONTEXT%NAMESPACE%POD%CONTAINER:/some/file")
+  "Name of the Kubed Tramp method.")
+
+(defun kubed-tramp-remote-file-name (context namespace pod &optional file-name)
+  "Return Tramp remote FILE-NAME for POD in NAMESPACE and CONTEXT."
+  (concat "/" kubed-tramp-method ":"
+          context "%" namespace "%" pod
+          "%" (kubed-read-container pod "Container" t context namespace)
+          ":" file-name))
+
+;;;###autoload
+(defun kubed-tramp-context (file-name)
+  "Extract `kubectl' context from Kubed Tramp remote file name FILE-NAME."
+  (nth 0 (split-string
+          (tramp-file-name-host (tramp-dissect-file-name file-name)) "%")))
+
+;;;###autoload
+(defun kubed-tramp-namespace (file-name)
+  "Extract Kubernetes namespace from Kubed Tramp remote file name FILE-NAME."
+  (nth 1 (split-string
+          (tramp-file-name-host (tramp-dissect-file-name file-name)) "%")))
+
+;;;###autoload
+(defun kubed-tramp-assert-support ()
+  "Check if Kubed Tramp support is available, throw `user-error' if not."
+  (unless (assoc kubed-tramp-method tramp-methods)
+    (user-error "Kubed Tramp support requires Tramp version 2.7 or later")))
+
+(when (boundp 'tramp-extra-expand-args) ; Tramp 2.7+
+  (setf (alist-get kubed-tramp-method tramp-methods nil nil #'string=)
+        `((tramp-login-program ,kubed-kubectl-program)
+          (tramp-login-args (("exec")
+                             ("--context" "%x")
+                             ("--namespace" "%y")
+                             ("-c" "%a")
+                             ("%h")
+                             ("-it")
+                             ("--")
+                            ("%l")))
+          (tramp-direct-async (,tramp-default-remote-shell "-c"))
+          (tramp-remote-shell ,tramp-default-remote-shell)
+          (tramp-remote-shell-login ("-l"))
+          (tramp-remote-shell-args ("-i" "-c"))))
+
+  (connection-local-set-profile-variables
+   'kubed-tramp-connection-local-default-profile
+   '((tramp-extra-expand-args
+      ?a (kubed-tramp--container (car tramp-current-connection))
+      ?h (kubed-tramp--pod       (car tramp-current-connection))
+      ?x (kubed-tramp--context   (car tramp-current-connection))
+      ?y (kubed-tramp--namespace (car tramp-current-connection)))))
+
+  (connection-local-set-profiles
+   `(:application tramp :protocol ,kubed-tramp-method)
+   'kubed-tramp-connection-local-default-profile))
+
+(provide 'kubed-tramp)
+;;; kubed-tramp.el ends here
index f8639c46c79453fafe62ccf67643a492f82c1e23..5925b1235a072b4598459d317359359b79f60a15 100644 (file)
--- a/kubed.el
+++ b/kubed.el
@@ -1088,20 +1088,6 @@ prompt for CONTEXT as well."
     (error (format "Failed to delete Kubernetes %s `%s'"
                    type (string-join resources "', `")))))
 
-(defmacro kubed--static-if (condition then-form &rest else-forms)
-  "A conditional compilation macro.
-Evaluate CONDITION at macro-expansion time.  If it is non-nil, expand
-the macro to THEN-FORM.  Otherwise expand it to ELSE-FORMS enclosed in a
-‘progn’ form.  ELSE-FORMS may be empty.
-
-This is the same as `static-if' from Emacs 30, defined here for
-compatibility with earlier Emacs versions."
-  (declare (indent 2)
-           (debug (sexp sexp &rest sexp)))
-  (if (eval condition lexical-binding)
-      then-form
-    (when else-forms (cons 'progn else-forms))))
-
 ;;;###autoload
 (defun kubed-edit-resource (type resource context &optional namespace)
   "Edit Kubernetes RESOURCE of type TYPE in context CONTEXT.
@@ -1138,7 +1124,7 @@ prompt for CONTEXT as well."
            context namespace)))
   (unless (bound-and-true-p server-process) (server-start))
   (let ((process-environment
-         (cons (kubed--static-if (<= 30 emacs-major-version)
+         (cons (if (boundp 'emacsclient-program-name)
                    (concat "KUBE_EDITOR=" emacsclient-program-name)
                  "KUBE_EDITOR=emacsclient")
                process-environment)))
@@ -1665,6 +1651,12 @@ Interactively, use the current context.  With a prefix argument
                "\\)")
        1))
 
+(declare-function kubed-tramp-context          "kubed-tramp" (file-name))
+(declare-function kubed-tramp-namespace        "kubed-tramp" (file-name))
+(declare-function kubed-tramp-assert-support   "kubed-tramp" ())
+(declare-function kubed-tramp-remote-file-name "kubed-tramp"
+                  (context namespace pod &optional file-name))
+
 ;;;###autoload (autoload 'kubed-display-pod "kubed" nil t)
 ;;;###autoload (autoload 'kubed-edit-pod "kubed" nil t)
 ;;;###autoload (autoload 'kubed-delete-pods "kubed" nil t)
@@ -1709,38 +1701,18 @@ Interactively, use the current context.  With a prefix argument
                ("s" "Shell" kubed-pods-shell)
                ("F" "Forward port" kubed-pods-forward-port)])
   (dired "C-d" "Start Dired in"
-         ;; Explicit namespace in Kuberenetes remote file names
-         ;; introduced in Emacs 31.  See Bug#59797.
-         (kubed--static-if (<= 31 emacs-major-version)
-             (dired (concat "/kubernetes:" pod "%" kubed-list-namespace ":"))
-           ;; FIXME: Also check context.
-           (unless (string= kubed-list-namespace (kubed-current-namespace))
-             (if (y-or-n-p
-                  (format "Starting Dired in a pod in a different namespace \
-requires Emacs 31 or later.
-You can proceed by first switching your current namespace.
-Switch to namespace `%s' and proceed?" kubed-list-namespace))
-                 (kubed-set-namespace kubed-list-namespace)
-               (user-error
-                "Cannot start Dired in a pod in different namespace `%s'"
-                kubed-list-namespace)))
-           (dired (concat "/kubernetes:" pod ":"))))
+         (kubed-tramp-assert-support)
+         (dired (kubed-tramp-remote-file-name
+                 kubed-list-context kubed-list-namespace pod)))
   (shell "s" "Start shell in"
-         (kubed--static-if (<= 31 emacs-major-version)
-             (let* ((default-directory (concat "/kubernetes:" pod "%" kubed-list-namespace ":")))
-               (shell (format "*kubed-pod-%s-shell*" pod)))
-           (unless (string= kubed-list-namespace (kubed-current-namespace))
-             (if (y-or-n-p
-                  (format "Starting Shell in a pod in a different namespace \
-requires Emacs 31 or later.
-You can proceed by first switching your current namespace.
-Switch to namespace `%s' and proceed?" kubed-list-namespace))
-                 (kubed-set-namespace kubed-list-namespace)
-               (user-error
-                "Cannot start Shell in a pod in different namespace `%s'"
-                kubed-list-namespace)))
-           (let* ((default-directory (concat "/kubernetes:" pod ":")))
-             (shell (format "*kubed-pod-%s-shell*" pod)))))
+         (kubed-tramp-assert-support)
+         (let* ((default-directory (kubed-tramp-remote-file-name
+                                    kubed-list-context kubed-list-namespace pod)))
+           (shell
+            (concat "*Kubed Shell "
+                    (kubed-display-resource-short-description
+                     "pods" pod kubed-list-context kubed-list-namespace)
+                    "*"))))
   (attach "a" "Attach to remote process running on"
           (kubed-attach pod (kubed-read-container pod "Container" t
                                                   kubed-list-context
@@ -2370,10 +2342,18 @@ DEFAULT-BACKEND is the service to use as a backend for unhandled URLs."
   "Return default Kubernetes namespace in the default context."
   (cdr (kubed-default-context-and-namespace)))
 
+(defun kubed-remote-file-name-p (file-name)
+  "Check whether FILE-NAME is a Kubed Tramp remote file name."
+  ;; We use this function to heuristically check file names without
+  ;; loading `kubed-tramp' (which in turn loads `tramp').
+  (string-match-p "[/|]kubedv[0-9]+:" file-name))
+
 (defun kubed-local-context ()
   "Return Kubernetes context local to the current buffer."
   (or kubed-list-context
       (nth 2 kubed-display-resource-info)
+      (and (kubed-remote-file-name-p default-directory)
+           (kubed-tramp-context default-directory))
       (kubed-default-context)))
 
 (defvar kubed-context-history nil
@@ -2453,10 +2433,8 @@ If no namespace is configured for CONTEXT, return nil."
   "Return Kubernetes namespace in CONTEXT local to the current buffer."
   (or kubed-list-namespace
       (nth 3 kubed-display-resource-info)
-      (kubed--static-if (<= 31 emacs-major-version)
-          (and (string-match "[/|]kubernetes:.*%\\([a-z0-9-]+\\):"
-                             default-directory)
-               (match-string 1 default-directory)))
+      (and (kubed-remote-file-name-p default-directory)
+           (kubed-tramp-namespace default-directory))
       (kubed-default-namespace)))
 
 (defun kubed-local-context-and-namespace ()
@@ -2469,13 +2447,10 @@ If no namespace is configured for CONTEXT, return nil."
         (cons context
               (or (nth 3 kubed-display-resource-info)
                   (kubed-current-namespace context))))
-      (let ((context (kubed-default-context)))
-        (cons context
-              (or (kubed--static-if (<= 31 emacs-major-version)
-                      (and (string-match "[/|]kubernetes:.*%\\([a-z0-9-]+\\):"
-                                         default-directory)
-                           (match-string 1 default-directory)))
-                  (kubed-default-namespace))))))
+      (when-let ((context (and (kubed-remote-file-name-p default-directory)
+                               (kubed-tramp-context default-directory))))
+        (cons context (kubed-tramp-namespace default-directory)))
+      (kubed-default-context-and-namespace)))
 
 ;;;###autoload
 (defun kubed-set-namespace (namespace &optional context)