From 4c0e359b391aa4db45cdbe99df5ddaf6e082441a Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 10:29:31 +0800 Subject: [PATCH 01/23] tramp: initial working version --- extensions/tramp/lem-tramp.asd | 4 + extensions/tramp/tramp.lisp | 580 ++++++++++++++++++++++++++++++++ lem.asd | 3 +- src/buffer/file-utils.lisp | 101 ++++-- src/buffer/file.lisp | 15 +- src/buffer/internal/buffer.lisp | 2 +- src/commands/file.lisp | 2 +- 7 files changed, 675 insertions(+), 32 deletions(-) create mode 100644 extensions/tramp/lem-tramp.asd create mode 100644 extensions/tramp/tramp.lisp diff --git a/extensions/tramp/lem-tramp.asd b/extensions/tramp/lem-tramp.asd new file mode 100644 index 000000000..5addc89f5 --- /dev/null +++ b/extensions/tramp/lem-tramp.asd @@ -0,0 +1,4 @@ +(defsystem "lem-tramp" + :depends-on ("lem/core" "flexi-streams" "str") + :serial t + :components ((:file "tramp"))) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp new file mode 100644 index 000000000..89c51a7e7 --- /dev/null +++ b/extensions/tramp/tramp.lisp @@ -0,0 +1,580 @@ +(defpackage :lem-tramp + (:use :cl :lem) + (:export :tramp-mode)) +(in-package :lem-tramp) + +(setf (documentation *package* t) + "TRAMP-like remote file editing for Lem. +Supports /ssh:user@host:/path and /sudo::/path syntax for transparent +remote file access via SSH and sudo. + +C-x C-f /ssh:host:/etc/hostname +C-x C-f /sudo::/etc/hostname") + +;;; ------------------------------------------------------------------ +;;; Path Parsing +;;; ------------------------------------------------------------------ + +(defun tramp-path-p (filename) + "Return T if FILENAME is a TRAMP-style path (/method:user@host:/path)." + (when (pathnamep filename) + (setf filename (namestring filename))) + (and (stringp filename) + (> (length filename) 1) + (char= (char filename 0) #\/) + (ppcre:scan "^\\w+:" (subseq filename 1)) + t)) + +(defun parse-tramp-path (filename) + "Parse FILENAME like /ssh:user@host:/remote/path or /sudo::/path. +Returns (values method user host remote-path)." + (when (pathnamep filename) + (setf filename (namestring filename))) + (ppcre:register-groups-bind (method user-host remote-path) + ("^/(\\w+):([^:]*):(.+)" filename) + (unless method + (editor-error "Invalid TRAMP path: ~A" filename)) + (let ((user nil) + (host nil)) + (when (and user-host (> (length user-host) 0)) + (if (find #\@ user-host) + (ppcre:register-groups-bind (u h) + ("^([^@]*)@(.*)" user-host) + (setf user (unless (string= u "") u) + host (unless (string= h "") h))) + (setf host user-host))) + (when (null host) + (setf host "localhost")) + (values (intern (string-upcase method) :keyword) + user + host + remote-path)))) + +;;; ------------------------------------------------------------------ +;;; Password Management +;;; ------------------------------------------------------------------ + +(defvar *tramp-passwords* (make-hash-table :test 'equal) + "Cache of passwords keyed by connection key (e.g. \"sudo:root@localhost\").") + +(defun tramp-connection-key (method user host) + "Make a cache key for a TRAMP connection." + (format nil "~A:~A@~A" method (or user "") host)) + +(defun tramp-get-password (method user host) + "Get the cached password for a connection, or nil." + (values (gethash (tramp-connection-key method user host) *tramp-passwords*))) + +(defun tramp-clear-password (method user host) + "Clear the cached password for a connection (on auth failure)." + (remhash (tramp-connection-key method user host) *tramp-passwords*)) + +(defun tramp-prompt-password (method user host) + "Prompt the user for a password and cache it. +Returns the password string, or nil if cancelled/empty." + (let ((prompt (format nil "TRAMP password for /~A:~@[~A@~]~A: " + (string-downcase method) user host))) + (let ((password (prompt-for-string prompt))) + (if (and password (plusp (length password))) + (progn + (setf (gethash (tramp-connection-key method user host) *tramp-passwords*) + password) + password) + (progn + (tramp-clear-password method user host) + nil))))) + +(defvar *ssh-key-auth-cache* (make-hash-table :test 'equal) + "Cache of SSH key auth results. Maps connection key to T (key works) or NIL (needs password).") + +(defun sshpass-available-p () + "Check if the sshpass utility is available on the system." + (or (eql 0 (nth-value 2 + (uiop:run-program '("which" "sshpass") + :output nil + :error-output nil + :ignore-error-status t))) + ;; Fallback: check if sshpass exists at common locations + (probe-file "/usr/bin/sshpass") + (probe-file "/usr/local/bin/sshpass"))) + +(defun ssh-check-key-auth (user host) + "Check if key-based SSH authentication works for USER@HOST. +Returns T if key auth works, NIL otherwise. Caches the result." + (let* ((conn-key (format nil "~A@~A" (or user "") host)) + (cached (gethash conn-key *ssh-key-auth-cache* :not-found))) + (when (eq cached :not-found) + (let ((target (if user (format nil "~A@~A" user host) host))) + (setf cached + (eql 0 (handler-case + (nth-value 2 + (uiop:run-program + `("ssh" "-T" + "-o" "BatchMode=yes" + "-o" "ConnectTimeout=3" + "-o" "StrictHostKeyChecking=accept-new" + ,@(ssh-control-options) + ,target "true") + :output nil + :error-output nil + :ignore-error-status t)) + (error () 1)))) + (setf (gethash conn-key *ssh-key-auth-cache*) cached))) + cached)) + +(defun tramp-ensure-password (method user host) + "Get cached password or prompt the user. Returns nil if no password needed/available." + (or (tramp-get-password method user host) + (ecase method + (:sudo + (or (tramp-prompt-password method user host) + (error 'editor-abort))) + (:ssh + (unless (ssh-check-key-auth user host) + (if (sshpass-available-p) + (tramp-prompt-password method user host) + (editor-error + "SSH key authentication failed for ~A@~A.~%~ + Install sshpass for password authentication, or set up SSH keys." + (or user "") host))))))) + +;;; ------------------------------------------------------------------ +;;; Remote Command Execution +;;; ------------------------------------------------------------------ + +(defun ssh-control-options () + "Return SSH ControlMaster options for connection multiplexing. +All SSH connections to the same host reuse a single TCP connection, +avoiding repeated authentication delays." + (list "-o" "ControlMaster=auto" + "-o" "ControlPath=/tmp/lem-ssh-%C" + "-o" "ControlPersist=60")) + +(defun build-ssh-args (method user host command &key (use-sudo-s nil) password) + "Build the argument list for running a command via SSH or sudo. +When USE-SUDO-S is T, sudo reads the password from stdin (-S flag). +When PASSWORD is provided for :ssh, uses sshpass to deliver the password." + (ecase method + (:ssh + (let ((target (if user (format nil "~A@~A" user host) host)) + (cmd-args (if (listp command) command (list command))) + (control-opts (ssh-control-options))) + (if password + `("sshpass" "-p" ,password + "ssh" "-T" + "-o" "StrictHostKeyChecking=accept-new" + "-o" "ConnectTimeout=3" + ,@control-opts + ,target ,@cmd-args) + `("ssh" "-T" + "-o" "BatchMode=yes" + "-o" "StrictHostKeyChecking=accept-new" + "-o" "ConnectTimeout=3" + ,@control-opts + ,target ,@cmd-args)))) + (:sudo + (let ((args (list "sudo"))) + (when use-sudo-s + (push "-S" (cdr args))) ; -S: read password from stdin + (when user + (setf args (append args (list "-u" user)))) + (append args (if (listp command) command (list command))))))) + +(defun %run-remote-with-password (method user host args + &key (output :string) input (error-output :string)) + "Run a command with optional password authentication. +For :sudo, sends password via stdin with sudo -S. +For :ssh, password is passed via sshpass in the args list. +Returns (values process-info password-input-stream-or-nil)." + (let ((password (tramp-ensure-password method user host))) + (if password + (ecase method + (:sudo + ;; sudo: password via stdin with -S + (handler-case + (let ((process + (uiop:launch-program args + :output output + :input :stream + :error-output error-output + :ignore-error-status t))) + (let ((pwd-stream (uiop:process-info-input process))) + (write-line password pwd-stream) + (finish-output pwd-stream) + (values process pwd-stream))) + (editor-error (e) + (error e)) + (error (e) + (tramp-clear-password method user host) + (editor-error "Failed to run remote command ~A: ~A" args e)))) + (:ssh + ;; ssh: password already in args via sshpass prefix (build-ssh-args) + (handler-case + (values (uiop:launch-program args + :output output + :input input + :error-output error-output + :ignore-error-status t) + nil) + (editor-error (e) + (error e)) + (error (e) + (tramp-clear-password method user host) + (editor-error "Failed to run remote command ~A: ~A" args e))))) + ;; No password needed + (handler-case + (values (uiop:launch-program args + :output output + :input input + :error-output error-output + :ignore-error-status t) + nil) + (editor-error (e) + (error e)) + (error (e) + (editor-error "Failed to run remote command ~A: ~A" args e)))))) + +(defun run-remote (method user host command &key (output :string) input (error-output :string)) + "Run a command on a remote host via SSH or sudo. +Returns the process-info from uiop:launch-program. +For sudo and SSH, automatically handles password prompting if needed." + (let* ((password (tramp-ensure-password method user host)) + (use-sudo-s (and (eq method :sudo) password)) + (args (build-ssh-args method user host command + :use-sudo-s use-sudo-s + :password (when (eq method :ssh) password)))) + (multiple-value-bind (process pwd-stream) + (%run-remote-with-password method user host args + :output output :input input :error-output error-output) + (declare (ignore pwd-stream)) + process))) + +(defun run-remote-string (method user host command) + "Run a command on a remote host and return its stdout as a string." + (let* ((password (tramp-ensure-password method user host)) + (use-sudo-s (and (eq method :sudo) password)) + (args (build-ssh-args method user host command + :use-sudo-s use-sudo-s + :password (when (eq method :ssh) password)))) + (handler-case + (if (and password (eq method :sudo)) + ;; sudo with password: use launch-program to avoid temp file issues + (let* ((process (uiop:launch-program args + :output :stream + :input :stream + :error-output :stream + :ignore-error-status t)) + (in (uiop:process-info-input process)) + (out (uiop:process-info-output process))) + (write-line password in) + (finish-output in) + (close in) + (let ((result + (with-output-to-string (s) + (loop for line = (read-line out nil nil) + while line + do (write-line line s))))) + (ignore-errors (close out)) + (uiop:wait-process process) + (string-trim '(#\newline #\return) result))) + (string-trim + '(#\newline #\return) + (uiop:run-program args + :output :string + :error-output :string + :ignore-error-status t))) + (editor-error (e) + (error e)) + (error (e) + (tramp-clear-password method user host) + (editor-error "Failed to run remote command ~A: ~A" command e))))) + +(defun run-remote-exit-code (method user host command) + "Run a command on a remote host and return its exit code (0 = success)." + (let* ((password (tramp-ensure-password method user host)) + (use-sudo-s (and (eq method :sudo) password)) + (args (build-ssh-args method user host command + :use-sudo-s use-sudo-s + :password (when (eq method :ssh) password)))) + (handler-case + (if (and password (eq method :sudo)) + ;; sudo with password: use launch-program with pipe for stdin + ;; (avoids uiop:run-program temp file issues) + (let* ((process (uiop:launch-program args + :output nil + :input :stream + :error-output nil + :ignore-error-status t)) + (in (uiop:process-info-input process))) + (write-line password in) + (finish-output in) + (close in) + (uiop:wait-process process)) + (nth-value 2 + (uiop:run-program args + :output nil + :error-output nil + :ignore-error-status t))) + (editor-error (e) + (error e)) + (error (c) + (tramp-clear-password method user host) + (message "TRAMP: sudo failed - ~A" c) + nil)))) + +;;; ------------------------------------------------------------------ +;;; Stream Creation +;;; ------------------------------------------------------------------ + +(defun %make-ssh-output-stream (method user host path) + "Create a stream for reading a remote file via SSH/sudo. +Reads the entire file content into memory via uiop:run-program, +avoiding pipe/process lifetime issues. +Returns (values stream closer-fn)." + (let* ((cmd (ecase method + (:ssh `("cat" ,path)) + (:sudo `("cat" ,path)))) + (use-sudo-s (eq method :sudo)) + (password (tramp-ensure-password method user host)) + (args (build-ssh-args method user host cmd + :use-sudo-s use-sudo-s + :password (when (eq method :ssh) password)))) + (handler-case + (let* ((output + (if (and password (eq method :sudo)) + (with-input-from-string (s (format nil "~A~%" password)) + (uiop:run-program args + :output :string + :input s + :error-output :string + :ignore-error-status t)) + (uiop:run-program args + :output :string + :error-output :string + :ignore-error-status t))) + (octets (babel:string-to-octets output :encoding :utf-8))) + (values (flexi-streams:make-in-memory-input-stream octets) + (lambda (s) + (declare (ignore s))))) + (editor-error (e) + (error e)) + (error (e) + (tramp-clear-password method user host) + (editor-error "Failed to read remote file ~A: ~A" path e))))) + +(defun %make-ssh-input-stream (method user host path) + "Create a stream for writing a remote file via SSH/sudo. +Returns (values stream closer-fn)." + (let* ((cmd (ecase method + (:ssh (list "/bin/sh" "-c" + (format nil "cat > ~A" (escape-shell-arg path)))) + (:sudo (list "/bin/sh" "-c" + (format nil "cat > ~A" (escape-shell-arg path)))))) + (use-sudo-s (eq method :sudo)) + (password (tramp-ensure-password method user host)) + (args (build-ssh-args method user host cmd + :use-sudo-s use-sudo-s + :password (when (eq method :ssh) password)))) + (handler-case + (let* ((process (uiop:launch-program args + :output nil + :input :stream + :error-output :stream + :ignore-error-status t)) + (stream (uiop:process-info-input process))) + ;; For sudo: send password via stdin first + (when (and password (eq method :sudo)) + (write-line password stream) + (finish-output stream)) + ;; For ssh: password already in args via sshpass, nothing extra needed + (values stream + (lambda (s) + ;; s is the flexi-stream (or raw stream for binary); + ;; flush it so all buffered data reaches the pipe + (finish-output s) + (ignore-errors (close s)) + ;; wait for ssh to finish writing to the remote file + (ignore-errors (uiop:wait-process process))))) + (editor-error (e) + (error e)) + (error (e) + (tramp-clear-password method user host) + (editor-error "Failed to write remote file ~A: ~A" path e))))) + +(defun escape-shell-arg (arg) + "Escape ARG for safe use in a shell command (single-quote escaping)." + (let ((escaped (ppcre:regex-replace-all "'" arg "'\\''"))) + (concatenate 'string "'" escaped "'"))) + +;;; ------------------------------------------------------------------ +;;; Virtual File Open Handler +;;; ------------------------------------------------------------------ + +(defun tramp-file-open-handler (filename &key direction element-type external-format) + "Handler for *virtual-file-open* that intercepts TRAMP paths." + (when (pathnamep filename) + (setf filename (namestring filename))) + (when (tramp-path-p filename) + (multiple-value-bind (method user host remote-path) (parse-tramp-path filename) + (ecase direction + (:input + (multiple-value-bind (raw-stream closer) + (%make-ssh-output-stream method user host remote-path) + (if (equal element-type '(unsigned-byte 8)) + ;; Binary stream — return as-is + (list raw-stream closer) + ;; Character stream — need to wrap + (list (flexi-streams:make-flexi-stream raw-stream + :external-format (or external-format :utf-8)) + closer)))) + (:output + (multiple-value-bind (raw-stream closer) + (%make-ssh-input-stream method user host remote-path) + (if (equal element-type '(unsigned-byte 8)) + (list raw-stream closer) + (list (flexi-streams:make-flexi-stream raw-stream + :external-format (or external-format :utf-8)) + closer)))))))) + +;;; ------------------------------------------------------------------ +;;; Filesystem Hooks +;;; ------------------------------------------------------------------ + +(defun tramp-probe-file-handler (pathspec &optional base-dir) + "Handler for *virtual-probe-file-functions*." + (declare (ignore base-dir)) + (when (tramp-path-p pathspec) + (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) + ;; Use exit code instead of shell && to avoid needing shell + (let ((code (run-remote-exit-code method user host + (list "test" "-f" remote-path)))) + (when (eql 0 code) + ;; Return as string — namestring on a string is identity + (namestring pathspec)))))) + +(defun tramp-directory-exists-handler (directory) + "Handler for *virtual-directory-exists-p-functions*." + (when (tramp-path-p directory) + (multiple-value-bind (method user host remote-path) (parse-tramp-path directory) + (let ((code (run-remote-exit-code method user host + (list "test" "-d" remote-path)))) + (when (eql 0 code) + directory))))) + +(defun tramp-directory-files-handler (pathspec) + "Handler for *virtual-directory-files-functions*. +If PATHSPEC is a file (not a directory), return a list of just that file. +If it's a directory, list its contents via ls." + (when (tramp-path-p pathspec) + (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) + ;; First check if this is a directory + (if (eql 0 (run-remote-exit-code method user host + (list "test" "-d" remote-path))) + ;; It's a directory — list its contents + (let ((output (run-remote-string method user host + (list "ls" "-1a" remote-path)))) + (when output + (let ((prefix (if (char= (char pathspec (1- (length pathspec))) #\/) + pathspec + (concatenate 'string pathspec "/")))) + (loop :for line :in (str:lines output) + :for name := (string-trim '(#\space #\tab) line) + :unless (or (string= name "") (string= name ".") (string= name "..")) + :collect (concatenate 'string prefix name))))) + ;; It's a file (or doesn't exist) — return as-is like local behavior + (list pathspec))))) + +(defun tramp-file-metadata-handler (pathname op) + "Handler for *virtual-file-metadata-functions*." + (when (tramp-path-p pathname) + (multiple-value-bind (method user host remote-path) (parse-tramp-path pathname) + (ecase op + (:size + (let ((result (run-remote-string method user host + (list "stat" "-c" "%s" remote-path)))) + (when result + (ignore-errors (parse-integer result))))) + (:mtime + (let ((result (run-remote-string method user host + (list "stat" "-c" "%Y" remote-path)))) + (when result + (ignore-errors (parse-integer result))))) + (:write-date + (let ((result (run-remote-string method user host + (list "stat" "-c" "%Y" remote-path)))) + (when result + (ignore-errors (parse-integer result))))))))) + +(defun tramp-expand-file-name-handler (filename directory) + "Handler for *virtual-expand-file-name-functions*. +For TRAMP paths, skip local path merging and return the path as-is." + (declare (ignore directory)) + (when (tramp-path-p filename) + filename)) + +;;; ------------------------------------------------------------------ +;;; External Format Detection Override +;;; ------------------------------------------------------------------ + +(defvar *tramp-original-external-format-function* nil + "Saved original value of *external-format-function* before TRAMP overrides it.") + +(defun tramp-external-format-function-wrapper (filename) + "Wrapper for *external-format-function* that handles TRAMP paths. +TRAMP files cannot be opened with CL's OPEN for encoding detection, +so we return a safe default (:utf-8 :lf) for remote files." + (if (tramp-path-p filename) + (values :utf-8 :lf) + (if *tramp-original-external-format-function* + (funcall *tramp-original-external-format-function* filename) + (values :utf-8 :lf)))) + +;;; ------------------------------------------------------------------ +;;; Registration +;;; ------------------------------------------------------------------ + +(defun tramp-enable () + "Enable TRAMP remote file support." + (pushnew 'tramp-file-open-handler *virtual-file-open*) + (pushnew 'tramp-probe-file-handler + lem/buffer/file-utils:*virtual-probe-file-functions*) + (pushnew 'tramp-directory-exists-handler + lem/buffer/file-utils:*virtual-directory-exists-p-functions*) + (pushnew 'tramp-directory-files-handler + lem/buffer/file-utils:*virtual-directory-files-functions*) + (pushnew 'tramp-file-metadata-handler + lem/buffer/file-utils:*virtual-file-metadata-functions*) + (pushnew 'tramp-expand-file-name-handler + lem/buffer/file-utils:*virtual-expand-file-name-functions*) + ;; Override encoding detection for TRAMP paths: inq:detect-encoding + ;; calls CL:OPEN directly (bypassing the virtual filesystem), so we + ;; must intercept *external-format-function* to return :utf-8 for + ;; remote files instead of trying to open them locally. + (unless *tramp-original-external-format-function* + (setf *tramp-original-external-format-function* + lem/buffer/file:*external-format-function*) + (setf lem/buffer/file:*external-format-function* + 'tramp-external-format-function-wrapper))) + +(defun tramp-disable () + "Disable TRAMP remote file support." + (setf *virtual-file-open* + (remove 'tramp-file-open-handler *virtual-file-open*)) + (setf lem/buffer/file-utils:*virtual-probe-file-functions* + (remove 'tramp-probe-file-handler lem/buffer/file-utils:*virtual-probe-file-functions*)) + (setf lem/buffer/file-utils:*virtual-directory-exists-p-functions* + (remove 'tramp-directory-exists-handler lem/buffer/file-utils:*virtual-directory-exists-p-functions*)) + (setf lem/buffer/file-utils:*virtual-directory-files-functions* + (remove 'tramp-directory-files-handler lem/buffer/file-utils:*virtual-directory-files-functions*)) + (setf lem/buffer/file-utils:*virtual-file-metadata-functions* + (remove 'tramp-file-metadata-handler lem/buffer/file-utils:*virtual-file-metadata-functions*)) + (setf lem/buffer/file-utils:*virtual-expand-file-name-functions* + (remove 'tramp-expand-file-name-handler lem/buffer/file-utils:*virtual-expand-file-name-functions*)) + ;; Restore original encoding detection function + (when *tramp-original-external-format-function* + (setf lem/buffer/file:*external-format-function* + *tramp-original-external-format-function*) + (setf *tramp-original-external-format-function* nil))) + +;; Auto-enable at load time +(tramp-enable) diff --git a/lem.asd b/lem.asd index 01dfe30b6..9aafab5ab 100644 --- a/lem.asd +++ b/lem.asd @@ -305,7 +305,8 @@ "lem-tree-sitter" "lem-git-gutter" "lem-skk-mode" - "lem-display-time-mode")) + "lem-display-time-mode" + "lem-tramp")) (defsystem "lem" :version "2.3.0" diff --git a/src/buffer/file-utils.lisp b/src/buffer/file-utils.lisp index baa8959a5..95376a5cc 100644 --- a/src/buffer/file-utils.lisp +++ b/src/buffer/file-utils.lisp @@ -7,7 +7,15 @@ :file-size :copy-file-or-directory :virtual-probe-file - :with-open-virtual-file)) + :with-open-virtual-file + ;; Virtual filesystem hooks + :*virtual-file-open* + :*virtual-probe-file-functions* + :*virtual-expand-file-name-functions* + :*virtual-directory-files-functions* + :*virtual-file-metadata-functions* + :*virtual-directory-exists-p-functions* + :virtual-directory-exists-p)) (in-package :lem/buffer/file-utils) (defun guess-host-name (filename) @@ -49,8 +57,11 @@ (defun expand-file-name (filename &optional (directory (uiop:getcwd))) (when (pathnamep filename) (setf filename (namestring filename))) - (let ((pathname (parse-filename filename (pathname-directory directory)))) - (namestring (merge-pathnames pathname directory)))) + (or (loop :for f :in *virtual-expand-file-name-functions* + :for result := (funcall f filename directory) + :when result :do (return result)) + (let ((pathname (parse-filename filename (pathname-directory directory)))) + (namestring (merge-pathnames pathname directory))))) (defun tail-of-pathname (pathname) (let ((pathname (uiop:ensure-absolute-pathname pathname #p"/"))) @@ -71,9 +82,12 @@ x2))))) (defun virtual-probe-file (pathspec &optional (base-dir pathspec)) - (cond - ((ppcre:scan "^~/.*" (namestring base-dir)) (probe-file% pathspec)) - (t (probe-file pathspec)))) + (or (loop :for f :in *virtual-probe-file-functions* + :for result := (funcall f pathspec base-dir) + :when result :do (return result)) + (cond + ((ppcre:scan "^~/.*" (namestring base-dir)) (probe-file% pathspec)) + (t (probe-file pathspec))))) (defun sort-files (pathnames &key (key #'namestring) (test #'string<)) "Sort a list of pathnames." @@ -91,11 +105,14 @@ (sort-files files)))) (defun directory-files (pathspec) - (if (uiop:directory-pathname-p pathspec) - (list (pathname pathspec)) - (or (mapcar (lambda (x) (virtual-probe-file x pathspec)) - (directory pathspec)) - (list pathspec)))) + (or (loop :for f :in *virtual-directory-files-functions* + :for result := (funcall f pathspec) + :when result :do (return result)) + (if (uiop:directory-pathname-p pathspec) + (list (pathname pathspec)) + (or (mapcar (lambda (x) (virtual-probe-file x pathspec)) + (directory pathspec)) + (list pathspec))))) (defun list-directory (directory &key directory-only (sort-method :pathname)) (delete nil @@ -108,21 +125,27 @@ :sort-method sort-method)))))) (defun file-size (pathname) - #+sbcl - (sb-posix:stat-size (sb-posix:stat pathname)) - #+lispworks - (system:file-size pathname) - #+(and (not lispworks) win32) - (return-from file-size nil) - #-win32 - (ignore-errors (with-open-file (in pathname) (file-length in)))) + (or (loop :for f :in *virtual-file-metadata-functions* + :for result := (funcall f pathname :size) + :when result :do (return result)) + #+sbcl + (sb-posix:stat-size (sb-posix:stat pathname)) + #+lispworks + (system:file-size pathname) + #+(and (not lispworks) win32) + (return-from file-size nil) + #-win32 + (ignore-errors (with-open-file (in pathname) (file-length in))))) (defun file-mtime (pathname) "Return the file's last data modification time." - #+sbcl - (sb-posix:stat-mtime (sb-posix:stat pathname)) - #-sbcl - (error "file-utils: file-mtime is not implemented for your implementation.")) + (or (loop :for f :in *virtual-file-metadata-functions* + :for result := (funcall f pathname :mtime) + :when result :do (return result)) + #+sbcl + (sb-posix:stat-mtime (sb-posix:stat pathname)) + #-sbcl + (error "file-utils: file-mtime is not implemented for your implementation."))) (defun copy-file-or-directory (from to) (let ((base-dir from)) @@ -142,6 +165,38 @@ (defparameter *virtual-file-open* nil) +(defparameter *virtual-probe-file-functions* nil + "A list of functions for virtual probe-file. +Each function receives (pathspec &optional base-dir) and should return +a pathname if the file exists, or nil to pass to the next handler.") + +(defparameter *virtual-expand-file-name-functions* nil + "A list of functions for virtual expand-file-name. +Each function receives (filename &optional directory) and should return +an expanded filename string, or nil to pass to the next handler.") + +(defparameter *virtual-directory-files-functions* nil + "A list of functions for virtual directory-files. +Each function receives (pathspec) and should return a list of pathnames, +or nil to pass to the next handler.") + +(defparameter *virtual-file-metadata-functions* nil + "A list of functions for virtual file metadata (size, mtime). +Each function receives (pathname op) where op is :size, :mtime, or :write-date, +and should return the value, or nil to pass to the next handler.") + +(defparameter *virtual-directory-exists-p-functions* nil + "A list of functions for virtual directory-exists-p. +Each function receives (directory) and should return the directory if it exists, +or nil to pass to the next handler.") + +(defun virtual-directory-exists-p (directory) + "Check if a directory exists, using virtual filesystem hooks if applicable." + (or (loop :for f :in *virtual-directory-exists-p-functions* + :for result := (funcall f directory) + :when result :do (return result)) + (uiop:directory-exists-p directory))) + (defun open-virtual-file (filename &key external-format direction element-type) (apply #'values (or (loop :for f :in *virtual-file-open* diff --git a/src/buffer/file.lisp b/src/buffer/file.lisp index 1dfd269d7..d7545f60c 100644 --- a/src/buffer/file.lisp +++ b/src/buffer/file.lisp @@ -72,9 +72,9 @@ (when (pathnamep filename) (setf filename (namestring filename))) (setf filename (expand-file-name filename)) - (unless (uiop:directory-exists-p (directory-namestring filename)) + (unless (virtual-directory-exists-p (directory-namestring filename)) (error 'directory-does-not-exist :directory (directory-namestring filename))) - (alexandria:when-let (it (probe-file filename)) (setf filename (namestring it))) + (alexandria:when-let (it (virtual-probe-file filename)) (setf filename (namestring it))) (cond ((uiop:directory-pathname-p filename) (if *find-directory-function* (funcall *find-directory-function* filename) @@ -91,7 +91,7 @@ :enable-undo-p nil :temporary temporary))) (setf (buffer-filename buffer) filename) - (when (probe-file filename) + (when (virtual-probe-file filename) (let ((*inhibit-modification-hooks* t)) (let ((encoding (handler-bind ((encoding-read-error @@ -186,8 +186,11 @@ (%%write-region-to-file encoding out)))))) (defun file-write-date* (buffer) - (if (probe-file (buffer-filename buffer)) - (file-write-date (buffer-filename buffer)))) + (if (virtual-probe-file (buffer-filename buffer)) + (or (loop :for f :in *virtual-file-metadata-functions* + :for result := (funcall f (buffer-filename buffer) :write-date) + :when result :do (return result)) + (file-write-date (buffer-filename buffer))))) (defun update-changed-disk-date (buffer) (setf (buffer-last-write-date buffer) @@ -195,6 +198,6 @@ (defun changed-disk-p (buffer) (and (buffer-filename buffer) - (probe-file (buffer-filename buffer)) + (virtual-probe-file (buffer-filename buffer)) (not (eql (buffer-last-write-date buffer) (file-write-date* buffer))))) diff --git a/src/buffer/internal/buffer.lisp b/src/buffer/internal/buffer.lisp index 61390b094..7d6ebce3b 100644 --- a/src/buffer/internal/buffer.lisp +++ b/src/buffer/internal/buffer.lisp @@ -224,7 +224,7 @@ Options that can be specified by arguments are ignored if `temporary` is NIL and (namestring (uiop:getcwd)))) (defun (setf buffer-directory) (directory &optional (buffer (current-buffer))) - (let ((result (uiop:directory-exists-p directory))) + (let ((result (virtual-directory-exists-p directory))) (unless result (error 'directory-does-not-exist :directory directory)) (setf (buffer-%directory buffer) diff --git a/src/commands/file.lisp b/src/commands/file.lisp index 874ad57c8..101922350 100644 --- a/src/commands/file.lisp +++ b/src/commands/file.lisp @@ -66,7 +66,7 @@ (defun directory-for-file-or-lose (filename) (let ((directory (directory-namestring filename))) - (unless (or (uiop:directory-exists-p directory) + (unless (or (virtual-directory-exists-p directory) (maybe-create-directory directory)) (error 'editor-abort)) directory)) From 431fb64bac23e47c063dc93ab685e0f0d6cd4069 Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 11:30:37 +0800 Subject: [PATCH 02/23] tramp: performance improved --- extensions/tramp/tramp.lisp | 560 ++++++++++++++++++------------------ 1 file changed, 287 insertions(+), 273 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 89c51a7e7..4157c5197 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -84,8 +84,41 @@ Returns the password string, or nil if cancelled/empty." (tramp-clear-password method user host) nil))))) -(defvar *ssh-key-auth-cache* (make-hash-table :test 'equal) - "Cache of SSH key auth results. Maps connection key to T (key works) or NIL (needs password).") +;;; ------------------------------------------------------------------ +;;; FS Cache (5-second TTL — eliminates duplicate SSH calls) +;;; ------------------------------------------------------------------ + +(defvar *tramp-fs-cache* (make-hash-table :test 'equal) + "Cache for filesystem operations. Keys are (method user host path op), +values are cons of (timestamp . result).") + +(defvar *tramp-fs-cache-ttl* 5 + "Time-to-live in seconds for filesystem cache entries.") + +(defun tramp-fs-cache-key (method user host path op) + "Make a cache key for a filesystem operation." + (format nil "~A:~A@~A:~A:~A" method (or user "") host path op)) + +(defun tramp-fs-cache-get (method user host path op) + "Get a cached value, or :not-found." + (let* ((key (tramp-fs-cache-key method user host path op)) + (entry (gethash key *tramp-fs-cache*))) + (if (and entry (< (- (get-universal-time) (car entry)) *tramp-fs-cache-ttl*)) + (cdr entry) + (progn (remhash key *tramp-fs-cache*) :not-found)))) + +(defun tramp-fs-cache-set (method user host path op value) + "Cache a value with current timestamp." + (setf (gethash (tramp-fs-cache-key method user host path op) *tramp-fs-cache*) + (cons (get-universal-time) value))) + +;;; ------------------------------------------------------------------ +;;; SSH Auth (lazy — no separate pre-check call) +;;; ------------------------------------------------------------------ + +(defvar *ssh-auth-method-cache* (make-hash-table :test 'equal) + "Cache of SSH auth methods. Values: :key (key auth works), +:password (needs password), or nil (unknown).") (defun sshpass-available-p () "Check if the sshpass utility is available on the system." @@ -94,66 +127,72 @@ Returns the password string, or nil if cancelled/empty." :output nil :error-output nil :ignore-error-status t))) - ;; Fallback: check if sshpass exists at common locations (probe-file "/usr/bin/sshpass") (probe-file "/usr/local/bin/sshpass"))) -(defun ssh-check-key-auth (user host) - "Check if key-based SSH authentication works for USER@HOST. -Returns T if key auth works, NIL otherwise. Caches the result." - (let* ((conn-key (format nil "~A@~A" (or user "") host)) - (cached (gethash conn-key *ssh-key-auth-cache* :not-found))) - (when (eq cached :not-found) - (let ((target (if user (format nil "~A@~A" user host) host))) - (setf cached - (eql 0 (handler-case - (nth-value 2 - (uiop:run-program - `("ssh" "-T" - "-o" "BatchMode=yes" - "-o" "ConnectTimeout=3" - "-o" "StrictHostKeyChecking=accept-new" - ,@(ssh-control-options) - ,target "true") - :output nil - :error-output nil - :ignore-error-status t)) - (error () 1)))) - (setf (gethash conn-key *ssh-key-auth-cache*) cached))) - cached)) +(defun ssh-ensure-auth (method user host) + "Get cached auth state for SSH connection. +Returns (values password auth-tried-p): + - cached password → (values password t) + - key auth known to work → (values nil t) + - unknown → (values nil nil) — caller should try BatchMode first" + (declare (ignore method)) + (let ((conn-key (format nil "~A@~A" (or user "") host))) + (or (let ((pwd (tramp-get-password :ssh user host))) + (when pwd (return-from ssh-ensure-auth (values pwd t)))) + (let ((auth-method (gethash conn-key *ssh-auth-method-cache*))) + (ecase auth-method + ((nil) (values nil nil)) ;; unknown — try key first + (:key (values nil t)) ;; key works, no password needed + (:password ;; need password + (if (sshpass-available-p) + (let ((pwd (tramp-prompt-password :ssh user host))) + (values pwd t)) + (editor-error + "SSH key auth failed for ~A@~A. Install sshpass for password auth." + (or user "") host)))))))) + +(defun ssh-remember-auth-failure (user host) + "Called when a BatchMode SSH command fails (exit 255). +Marks connection as needing password and prompts." + (let ((conn-key (format nil "~A@~A" (or user "") host))) + (setf (gethash conn-key *ssh-auth-method-cache*) :password) + (tramp-clear-password :ssh user host) + (if (sshpass-available-p) + (tramp-prompt-password :ssh user host) + (editor-error + "SSH key auth failed for ~A@~A. Install sshpass for password auth." + (or user "") host)))) + +(defun ssh-remember-auth-success (user host) + "Called when a BatchMode SSH command succeeds. Marks key auth as working." + (let ((conn-key (format nil "~A@~A" (or user "") host))) + (setf (gethash conn-key *ssh-auth-method-cache*) :key))) (defun tramp-ensure-password (method user host) - "Get cached password or prompt the user. Returns nil if no password needed/available." + "Get cached password or prompt the user. For :ssh returns nil +(lazy auth — the actual command will trigger auth handling)." (or (tramp-get-password method user host) (ecase method (:sudo (or (tramp-prompt-password method user host) (error 'editor-abort))) (:ssh - (unless (ssh-check-key-auth user host) - (if (sshpass-available-p) - (tramp-prompt-password method user host) - (editor-error - "SSH key authentication failed for ~A@~A.~%~ - Install sshpass for password authentication, or set up SSH keys." - (or user "") host))))))) + ;; Lazy auth: authenticated on first actual command, not here + nil)))) ;;; ------------------------------------------------------------------ ;;; Remote Command Execution ;;; ------------------------------------------------------------------ (defun ssh-control-options () - "Return SSH ControlMaster options for connection multiplexing. -All SSH connections to the same host reuse a single TCP connection, -avoiding repeated authentication delays." + "Return SSH ControlMaster options for connection multiplexing." (list "-o" "ControlMaster=auto" "-o" "ControlPath=/tmp/lem-ssh-%C" "-o" "ControlPersist=60")) (defun build-ssh-args (method user host command &key (use-sudo-s nil) password) - "Build the argument list for running a command via SSH or sudo. -When USE-SUDO-S is T, sudo reads the password from stdin (-S flag). -When PASSWORD is provided for :ssh, uses sshpass to deliver the password." + "Build the argument list for running a command via SSH or sudo." (ecase method (:ssh (let ((target (if user (format nil "~A@~A" user host) host)) @@ -175,203 +214,165 @@ When PASSWORD is provided for :ssh, uses sshpass to deliver the password." (:sudo (let ((args (list "sudo"))) (when use-sudo-s - (push "-S" (cdr args))) ; -S: read password from stdin + (push "-S" (cdr args))) (when user (setf args (append args (list "-u" user)))) (append args (if (listp command) command (list command))))))) -(defun %run-remote-with-password (method user host args - &key (output :string) input (error-output :string)) - "Run a command with optional password authentication. -For :sudo, sends password via stdin with sudo -S. -For :ssh, password is passed via sshpass in the args list. -Returns (values process-info password-input-stream-or-nil)." - (let ((password (tramp-ensure-password method user host))) - (if password - (ecase method - (:sudo - ;; sudo: password via stdin with -S - (handler-case - (let ((process - (uiop:launch-program args - :output output - :input :stream - :error-output error-output - :ignore-error-status t))) - (let ((pwd-stream (uiop:process-info-input process))) - (write-line password pwd-stream) - (finish-output pwd-stream) - (values process pwd-stream))) - (editor-error (e) - (error e)) - (error (e) - (tramp-clear-password method user host) - (editor-error "Failed to run remote command ~A: ~A" args e)))) - (:ssh - ;; ssh: password already in args via sshpass prefix (build-ssh-args) - (handler-case - (values (uiop:launch-program args - :output output - :input input - :error-output error-output - :ignore-error-status t) - nil) - (editor-error (e) - (error e)) - (error (e) - (tramp-clear-password method user host) - (editor-error "Failed to run remote command ~A: ~A" args e))))) - ;; No password needed - (handler-case - (values (uiop:launch-program args - :output output - :input input - :error-output error-output - :ignore-error-status t) - nil) - (editor-error (e) - (error e)) - (error (e) - (editor-error "Failed to run remote command ~A: ~A" args e)))))) - -(defun run-remote (method user host command &key (output :string) input (error-output :string)) - "Run a command on a remote host via SSH or sudo. -Returns the process-info from uiop:launch-program. -For sudo and SSH, automatically handles password prompting if needed." - (let* ((password (tramp-ensure-password method user host)) - (use-sudo-s (and (eq method :sudo) password)) - (args (build-ssh-args method user host command - :use-sudo-s use-sudo-s - :password (when (eq method :ssh) password)))) - (multiple-value-bind (process pwd-stream) - (%run-remote-with-password method user host args - :output output :input input :error-output error-output) - (declare (ignore pwd-stream)) - process))) - -(defun run-remote-string (method user host command) - "Run a command on a remote host and return its stdout as a string." - (let* ((password (tramp-ensure-password method user host)) - (use-sudo-s (and (eq method :sudo) password)) - (args (build-ssh-args method user host command - :use-sudo-s use-sudo-s - :password (when (eq method :ssh) password)))) - (handler-case - (if (and password (eq method :sudo)) - ;; sudo with password: use launch-program to avoid temp file issues - (let* ((process (uiop:launch-program args - :output :stream - :input :stream - :error-output :stream - :ignore-error-status t)) - (in (uiop:process-info-input process)) - (out (uiop:process-info-output process))) - (write-line password in) - (finish-output in) - (close in) - (let ((result - (with-output-to-string (s) - (loop for line = (read-line out nil nil) - while line - do (write-line line s))))) - (ignore-errors (close out)) - (uiop:wait-process process) - (string-trim '(#\newline #\return) result))) - (string-trim - '(#\newline #\return) - (uiop:run-program args - :output :string - :error-output :string - :ignore-error-status t))) - (editor-error (e) - (error e)) - (error (e) - (tramp-clear-password method user host) - (editor-error "Failed to run remote command ~A: ~A" command e))))) +;;; Core SSH execution with lazy auth + +(defun %ssh-run (user host args) + "Run an SSH command, returning (values exit-code stdout-string)." + (handler-case + (multiple-value-bind (stdout stderr exit-code) + (uiop:run-program args + :output :string + :error-output :string + :ignore-error-status t) + (declare (ignore stderr)) + (values exit-code stdout)) + (error (c) + (values 255 (princ-to-string c))))) + +(defun %ssh-run-with-auth-retry (user host command) + "Run an SSH command with automatic auth handling. +Tries key auth first; on exit-255 failure, prompts for password and retries. +Returns (values exit-code stdout-string)." + (multiple-value-bind (password auth-tried) (ssh-ensure-auth :ssh user host) + (if auth-tried + ;; Auth method known — run directly + (let ((args (build-ssh-args :ssh user host command :password password))) + (%ssh-run user host args)) + ;; Auth method unknown — try key auth first + (let ((args (build-ssh-args :ssh user host command :password nil))) + (multiple-value-bind (exit-code stdout) (%ssh-run user host args) + (if (= exit-code 255) + ;; Auth failure → prompt password and retry + (let ((pwd (ssh-remember-auth-failure user host))) + (if pwd + (let ((args2 (build-ssh-args :ssh user host command :password pwd))) + (%ssh-run user host args2)) + (values exit-code stdout))) + ;; Key auth succeeded or command failed for other reasons + (progn + (ssh-remember-auth-success user host) + (values exit-code stdout)))))))) + +;;; Sudo command execution (pipe-based, no temp files) + +(defun %sudo-run (user host args password) + "Run a sudo command via pipe. Returns (values exit-code stdout-string)." + (handler-case + (let* ((process (uiop:launch-program args + :output :stream + :input :stream + :error-output :stream + :ignore-error-status t)) + (in (uiop:process-info-input process)) + (out (uiop:process-info-output process))) + (when password + (write-line password in) + (finish-output in)) + (close in) + (let ((stdout + (with-output-to-string (s) + (loop for line = (read-line out nil nil) + while line + do (write-line line s))))) + (ignore-errors (close out)) + (let ((exit-code (uiop:wait-process process))) + (values exit-code stdout)))) + (error (c) + (values 1 (princ-to-string c))))) + +(defun %sudo-run-exit-code (user host args password) + "Run a sudo command, returning just the exit code." + (handler-case + (let* ((process (uiop:launch-program args + :output nil + :input :stream + :error-output nil + :ignore-error-status t)) + (in (uiop:process-info-input process))) + (when password + (write-line password in) + (finish-output in)) + (close in) + (uiop:wait-process process)) + (error () 1))) + +;;; Public API (defun run-remote-exit-code (method user host command) - "Run a command on a remote host and return its exit code (0 = success)." - (let* ((password (tramp-ensure-password method user host)) - (use-sudo-s (and (eq method :sudo) password)) - (args (build-ssh-args method user host command - :use-sudo-s use-sudo-s - :password (when (eq method :ssh) password)))) - (handler-case - (if (and password (eq method :sudo)) - ;; sudo with password: use launch-program with pipe for stdin - ;; (avoids uiop:run-program temp file issues) - (let* ((process (uiop:launch-program args - :output nil - :input :stream - :error-output nil - :ignore-error-status t)) - (in (uiop:process-info-input process))) - (write-line password in) - (finish-output in) - (close in) - (uiop:wait-process process)) - (nth-value 2 - (uiop:run-program args - :output nil - :error-output nil - :ignore-error-status t))) - (editor-error (e) - (error e)) - (error (c) - (tramp-clear-password method user host) - (message "TRAMP: sudo failed - ~A" c) - nil)))) + "Run a command on a remote host. Returns its exit code (0 = success)." + (if (eq method :ssh) + (%ssh-run-with-auth-retry user host command) + (let* ((password (tramp-ensure-password method user host)) + (use-sudo-s (and (eq method :sudo) password)) + (args (build-ssh-args method user host command :use-sudo-s use-sudo-s))) + (%sudo-run-exit-code user host args password)))) + +(defun run-remote-string (method user host command) + "Run a command on a remote host. Returns its stdout as a trimmed string." + (if (eq method :ssh) + (multiple-value-bind (exit-code stdout) + (%ssh-run-with-auth-retry user host command) + (declare (ignore exit-code)) + (string-trim '(#\newline #\return) stdout)) + (let* ((password (tramp-ensure-password method user host)) + (use-sudo-s (and (eq method :sudo) password)) + (args (build-ssh-args method user host command :use-sudo-s use-sudo-s))) + (multiple-value-bind (exit-code stdout) + (%sudo-run user host args password) + (declare (ignore exit-code)) + (string-trim '(#\newline #\return) stdout))))) ;;; ------------------------------------------------------------------ ;;; Stream Creation ;;; ------------------------------------------------------------------ +(defun %read-remote-file (method user host path) + "Read a remote file via cat. Returns the content as a string." + (handler-case + (let ((cmd `("cat" ,path))) + (if (eq method :ssh) + (multiple-value-bind (exit-code stdout) + (%ssh-run-with-auth-retry user host cmd) + (unless (eql 0 exit-code) + (editor-error "Failed to read remote file ~A (exit ~D)" path exit-code)) + stdout) + (let* ((password (tramp-ensure-password method user host)) + (use-sudo-s (and (eq method :sudo) password)) + (args (build-ssh-args method user host cmd :use-sudo-s use-sudo-s))) + (multiple-value-bind (exit-code stdout) + (%sudo-run user host args password) + (unless (eql 0 exit-code) + (editor-error "Failed to read remote file ~A (exit ~D)" path exit-code)) + stdout)))) + (editor-error (e) + (error e)) + (error (e) + (tramp-clear-password method user host) + (editor-error "Failed to read remote file ~A: ~A" path e)))) + (defun %make-ssh-output-stream (method user host path) - "Create a stream for reading a remote file via SSH/sudo. -Reads the entire file content into memory via uiop:run-program, -avoiding pipe/process lifetime issues. -Returns (values stream closer-fn)." - (let* ((cmd (ecase method - (:ssh `("cat" ,path)) - (:sudo `("cat" ,path)))) - (use-sudo-s (eq method :sudo)) - (password (tramp-ensure-password method user host)) - (args (build-ssh-args method user host cmd - :use-sudo-s use-sudo-s - :password (when (eq method :ssh) password)))) - (handler-case - (let* ((output - (if (and password (eq method :sudo)) - (with-input-from-string (s (format nil "~A~%" password)) - (uiop:run-program args - :output :string - :input s - :error-output :string - :ignore-error-status t)) - (uiop:run-program args - :output :string - :error-output :string - :ignore-error-status t))) - (octets (babel:string-to-octets output :encoding :utf-8))) - (values (flexi-streams:make-in-memory-input-stream octets) - (lambda (s) - (declare (ignore s))))) - (editor-error (e) - (error e)) - (error (e) - (tramp-clear-password method user host) - (editor-error "Failed to read remote file ~A: ~A" path e))))) + "Create an in-memory stream for reading a remote file." + (let ((output (%read-remote-file method user host path))) + (let ((octets (babel:string-to-octets output :encoding :utf-8))) + (values (flexi-streams:make-in-memory-input-stream octets) + (lambda (s) + (declare (ignore s))))))) (defun %make-ssh-input-stream (method user host path) - "Create a stream for writing a remote file via SSH/sudo. -Returns (values stream closer-fn)." + "Create a stream for writing a remote file via SSH/sudo." (let* ((cmd (ecase method (:ssh (list "/bin/sh" "-c" (format nil "cat > ~A" (escape-shell-arg path)))) (:sudo (list "/bin/sh" "-c" (format nil "cat > ~A" (escape-shell-arg path)))))) (use-sudo-s (eq method :sudo)) - (password (tramp-ensure-password method user host)) + (password (or (tramp-get-password method user host) + (tramp-ensure-password method user host))) (args (build-ssh-args method user host cmd :use-sudo-s use-sudo-s :password (when (eq method :ssh) password)))) @@ -382,18 +383,13 @@ Returns (values stream closer-fn)." :error-output :stream :ignore-error-status t)) (stream (uiop:process-info-input process))) - ;; For sudo: send password via stdin first (when (and password (eq method :sudo)) (write-line password stream) (finish-output stream)) - ;; For ssh: password already in args via sshpass, nothing extra needed (values stream (lambda (s) - ;; s is the flexi-stream (or raw stream for binary); - ;; flush it so all buffered data reaches the pipe (finish-output s) (ignore-errors (close s)) - ;; wait for ssh to finish writing to the remote file (ignore-errors (uiop:wait-process process))))) (editor-error (e) (error e)) @@ -421,11 +417,9 @@ Returns (values stream closer-fn)." (multiple-value-bind (raw-stream closer) (%make-ssh-output-stream method user host remote-path) (if (equal element-type '(unsigned-byte 8)) - ;; Binary stream — return as-is (list raw-stream closer) - ;; Character stream — need to wrap (list (flexi-streams:make-flexi-stream raw-stream - :external-format (or external-format :utf-8)) + :external-format (or external-format :utf-8)) closer)))) (:output (multiple-value-bind (raw-stream closer) @@ -433,77 +427,102 @@ Returns (values stream closer-fn)." (if (equal element-type '(unsigned-byte 8)) (list raw-stream closer) (list (flexi-streams:make-flexi-stream raw-stream - :external-format (or external-format :utf-8)) + :external-format (or external-format :utf-8)) closer)))))))) ;;; ------------------------------------------------------------------ -;;; Filesystem Hooks +;;; Filesystem Hooks (with 5-second FS cache) ;;; ------------------------------------------------------------------ (defun tramp-probe-file-handler (pathspec &optional base-dir) - "Handler for *virtual-probe-file-functions*." + "Handler for *virtual-probe-file-functions*. Uses cache to avoid duplicate SSH calls." (declare (ignore base-dir)) (when (tramp-path-p pathspec) (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) - ;; Use exit code instead of shell && to avoid needing shell + (let ((cached (tramp-fs-cache-get method user host remote-path :probe-file))) + (unless (eq cached :not-found) + (return-from tramp-probe-file-handler cached))) (let ((code (run-remote-exit-code method user host (list "test" "-f" remote-path)))) - (when (eql 0 code) - ;; Return as string — namestring on a string is identity - (namestring pathspec)))))) + (let ((result (when (eql 0 code) (namestring pathspec)))) + (tramp-fs-cache-set method user host remote-path :probe-file result) + result))))) (defun tramp-directory-exists-handler (directory) - "Handler for *virtual-directory-exists-p-functions*." + "Handler for *virtual-directory-exists-p-functions*. Uses cache." (when (tramp-path-p directory) (multiple-value-bind (method user host remote-path) (parse-tramp-path directory) + (let ((cached (tramp-fs-cache-get method user host remote-path :dir-exists))) + (unless (eq cached :not-found) + (return-from tramp-directory-exists-handler + (when cached directory)))) (let ((code (run-remote-exit-code method user host (list "test" "-d" remote-path)))) + (tramp-fs-cache-set method user host remote-path :dir-exists (eql 0 code)) (when (eql 0 code) directory))))) (defun tramp-directory-files-handler (pathspec) "Handler for *virtual-directory-files-functions*. -If PATHSPEC is a file (not a directory), return a list of just that file. -If it's a directory, list its contents via ls." +Caches directory check and listings for 5 seconds." (when (tramp-path-p pathspec) (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) - ;; First check if this is a directory - (if (eql 0 (run-remote-exit-code method user host - (list "test" "-d" remote-path))) - ;; It's a directory — list its contents - (let ((output (run-remote-string method user host - (list "ls" "-1a" remote-path)))) - (when output - (let ((prefix (if (char= (char pathspec (1- (length pathspec))) #\/) - pathspec - (concatenate 'string pathspec "/")))) - (loop :for line :in (str:lines output) - :for name := (string-trim '(#\space #\tab) line) - :unless (or (string= name "") (string= name ".") (string= name "..")) - :collect (concatenate 'string prefix name))))) - ;; It's a file (or doesn't exist) — return as-is like local behavior - (list pathspec))))) + ;; Use cached directory check + (let ((cached (tramp-fs-cache-get method user host remote-path :dir-exists))) + (if (eq cached :not-found) + ;; Check and cache + (let ((is-dir (eql 0 (run-remote-exit-code method user host + (list "test" "-d" remote-path))))) + (tramp-fs-cache-set method user host remote-path :dir-exists is-dir) + (if is-dir + (tramp-list-directory-1 method user host pathspec remote-path) + (list pathspec))) + (if cached + (tramp-list-directory-1 method user host pathspec remote-path) + (list pathspec))))))) + +(defun tramp-list-directory-1 (method user host pathspec remote-path) + "List contents of a remote directory. Uses cache." + (let ((cached (tramp-fs-cache-get method user host remote-path :dir-files))) + (unless (eq cached :not-found) + (return-from tramp-list-directory-1 cached))) + (let ((output (run-remote-string method user host + (list "ls" "-1a" remote-path)))) + (when output + (let ((prefix (if (char= (char pathspec (1- (length pathspec))) #\/) + pathspec + (concatenate 'string pathspec "/"))) + (result '())) + (dolist (line (str:lines output)) + (let ((name (string-trim '(#\space #\tab) line))) + (unless (or (string= name "") (string= name ".") (string= name "..")) + (push (concatenate 'string prefix name) result)))) + (setf result (nreverse result)) + (tramp-fs-cache-set method user host remote-path :dir-files result) + result)))) (defun tramp-file-metadata-handler (pathname op) - "Handler for *virtual-file-metadata-functions*." + "Handler for *virtual-file-metadata-functions*. +Uses cache; fetches all metadata in a single stat call." (when (tramp-path-p pathname) (multiple-value-bind (method user host remote-path) (parse-tramp-path pathname) - (ecase op - (:size - (let ((result (run-remote-string method user host - (list "stat" "-c" "%s" remote-path)))) - (when result - (ignore-errors (parse-integer result))))) - (:mtime - (let ((result (run-remote-string method user host - (list "stat" "-c" "%Y" remote-path)))) - (when result - (ignore-errors (parse-integer result))))) - (:write-date - (let ((result (run-remote-string method user host - (list "stat" "-c" "%Y" remote-path)))) - (when result - (ignore-errors (parse-integer result))))))))) + ;; Check cache for any metadata op + (let ((cached (tramp-fs-cache-get method user host remote-path :metadata))) + (when (eq cached :not-found) + ;; Fetch all metadata in one call: "stat -c '%s %Y'" + (let ((output (run-remote-string method user host + (list "stat" "-c" "%s %Y" remote-path)))) + (setf cached + (when output + (let ((parts (str:split " " output :limit 2))) + (when (= 2 (length parts)) + (cons (ignore-errors (parse-integer (first parts))) + (ignore-errors (parse-integer (second parts)))))))) + (tramp-fs-cache-set method user host remote-path :metadata cached))) + (ecase op + (:size (or (car cached) 0)) + (:mtime (or (cdr cached) 0)) + (:write-date (or (cdr cached) 0))))))) (defun tramp-expand-file-name-handler (filename directory) "Handler for *virtual-expand-file-name-functions*. @@ -546,10 +565,6 @@ so we return a safe default (:utf-8 :lf) for remote files." lem/buffer/file-utils:*virtual-file-metadata-functions*) (pushnew 'tramp-expand-file-name-handler lem/buffer/file-utils:*virtual-expand-file-name-functions*) - ;; Override encoding detection for TRAMP paths: inq:detect-encoding - ;; calls CL:OPEN directly (bypassing the virtual filesystem), so we - ;; must intercept *external-format-function* to return :utf-8 for - ;; remote files instead of trying to open them locally. (unless *tramp-original-external-format-function* (setf *tramp-original-external-format-function* lem/buffer/file:*external-format-function*) @@ -570,7 +585,6 @@ so we return a safe default (:utf-8 :lf) for remote files." (remove 'tramp-file-metadata-handler lem/buffer/file-utils:*virtual-file-metadata-functions*)) (setf lem/buffer/file-utils:*virtual-expand-file-name-functions* (remove 'tramp-expand-file-name-handler lem/buffer/file-utils:*virtual-expand-file-name-functions*)) - ;; Restore original encoding detection function (when *tramp-original-external-format-function* (setf lem/buffer/file:*external-format-function* *tramp-original-external-format-function*) From 514e66770703a44837f136efdc39084dfd5beaa6 Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 11:47:52 +0800 Subject: [PATCH 03/23] tramp: fix sudo password keystroke leakage into file buffer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Replaced the unconditional password prompt in the sudo auth path with a `sudo -n true` pre-check. On a fresh connection this runs in ~0.02s, providing a natural UI settling delay — the same reason SSH never had this problem (its BatchMode connection test takes ~3s). When `sudo -n true` succeeds (recent sudo timestamp still valid), no password prompt is needed at all, matching terminal sudo behaviour. --- extensions/tramp/tramp.lisp | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 4157c5197..862ff1cec 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -175,8 +175,14 @@ Marks connection as needing password and prompts." (or (tramp-get-password method user host) (ecase method (:sudo - (or (tramp-prompt-password method user host) - (error 'editor-abort))) + (if (eql 0 (nth-value 2 + (uiop:run-program '("sudo" "-n" "true") + :output nil + :error-output nil + :ignore-error-status t))) + nil ;; passwordless sudo + (or (tramp-prompt-password method user host) + (error 'editor-abort)))) (:ssh ;; Lazy auth: authenticated on first actual command, not here nil)))) From 81c93297a03bc6fae517c112128068d6a0fae001 Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 13:03:19 +0800 Subject: [PATCH 04/23] tramp: fix sudo password leaking into file buffer MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two-pronged fix for keystrokes from the sudo password prompt appearing at the top of the opened buffer: 1. Move the password prompt into the expand-file-name handler, which runs first in the file-open pipeline — before any directory probes and before the target buffer is created. This gives the UI a clean slate with no buffer to leak into. 2. Add a defensive strip in %read-remote-file: if the stdout from the remote cat starts with the cached password (a lem-webview prompt overlay cleanup race), remove it before the content reaches the buffer. --- extensions/tramp/tramp.lisp | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 862ff1cec..f595fa8b7 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -354,6 +354,12 @@ Returns (values exit-code stdout-string)." (%sudo-run user host args password) (unless (eql 0 exit-code) (editor-error "Failed to read remote file ~A (exit ~D)" path exit-code)) + ;; Guard: strip password if it leaked into stdout due to + ;; a lem-webview prompt overlay cleanup race. + (when (and password (plusp (length password))) + (when (str:starts-with-p password stdout) + (setf stdout (subseq stdout (length password))) + (setf stdout (string-left-trim '(#\newline #\return) stdout)))) stdout)))) (editor-error (e) (error e)) @@ -532,10 +538,18 @@ Uses cache; fetches all metadata in a single stat call." (defun tramp-expand-file-name-handler (filename directory) "Handler for *virtual-expand-file-name-functions*. -For TRAMP paths, skip local path merging and return the path as-is." +For TRAMP paths, skip local path merging and return the path as-is. +For :sudo, pre-fetches the password here (before any buffer is created) +to prevent keystrokes from leaking into the file buffer." (declare (ignore directory)) (when (tramp-path-p filename) - filename)) + (multiple-value-bind (method user host remote-path) (parse-tramp-path filename) + (declare (ignore remote-path)) + (when (eq method :sudo) + ;; Prompt early, while the UI is clean — no buffer exists yet, + ;; and the find-file minibuffer just closed. + (tramp-ensure-password method user host)) + filename))) ;;; ------------------------------------------------------------------ ;;; External Format Detection Override From 6c1960171968b0cec19a6414a477301e189eaba4 Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 13:38:57 +0800 Subject: [PATCH 05/23] tramp: fix tab completion for ssh and sudo paths MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two problems broke completion: 1. parse-tramp-path regex "(.+)$" required at least one character after the second colon, so "/ssh:host:" (typed before pressing Tab) failed to parse. Changed to "(.*)$" with nil/empty defaulting to "/". 2. completion-file calls list-directory, which uses uiop:subdirectories and uiop:directory-files directly — no virtual filesystem hooks. TRAMP paths don't exist locally, so list-directory returned nil and the completion candidate list was always empty. Fixes: - Override *prompt-file-completion-function* with a TRAMP-aware wrapper that calls directory-files (which does have virtual hooks) directly. - For :sudo, delegate directory listing to the local filesystem (strip the "/sudo::" prefix, list locally, re-add the prefix) so completion works without triggering a password prompt. - Add pathname→string guards in tramp-list-directory-1 and tramp-sudo-directory-files (completion-file passes pathname objects from merge-pathnames). --- extensions/tramp/tramp.lisp | 109 +++++++++++++++++++++++++++--------- 1 file changed, 84 insertions(+), 25 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index f595fa8b7..eaa37230e 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -31,7 +31,7 @@ Returns (values method user host remote-path)." (when (pathnamep filename) (setf filename (namestring filename))) (ppcre:register-groups-bind (method user-host remote-path) - ("^/(\\w+):([^:]*):(.+)" filename) + ("^/(\\w+):([^:]*):(.*)" filename) (unless method (editor-error "Invalid TRAMP path: ~A" filename)) (let ((user nil) @@ -45,6 +45,8 @@ Returns (values method user host remote-path)." (setf host user-host))) (when (null host) (setf host "localhost")) + (when (or (null remote-path) (string= remote-path "")) + (setf remote-path "/")) (values (intern (string-upcase method) :keyword) user host @@ -176,10 +178,10 @@ Marks connection as needing password and prompts." (ecase method (:sudo (if (eql 0 (nth-value 2 - (uiop:run-program '("sudo" "-n" "true") - :output nil - :error-output nil - :ignore-error-status t))) + (uiop:run-program '("sudo" "-n" "true") + :output nil + :error-output nil + :ignore-error-status t))) nil ;; passwordless sudo (or (tramp-prompt-password method user host) (error 'editor-abort)))) @@ -281,10 +283,10 @@ Returns (values exit-code stdout-string)." (finish-output in)) (close in) (let ((stdout - (with-output-to-string (s) - (loop for line = (read-line out nil nil) - while line - do (write-line line s))))) + (with-output-to-string (s) + (loop for line = (read-line out nil nil) + while line + do (write-line line s))))) (ignore-errors (close out)) (let ((exit-code (uiop:wait-process process))) (values exit-code stdout)))) @@ -431,7 +433,7 @@ Returns (values exit-code stdout-string)." (if (equal element-type '(unsigned-byte 8)) (list raw-stream closer) (list (flexi-streams:make-flexi-stream raw-stream - :external-format (or external-format :utf-8)) + :external-format (or external-format :utf-8)) closer)))) (:output (multiple-value-bind (raw-stream closer) @@ -439,7 +441,7 @@ Returns (values exit-code stdout-string)." (if (equal element-type '(unsigned-byte 8)) (list raw-stream closer) (list (flexi-streams:make-flexi-stream raw-stream - :external-format (or external-format :utf-8)) + :external-format (or external-format :utf-8)) closer)))))))) ;;; ------------------------------------------------------------------ @@ -476,15 +478,20 @@ Returns (values exit-code stdout-string)." (defun tramp-directory-files-handler (pathspec) "Handler for *virtual-directory-files-functions*. -Caches directory check and listings for 5 seconds." +Caches directory check and listings for 5 seconds. +For :sudo, delegates to local filesystem (no remote calls) so +completion works without triggering a password prompt." (when (tramp-path-p pathspec) (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) + (when (eq method :sudo) + (return-from tramp-directory-files-handler + (tramp-sudo-directory-files pathspec remote-path))) ;; Use cached directory check (let ((cached (tramp-fs-cache-get method user host remote-path :dir-exists))) (if (eq cached :not-found) ;; Check and cache (let ((is-dir (eql 0 (run-remote-exit-code method user host - (list "test" "-d" remote-path))))) + (list "test" "-d" remote-path))))) (tramp-fs-cache-set method user host remote-path :dir-exists is-dir) (if is-dir (tramp-list-directory-1 method user host pathspec remote-path) @@ -493,8 +500,30 @@ Caches directory check and listings for 5 seconds." (tramp-list-directory-1 method user host pathspec remote-path) (list pathspec))))))) +(defun tramp-sudo-directory-files (pathspec remote-path) + "List local directory contents for a :sudo path. +Uses local filesystem, not sudo — this is for completion only; +file open still goes through sudo for access." + (when (pathnamep pathspec) + (setf pathspec (namestring pathspec))) + (let* ((local-dir (uiop:ensure-directory-pathname remote-path)) + (files (ignore-errors + (or (append (uiop:subdirectories local-dir) + (uiop:directory-files local-dir)) + (directory (make-pathname :defaults local-dir + :name :wild :type :wild)))))) + (when files + (let ((prefix (if (char= (char pathspec (1- (length pathspec))) #\/) + pathspec + (concatenate 'string pathspec "/")))) + (mapcar (lambda (f) (concatenate 'string prefix + (namestring (enough-namestring f local-dir)))) + files))))) + (defun tramp-list-directory-1 (method user host pathspec remote-path) "List contents of a remote directory. Uses cache." + (when (pathnamep pathspec) + (setf pathspec (namestring pathspec))) (let ((cached (tramp-fs-cache-get method user host remote-path :dir-files))) (unless (eq cached :not-found) (return-from tramp-list-directory-1 cached))) @@ -538,18 +567,38 @@ Uses cache; fetches all metadata in a single stat call." (defun tramp-expand-file-name-handler (filename directory) "Handler for *virtual-expand-file-name-functions*. -For TRAMP paths, skip local path merging and return the path as-is. -For :sudo, pre-fetches the password here (before any buffer is created) -to prevent keystrokes from leaking into the file buffer." +For TRAMP paths, skip local path merging and return the path as-is." (declare (ignore directory)) (when (tramp-path-p filename) - (multiple-value-bind (method user host remote-path) (parse-tramp-path filename) - (declare (ignore remote-path)) - (when (eq method :sudo) - ;; Prompt early, while the UI is clean — no buffer exists yet, - ;; and the find-file minibuffer just closed. - (tramp-ensure-password method user host)) - filename))) + filename)) + +;;; ------------------------------------------------------------------ +;;; File Completion (bypasses list-directory which lacks virtual hooks) +;;; ------------------------------------------------------------------ + +(defvar *tramp-original-completion-function* nil) + +(defun tramp-file-completion (string directory &key directory-only) + "Completion function for TRAMP paths. +Bypasses list-directory (no virtual hooks) by calling +directory-files directly for the TRAMP directory listing." + (declare (ignore directory-only)) + (let* ((expanded (expand-file-name string directory)) + (input-dir (directory-namestring expanded))) + (if (tramp-path-p input-dir) + (let* ((files (directory-files expanded)) + (prefix-len (length input-dir))) + (when files + (mapcar (lambda (f) + (let* ((full (namestring f)) + (label (if (> (length full) prefix-len) + (subseq full prefix-len) + full))) + (lem/completion-mode:make-completion-item + :label label))) + files))) + (funcall *tramp-original-completion-function* + string directory :directory-only directory-only)))) ;;; ------------------------------------------------------------------ ;;; External Format Detection Override @@ -589,7 +638,13 @@ so we return a safe default (:utf-8 :lf) for remote files." (setf *tramp-original-external-format-function* lem/buffer/file:*external-format-function*) (setf lem/buffer/file:*external-format-function* - 'tramp-external-format-function-wrapper))) + 'tramp-external-format-function-wrapper)) + ;; Override completion to handle TRAMP paths + (unless *tramp-original-completion-function* + (setf *tramp-original-completion-function* + lem-core::*prompt-file-completion-function*) + (setf lem-core::*prompt-file-completion-function* + 'tramp-file-completion))) (defun tramp-disable () "Disable TRAMP remote file support." @@ -608,7 +663,11 @@ so we return a safe default (:utf-8 :lf) for remote files." (when *tramp-original-external-format-function* (setf lem/buffer/file:*external-format-function* *tramp-original-external-format-function*) - (setf *tramp-original-external-format-function* nil))) + (setf *tramp-original-external-format-function* nil)) + (when *tramp-original-completion-function* + (setf lem-core::*prompt-file-completion-function* + *tramp-original-completion-function*) + (setf *tramp-original-completion-function* nil))) ;; Auto-enable at load time (tramp-enable) From 8946318800f8608ed2bdfd589c57eabba7423daf Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 13:45:09 +0800 Subject: [PATCH 06/23] fix contract.yml errors --- extensions/tramp/tramp.lisp | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index eaa37230e..a2ebcb29f 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -207,18 +207,20 @@ Marks connection as needing password and prompts." (cmd-args (if (listp command) command (list command))) (control-opts (ssh-control-options))) (if password - `("sshpass" "-p" ,password - "ssh" "-T" - "-o" "StrictHostKeyChecking=accept-new" - "-o" "ConnectTimeout=3" - ,@control-opts - ,target ,@cmd-args) - `("ssh" "-T" - "-o" "BatchMode=yes" - "-o" "StrictHostKeyChecking=accept-new" - "-o" "ConnectTimeout=3" - ,@control-opts - ,target ,@cmd-args)))) + (append (list "sshpass" "-p" password + "ssh" "-T" + "-o" "StrictHostKeyChecking=accept-new" + "-o" "ConnectTimeout=3") + control-opts + (list target) + cmd-args) + (append (list "ssh" "-T" + "-o" "BatchMode=yes" + "-o" "StrictHostKeyChecking=accept-new" + "-o" "ConnectTimeout=3") + control-opts + (list target) + cmd-args)))) (:sudo (let ((args (list "sudo"))) (when use-sudo-s @@ -284,9 +286,9 @@ Returns (values exit-code stdout-string)." (close in) (let ((stdout (with-output-to-string (s) - (loop for line = (read-line out nil nil) - while line - do (write-line line s))))) + (loop :for line := (read-line out nil nil) + :while line + :do (write-line line s))))) (ignore-errors (close out)) (let ((exit-code (uiop:wait-process process))) (values exit-code stdout)))) @@ -342,7 +344,7 @@ Returns (values exit-code stdout-string)." (defun %read-remote-file (method user host path) "Read a remote file via cat. Returns the content as a string." (handler-case - (let ((cmd `("cat" ,path))) + (let ((cmd (list "cat" path))) (if (eq method :ssh) (multiple-value-bind (exit-code stdout) (%ssh-run-with-auth-retry user host cmd) @@ -576,7 +578,8 @@ For TRAMP paths, skip local path merging and return the path as-is." ;;; File Completion (bypasses list-directory which lacks virtual hooks) ;;; ------------------------------------------------------------------ -(defvar *tramp-original-completion-function* nil) +(defvar *tramp-original-completion-function* nil + "Saved original value of *prompt-file-completion-function*.") (defun tramp-file-completion (string directory &key directory-only) "Completion function for TRAMP paths. From ea06bc3f0c528cbf6e883e017ff68a7f9c5a02c6 Mon Sep 17 00:00:00 2001 From: steiner Date: Tue, 21 Jul 2026 14:03:21 +0800 Subject: [PATCH 07/23] tramp: fix completion filtering by partial input MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Two bugs in tramp-file-completion: 1. directory-files was called with the full user input (e.g. /sudo::/etc/p) instead of the directory part (/sudo::/etc/), causing the delegation to local filesystem to look up a non-existent directory path and return nothing. 2. No filtering was applied to the completion candidates — Tab always showed every file in the directory regardless of what the user had already typed. Added case-insensitive prefix matching against the partial filename. --- extensions/tramp/tramp.lisp | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index a2ebcb29f..ed97e3d1d 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -589,17 +589,28 @@ directory-files directly for the TRAMP directory listing." (let* ((expanded (expand-file-name string directory)) (input-dir (directory-namestring expanded))) (if (tramp-path-p input-dir) - (let* ((files (directory-files expanded)) - (prefix-len (length input-dir))) + (let* ((files (directory-files input-dir)) + ;; Partial filename the user is typing (after the last "/") + (partial (enough-namestring expanded input-dir))) (when files - (mapcar (lambda (f) - (let* ((full (namestring f)) - (label (if (> (length full) prefix-len) - (subseq full prefix-len) - full))) - (lem/completion-mode:make-completion-item - :label label))) - files))) + (let ((filtered + (if (and partial (not (string= partial ""))) + (remove-if-not + (lambda (f) + (let ((name (enough-namestring (namestring f) input-dir))) + (and name + (> (length name) 0) + (eql 0 (search (string-downcase partial) + (string-downcase name)))))) + files) + files))) + (unless filtered + (return-from tramp-file-completion nil)) + (mapcar (lambda (f) + (let ((label (enough-namestring (namestring f) input-dir))) + (lem/completion-mode:make-completion-item + :label (or label (namestring f))))) + filtered)))) (funcall *tramp-original-completion-function* string directory :directory-only directory-only)))) From 1ae444cf622bb5bf267cd0022e5e874f68783b6a Mon Sep 17 00:00:00 2001 From: steiner Date: Wed, 22 Jul 2026 23:20:47 +0800 Subject: [PATCH 08/23] tramp: Add README --- extensions/tramp/README.md | 75 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 75 insertions(+) create mode 100644 extensions/tramp/README.md diff --git a/extensions/tramp/README.md b/extensions/tramp/README.md new file mode 100644 index 000000000..c1ae3b5bd --- /dev/null +++ b/extensions/tramp/README.md @@ -0,0 +1,75 @@ +# lem-tramp + +Transparent remote file editing for Lem. Works like +[Emacs TRAMP](https://www.gnu.org/software/tramp/) — type a remote path +into `C-x C-f` and edit the file as if it were local. + +## Supported Methods + +| Method | Syntax | Description | +|--------|--------|-------------| +| `ssh` | `/ssh:user@host:/remote/path` | Edit files on a remote host via SSH | +| `sudo` | `/sudo::/local/path` | Edit local files with root privileges via sudo | + +## Usage + +Open a file with `C-x C-f` using the TRAMP path syntax: + +``` +C-x C-f /ssh:root@example.com:/etc/nginx/nginx.conf +C-x C-f /sudo::/etc/hostname +``` + +The remote file is loaded into a buffer. Edit normally, then save with `C-x C-s`. + +## Authentication + +### SSH (`/ssh:`) + +**Key-based auth** (recommended) — no prompt, works automatically if you have +SSH keys set up and your key is in the remote host's `authorized_keys`. + +**Password auth** — requires the `sshpass` utility: + +```bash +# Arch +sudo pacman -S sshpass +# Debian/Ubuntu +sudo apt install sshpass +``` + +When key auth is unavailable, a password prompt appears in the minibuffer. +The password is cached for the session; subsequent file operations on the +same host reuse it without re-prompting. + +### Sudo (`/sudo::`) + +A password prompt appears if your sudo timestamp has expired (typically +5-15 minutes since your last `sudo` invocation in a terminal). If you +have passwordless sudo configured (`NOPASSWD` in sudoers), no prompt is +shown. + +## How It Works + +lem-tramp hooks into Lem's virtual filesystem layer: + +- **Reading** — runs `cat /remote/path` via SSH (or sudo), loads the + output directly into an in-memory buffer. +- **Writing** — pipes the buffer content through `cat > /remote/path`. +- **Directory listing** — uses `ls -1a` for completion and directory-mode. +- **Metadata** — uses `stat -c '%s %Y'` for file size and modification time. + +No temporary files are created on either the local or remote side. + +## Dependencies + +- **sshpass** — only needed for SSH password authentication +- **flexi-streams**, **str**, **babel**, **ppcre** — Common Lisp libraries + +## Performance + +SSH connections use `ControlMaster` multiplexing — the first command +establishes the TCP connection, and all subsequent commands reuse it. +A 5-second filesystem cache eliminates redundant `test -d` / `test -f` / +`stat` calls when Lem probes the same path multiple times during a single +file-open operation. From 11002311cc99e9fed2a6f191cc8f4b777da3bb03 Mon Sep 17 00:00:00 2001 From: steiner Date: Wed, 22 Jul 2026 23:34:31 +0800 Subject: [PATCH 09/23] tramp: restrict auto-enable to Unix platforms --- extensions/tramp/tramp.lisp | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index ed97e3d1d..39766695f 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -683,5 +683,6 @@ so we return a safe default (:utf-8 :lf) for remote files." *tramp-original-completion-function*) (setf *tramp-original-completion-function* nil))) -;; Auto-enable at load time -(tramp-enable) +;; Auto-enable at load time (Unix only) +#+unix (tramp-enable) +#-unix (warn "TRAMP is not supported on this platform; only Unix systems are supported.") From 761871f079776b86c6e6e91259f27228d85c3f27 Mon Sep 17 00:00:00 2001 From: steiner Date: Wed, 22 Jul 2026 23:43:43 +0800 Subject: [PATCH 10/23] tramp: shorter for uiop:ensure-list --- extensions/tramp/tramp.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 39766695f..8ece72bd7 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -204,7 +204,7 @@ Marks connection as needing password and prompts." (ecase method (:ssh (let ((target (if user (format nil "~A@~A" user host) host)) - (cmd-args (if (listp command) command (list command))) + (cmd-args (uiop:ensure-list command)) (control-opts (ssh-control-options))) (if password (append (list "sshpass" "-p" password @@ -227,7 +227,7 @@ Marks connection as needing password and prompts." (push "-S" (cdr args))) (when user (setf args (append args (list "-u" user)))) - (append args (if (listp command) command (list command))))))) + (append args (uiop:ensure-list command)))))) ;;; Core SSH execution with lazy auth From abd86c90b6ee799d1b56d8ade24a5fc1e9d952df Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 23 Jul 2026 00:03:07 +0800 Subject: [PATCH 11/23] tramp: remove tramp-* prefix --- extensions/tramp/tramp.lisp | 219 ++++++++++++++++++------------------ 1 file changed, 109 insertions(+), 110 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 8ece72bd7..f2ca0dcb6 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -1,6 +1,5 @@ (defpackage :lem-tramp - (:use :cl :lem) - (:export :tramp-mode)) + (:use :cl :lem)) (in-package :lem-tramp) (setf (documentation *package* t) @@ -15,7 +14,7 @@ C-x C-f /sudo::/etc/hostname") ;;; Path Parsing ;;; ------------------------------------------------------------------ -(defun tramp-path-p (filename) +(defun path-p (filename) "Return T if FILENAME is a TRAMP-style path (/method:user@host:/path)." (when (pathnamep filename) (setf filename (namestring filename))) @@ -25,7 +24,7 @@ C-x C-f /sudo::/etc/hostname") (ppcre:scan "^\\w+:" (subseq filename 1)) t)) -(defun parse-tramp-path (filename) +(defun parse-path (filename) "Parse FILENAME like /ssh:user@host:/remote/path or /sudo::/path. Returns (values method user host remote-path)." (when (pathnamep filename) @@ -56,22 +55,22 @@ Returns (values method user host remote-path)." ;;; Password Management ;;; ------------------------------------------------------------------ -(defvar *tramp-passwords* (make-hash-table :test 'equal) +(defvar *passwords* (make-hash-table :test 'equal) "Cache of passwords keyed by connection key (e.g. \"sudo:root@localhost\").") -(defun tramp-connection-key (method user host) +(defun connection-key (method user host) "Make a cache key for a TRAMP connection." (format nil "~A:~A@~A" method (or user "") host)) -(defun tramp-get-password (method user host) +(defun get-password (method user host) "Get the cached password for a connection, or nil." - (values (gethash (tramp-connection-key method user host) *tramp-passwords*))) + (values (gethash (connection-key method user host) *passwords*))) -(defun tramp-clear-password (method user host) +(defun clear-password (method user host) "Clear the cached password for a connection (on auth failure)." - (remhash (tramp-connection-key method user host) *tramp-passwords*)) + (remhash (connection-key method user host) *passwords*)) -(defun tramp-prompt-password (method user host) +(defun prompt-password (method user host) "Prompt the user for a password and cache it. Returns the password string, or nil if cancelled/empty." (let ((prompt (format nil "TRAMP password for /~A:~@[~A@~]~A: " @@ -79,39 +78,39 @@ Returns the password string, or nil if cancelled/empty." (let ((password (prompt-for-string prompt))) (if (and password (plusp (length password))) (progn - (setf (gethash (tramp-connection-key method user host) *tramp-passwords*) + (setf (gethash (connection-key method user host) *passwords*) password) password) (progn - (tramp-clear-password method user host) + (clear-password method user host) nil))))) ;;; ------------------------------------------------------------------ ;;; FS Cache (5-second TTL — eliminates duplicate SSH calls) ;;; ------------------------------------------------------------------ -(defvar *tramp-fs-cache* (make-hash-table :test 'equal) +(defvar *fs-cache* (make-hash-table :test 'equal) "Cache for filesystem operations. Keys are (method user host path op), values are cons of (timestamp . result).") -(defvar *tramp-fs-cache-ttl* 5 +(defvar *fs-cache-ttl* 5 "Time-to-live in seconds for filesystem cache entries.") -(defun tramp-fs-cache-key (method user host path op) +(defun fs-cache-key (method user host path op) "Make a cache key for a filesystem operation." (format nil "~A:~A@~A:~A:~A" method (or user "") host path op)) -(defun tramp-fs-cache-get (method user host path op) +(defun fs-cache-get (method user host path op) "Get a cached value, or :not-found." - (let* ((key (tramp-fs-cache-key method user host path op)) - (entry (gethash key *tramp-fs-cache*))) - (if (and entry (< (- (get-universal-time) (car entry)) *tramp-fs-cache-ttl*)) + (let* ((key (fs-cache-key method user host path op)) + (entry (gethash key *fs-cache*))) + (if (and entry (< (- (get-universal-time) (car entry)) *fs-cache-ttl*)) (cdr entry) - (progn (remhash key *tramp-fs-cache*) :not-found)))) + (progn (remhash key *fs-cache*) :not-found)))) -(defun tramp-fs-cache-set (method user host path op value) +(defun fs-cache-set (method user host path op value) "Cache a value with current timestamp." - (setf (gethash (tramp-fs-cache-key method user host path op) *tramp-fs-cache*) + (setf (gethash (fs-cache-key method user host path op) *fs-cache*) (cons (get-universal-time) value))) ;;; ------------------------------------------------------------------ @@ -140,7 +139,7 @@ Returns (values password auth-tried-p): - unknown → (values nil nil) — caller should try BatchMode first" (declare (ignore method)) (let ((conn-key (format nil "~A@~A" (or user "") host))) - (or (let ((pwd (tramp-get-password :ssh user host))) + (or (let ((pwd (get-password :ssh user host))) (when pwd (return-from ssh-ensure-auth (values pwd t)))) (let ((auth-method (gethash conn-key *ssh-auth-method-cache*))) (ecase auth-method @@ -148,7 +147,7 @@ Returns (values password auth-tried-p): (:key (values nil t)) ;; key works, no password needed (:password ;; need password (if (sshpass-available-p) - (let ((pwd (tramp-prompt-password :ssh user host))) + (let ((pwd (prompt-password :ssh user host))) (values pwd t)) (editor-error "SSH key auth failed for ~A@~A. Install sshpass for password auth." @@ -159,9 +158,9 @@ Returns (values password auth-tried-p): Marks connection as needing password and prompts." (let ((conn-key (format nil "~A@~A" (or user "") host))) (setf (gethash conn-key *ssh-auth-method-cache*) :password) - (tramp-clear-password :ssh user host) + (clear-password :ssh user host) (if (sshpass-available-p) - (tramp-prompt-password :ssh user host) + (prompt-password :ssh user host) (editor-error "SSH key auth failed for ~A@~A. Install sshpass for password auth." (or user "") host)))) @@ -171,10 +170,10 @@ Marks connection as needing password and prompts." (let ((conn-key (format nil "~A@~A" (or user "") host))) (setf (gethash conn-key *ssh-auth-method-cache*) :key))) -(defun tramp-ensure-password (method user host) +(defun ensure-password (method user host) "Get cached password or prompt the user. For :ssh returns nil (lazy auth — the actual command will trigger auth handling)." - (or (tramp-get-password method user host) + (or (get-password method user host) (ecase method (:sudo (if (eql 0 (nth-value 2 @@ -183,7 +182,7 @@ Marks connection as needing password and prompts." :error-output nil :ignore-error-status t))) nil ;; passwordless sudo - (or (tramp-prompt-password method user host) + (or (prompt-password method user host) (error 'editor-abort)))) (:ssh ;; Lazy auth: authenticated on first actual command, not here @@ -317,7 +316,7 @@ Returns (values exit-code stdout-string)." "Run a command on a remote host. Returns its exit code (0 = success)." (if (eq method :ssh) (%ssh-run-with-auth-retry user host command) - (let* ((password (tramp-ensure-password method user host)) + (let* ((password (ensure-password method user host)) (use-sudo-s (and (eq method :sudo) password)) (args (build-ssh-args method user host command :use-sudo-s use-sudo-s))) (%sudo-run-exit-code user host args password)))) @@ -329,7 +328,7 @@ Returns (values exit-code stdout-string)." (%ssh-run-with-auth-retry user host command) (declare (ignore exit-code)) (string-trim '(#\newline #\return) stdout)) - (let* ((password (tramp-ensure-password method user host)) + (let* ((password (ensure-password method user host)) (use-sudo-s (and (eq method :sudo) password)) (args (build-ssh-args method user host command :use-sudo-s use-sudo-s))) (multiple-value-bind (exit-code stdout) @@ -351,7 +350,7 @@ Returns (values exit-code stdout-string)." (unless (eql 0 exit-code) (editor-error "Failed to read remote file ~A (exit ~D)" path exit-code)) stdout) - (let* ((password (tramp-ensure-password method user host)) + (let* ((password (ensure-password method user host)) (use-sudo-s (and (eq method :sudo) password)) (args (build-ssh-args method user host cmd :use-sudo-s use-sudo-s))) (multiple-value-bind (exit-code stdout) @@ -368,7 +367,7 @@ Returns (values exit-code stdout-string)." (editor-error (e) (error e)) (error (e) - (tramp-clear-password method user host) + (clear-password method user host) (editor-error "Failed to read remote file ~A: ~A" path e)))) (defun %make-ssh-output-stream (method user host path) @@ -387,8 +386,8 @@ Returns (values exit-code stdout-string)." (:sudo (list "/bin/sh" "-c" (format nil "cat > ~A" (escape-shell-arg path)))))) (use-sudo-s (eq method :sudo)) - (password (or (tramp-get-password method user host) - (tramp-ensure-password method user host))) + (password (or (get-password method user host) + (ensure-password method user host))) (args (build-ssh-args method user host cmd :use-sudo-s use-sudo-s :password (when (eq method :ssh) password)))) @@ -410,7 +409,7 @@ Returns (values exit-code stdout-string)." (editor-error (e) (error e)) (error (e) - (tramp-clear-password method user host) + (clear-password method user host) (editor-error "Failed to write remote file ~A: ~A" path e))))) (defun escape-shell-arg (arg) @@ -422,12 +421,12 @@ Returns (values exit-code stdout-string)." ;;; Virtual File Open Handler ;;; ------------------------------------------------------------------ -(defun tramp-file-open-handler (filename &key direction element-type external-format) +(defun file-open-handler (filename &key direction element-type external-format) "Handler for *virtual-file-open* that intercepts TRAMP paths." (when (pathnamep filename) (setf filename (namestring filename))) - (when (tramp-path-p filename) - (multiple-value-bind (method user host remote-path) (parse-tramp-path filename) + (when (path-p filename) + (multiple-value-bind (method user host remote-path) (parse-path filename) (ecase direction (:input (multiple-value-bind (raw-stream closer) @@ -450,59 +449,59 @@ Returns (values exit-code stdout-string)." ;;; Filesystem Hooks (with 5-second FS cache) ;;; ------------------------------------------------------------------ -(defun tramp-probe-file-handler (pathspec &optional base-dir) +(defun probe-file-handler (pathspec &optional base-dir) "Handler for *virtual-probe-file-functions*. Uses cache to avoid duplicate SSH calls." (declare (ignore base-dir)) - (when (tramp-path-p pathspec) - (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) - (let ((cached (tramp-fs-cache-get method user host remote-path :probe-file))) + (when (path-p pathspec) + (multiple-value-bind (method user host remote-path) (parse-path pathspec) + (let ((cached (fs-cache-get method user host remote-path :probe-file))) (unless (eq cached :not-found) - (return-from tramp-probe-file-handler cached))) + (return-from probe-file-handler cached))) (let ((code (run-remote-exit-code method user host (list "test" "-f" remote-path)))) (let ((result (when (eql 0 code) (namestring pathspec)))) - (tramp-fs-cache-set method user host remote-path :probe-file result) + (fs-cache-set method user host remote-path :probe-file result) result))))) -(defun tramp-directory-exists-handler (directory) +(defun directory-exists-handler (directory) "Handler for *virtual-directory-exists-p-functions*. Uses cache." - (when (tramp-path-p directory) - (multiple-value-bind (method user host remote-path) (parse-tramp-path directory) - (let ((cached (tramp-fs-cache-get method user host remote-path :dir-exists))) + (when (path-p directory) + (multiple-value-bind (method user host remote-path) (parse-path directory) + (let ((cached (fs-cache-get method user host remote-path :dir-exists))) (unless (eq cached :not-found) - (return-from tramp-directory-exists-handler + (return-from directory-exists-handler (when cached directory)))) (let ((code (run-remote-exit-code method user host (list "test" "-d" remote-path)))) - (tramp-fs-cache-set method user host remote-path :dir-exists (eql 0 code)) + (fs-cache-set method user host remote-path :dir-exists (eql 0 code)) (when (eql 0 code) directory))))) -(defun tramp-directory-files-handler (pathspec) +(defun directory-files-handler (pathspec) "Handler for *virtual-directory-files-functions*. Caches directory check and listings for 5 seconds. For :sudo, delegates to local filesystem (no remote calls) so completion works without triggering a password prompt." - (when (tramp-path-p pathspec) - (multiple-value-bind (method user host remote-path) (parse-tramp-path pathspec) + (when (path-p pathspec) + (multiple-value-bind (method user host remote-path) (parse-path pathspec) (when (eq method :sudo) - (return-from tramp-directory-files-handler - (tramp-sudo-directory-files pathspec remote-path))) + (return-from directory-files-handler + (sudo-directory-files pathspec remote-path))) ;; Use cached directory check - (let ((cached (tramp-fs-cache-get method user host remote-path :dir-exists))) + (let ((cached (fs-cache-get method user host remote-path :dir-exists))) (if (eq cached :not-found) ;; Check and cache (let ((is-dir (eql 0 (run-remote-exit-code method user host (list "test" "-d" remote-path))))) - (tramp-fs-cache-set method user host remote-path :dir-exists is-dir) + (fs-cache-set method user host remote-path :dir-exists is-dir) (if is-dir - (tramp-list-directory-1 method user host pathspec remote-path) + (list-directory-1 method user host pathspec remote-path) (list pathspec))) (if cached - (tramp-list-directory-1 method user host pathspec remote-path) + (list-directory-1 method user host pathspec remote-path) (list pathspec))))))) -(defun tramp-sudo-directory-files (pathspec remote-path) +(defun sudo-directory-files (pathspec remote-path) "List local directory contents for a :sudo path. Uses local filesystem, not sudo — this is for completion only; file open still goes through sudo for access." @@ -522,13 +521,13 @@ file open still goes through sudo for access." (namestring (enough-namestring f local-dir)))) files))))) -(defun tramp-list-directory-1 (method user host pathspec remote-path) +(defun list-directory-1 (method user host pathspec remote-path) "List contents of a remote directory. Uses cache." (when (pathnamep pathspec) (setf pathspec (namestring pathspec))) - (let ((cached (tramp-fs-cache-get method user host remote-path :dir-files))) + (let ((cached (fs-cache-get method user host remote-path :dir-files))) (unless (eq cached :not-found) - (return-from tramp-list-directory-1 cached))) + (return-from list-directory-1 cached))) (let ((output (run-remote-string method user host (list "ls" "-1a" remote-path)))) (when output @@ -541,16 +540,16 @@ file open still goes through sudo for access." (unless (or (string= name "") (string= name ".") (string= name "..")) (push (concatenate 'string prefix name) result)))) (setf result (nreverse result)) - (tramp-fs-cache-set method user host remote-path :dir-files result) + (fs-cache-set method user host remote-path :dir-files result) result)))) -(defun tramp-file-metadata-handler (pathname op) +(defun file-metadata-handler (pathname op) "Handler for *virtual-file-metadata-functions*. Uses cache; fetches all metadata in a single stat call." - (when (tramp-path-p pathname) - (multiple-value-bind (method user host remote-path) (parse-tramp-path pathname) + (when (path-p pathname) + (multiple-value-bind (method user host remote-path) (parse-path pathname) ;; Check cache for any metadata op - (let ((cached (tramp-fs-cache-get method user host remote-path :metadata))) + (let ((cached (fs-cache-get method user host remote-path :metadata))) (when (eq cached :not-found) ;; Fetch all metadata in one call: "stat -c '%s %Y'" (let ((output (run-remote-string method user host @@ -561,34 +560,34 @@ Uses cache; fetches all metadata in a single stat call." (when (= 2 (length parts)) (cons (ignore-errors (parse-integer (first parts))) (ignore-errors (parse-integer (second parts)))))))) - (tramp-fs-cache-set method user host remote-path :metadata cached))) + (fs-cache-set method user host remote-path :metadata cached))) (ecase op (:size (or (car cached) 0)) (:mtime (or (cdr cached) 0)) (:write-date (or (cdr cached) 0))))))) -(defun tramp-expand-file-name-handler (filename directory) +(defun expand-file-name-handler (filename directory) "Handler for *virtual-expand-file-name-functions*. For TRAMP paths, skip local path merging and return the path as-is." (declare (ignore directory)) - (when (tramp-path-p filename) + (when (path-p filename) filename)) ;;; ------------------------------------------------------------------ ;;; File Completion (bypasses list-directory which lacks virtual hooks) ;;; ------------------------------------------------------------------ -(defvar *tramp-original-completion-function* nil +(defvar *original-completion-function* nil "Saved original value of *prompt-file-completion-function*.") -(defun tramp-file-completion (string directory &key directory-only) +(defun file-completion (string directory &key directory-only) "Completion function for TRAMP paths. Bypasses list-directory (no virtual hooks) by calling directory-files directly for the TRAMP directory listing." (declare (ignore directory-only)) (let* ((expanded (expand-file-name string directory)) (input-dir (directory-namestring expanded))) - (if (tramp-path-p input-dir) + (if (path-p input-dir) (let* ((files (directory-files input-dir)) ;; Partial filename the user is typing (after the last "/") (partial (enough-namestring expanded input-dir))) @@ -605,84 +604,84 @@ directory-files directly for the TRAMP directory listing." files) files))) (unless filtered - (return-from tramp-file-completion nil)) + (return-from file-completion nil)) (mapcar (lambda (f) (let ((label (enough-namestring (namestring f) input-dir))) (lem/completion-mode:make-completion-item :label (or label (namestring f))))) filtered)))) - (funcall *tramp-original-completion-function* + (funcall *original-completion-function* string directory :directory-only directory-only)))) ;;; ------------------------------------------------------------------ ;;; External Format Detection Override ;;; ------------------------------------------------------------------ -(defvar *tramp-original-external-format-function* nil +(defvar *original-external-format-function* nil "Saved original value of *external-format-function* before TRAMP overrides it.") -(defun tramp-external-format-function-wrapper (filename) +(defun external-format-function-wrapper (filename) "Wrapper for *external-format-function* that handles TRAMP paths. TRAMP files cannot be opened with CL's OPEN for encoding detection, so we return a safe default (:utf-8 :lf) for remote files." - (if (tramp-path-p filename) + (if (path-p filename) (values :utf-8 :lf) - (if *tramp-original-external-format-function* - (funcall *tramp-original-external-format-function* filename) + (if *original-external-format-function* + (funcall *original-external-format-function* filename) (values :utf-8 :lf)))) ;;; ------------------------------------------------------------------ ;;; Registration ;;; ------------------------------------------------------------------ -(defun tramp-enable () +(defun enable () "Enable TRAMP remote file support." - (pushnew 'tramp-file-open-handler *virtual-file-open*) - (pushnew 'tramp-probe-file-handler + (pushnew 'file-open-handler *virtual-file-open*) + (pushnew 'probe-file-handler lem/buffer/file-utils:*virtual-probe-file-functions*) - (pushnew 'tramp-directory-exists-handler + (pushnew 'directory-exists-handler lem/buffer/file-utils:*virtual-directory-exists-p-functions*) - (pushnew 'tramp-directory-files-handler + (pushnew 'directory-files-handler lem/buffer/file-utils:*virtual-directory-files-functions*) - (pushnew 'tramp-file-metadata-handler + (pushnew 'file-metadata-handler lem/buffer/file-utils:*virtual-file-metadata-functions*) - (pushnew 'tramp-expand-file-name-handler + (pushnew 'expand-file-name-handler lem/buffer/file-utils:*virtual-expand-file-name-functions*) - (unless *tramp-original-external-format-function* - (setf *tramp-original-external-format-function* + (unless *original-external-format-function* + (setf *original-external-format-function* lem/buffer/file:*external-format-function*) (setf lem/buffer/file:*external-format-function* - 'tramp-external-format-function-wrapper)) + 'external-format-function-wrapper)) ;; Override completion to handle TRAMP paths - (unless *tramp-original-completion-function* - (setf *tramp-original-completion-function* + (unless *original-completion-function* + (setf *original-completion-function* lem-core::*prompt-file-completion-function*) (setf lem-core::*prompt-file-completion-function* - 'tramp-file-completion))) + 'file-completion))) -(defun tramp-disable () +(defun disable () "Disable TRAMP remote file support." (setf *virtual-file-open* - (remove 'tramp-file-open-handler *virtual-file-open*)) + (remove 'file-open-handler *virtual-file-open*)) (setf lem/buffer/file-utils:*virtual-probe-file-functions* - (remove 'tramp-probe-file-handler lem/buffer/file-utils:*virtual-probe-file-functions*)) + (remove 'probe-file-handler lem/buffer/file-utils:*virtual-probe-file-functions*)) (setf lem/buffer/file-utils:*virtual-directory-exists-p-functions* - (remove 'tramp-directory-exists-handler lem/buffer/file-utils:*virtual-directory-exists-p-functions*)) + (remove 'directory-exists-handler lem/buffer/file-utils:*virtual-directory-exists-p-functions*)) (setf lem/buffer/file-utils:*virtual-directory-files-functions* - (remove 'tramp-directory-files-handler lem/buffer/file-utils:*virtual-directory-files-functions*)) + (remove 'directory-files-handler lem/buffer/file-utils:*virtual-directory-files-functions*)) (setf lem/buffer/file-utils:*virtual-file-metadata-functions* - (remove 'tramp-file-metadata-handler lem/buffer/file-utils:*virtual-file-metadata-functions*)) + (remove 'file-metadata-handler lem/buffer/file-utils:*virtual-file-metadata-functions*)) (setf lem/buffer/file-utils:*virtual-expand-file-name-functions* - (remove 'tramp-expand-file-name-handler lem/buffer/file-utils:*virtual-expand-file-name-functions*)) - (when *tramp-original-external-format-function* + (remove 'expand-file-name-handler lem/buffer/file-utils:*virtual-expand-file-name-functions*)) + (when *original-external-format-function* (setf lem/buffer/file:*external-format-function* - *tramp-original-external-format-function*) - (setf *tramp-original-external-format-function* nil)) - (when *tramp-original-completion-function* + *original-external-format-function*) + (setf *original-external-format-function* nil)) + (when *original-completion-function* (setf lem-core::*prompt-file-completion-function* - *tramp-original-completion-function*) - (setf *tramp-original-completion-function* nil))) + *original-completion-function*) + (setf *original-completion-function* nil))) ;; Auto-enable at load time (Unix only) -#+unix (tramp-enable) +#+unix (enable) #-unix (warn "TRAMP is not supported on this platform; only Unix systems are supported.") From 36d951fa8a7959eb8a9a2d60b09c1b9e57b3882e Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 23 Jul 2026 01:22:16 +0800 Subject: [PATCH 12/23] tramp: re-prompt password when input wrong password --- extensions/tramp/tramp.lisp | 177 ++++++++++++++++++++++++++---------- 1 file changed, 127 insertions(+), 50 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index f2ca0dcb6..fb0664f72 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -243,24 +243,47 @@ Marks connection as needing password and prompts." (error (c) (values 255 (princ-to-string c))))) +(defun ssh-auth-failure-p (exit-code) + "Return T if EXIT-CODE indicates an SSH authentication failure. +Exit code 255 = SSH BatchMode auth failure / connection refused. +Exit code 5 = sshpass incorrect password." + (or (= exit-code 255) (= exit-code 5))) + (defun %ssh-run-with-auth-retry (user host command) "Run an SSH command with automatic auth handling. -Tries key auth first; on exit-255 failure, prompts for password and retries. -Returns (values exit-code stdout-string)." - (multiple-value-bind (password auth-tried) (ssh-ensure-auth :ssh user host) - (if auth-tried - ;; Auth method known — run directly - (let ((args (build-ssh-args :ssh user host command :password password))) - (%ssh-run user host args)) - ;; Auth method unknown — try key auth first - (let ((args (build-ssh-args :ssh user host command :password nil))) - (multiple-value-bind (exit-code stdout) (%ssh-run user host args) - (if (= exit-code 255) +Tries key auth first; on auth failure, clears cached password and retries. +Signals editor-error if authentication ultimately fails." + (flet ((run-with-password (pwd) + (let ((args (build-ssh-args :ssh user host command :password pwd))) + (%ssh-run user host args)))) + (multiple-value-bind (password auth-tried) (ssh-ensure-auth :ssh user host) + (if auth-tried + ;; Auth method known — run directly + (multiple-value-bind (exit-code stdout) (run-with-password password) + (if (ssh-auth-failure-p exit-code) + ;; Cached password is wrong — re-prompt and retry once + (let ((new-pwd (progn (clear-password :ssh user host) + (prompt-password :ssh user host)))) + (if new-pwd + (multiple-value-bind (ec2 out2) (run-with-password new-pwd) + (if (ssh-auth-failure-p ec2) + (editor-error "Authentication failed for /ssh:~@[~A@~]~A" + (or user "") host) + (values ec2 out2))) + (error 'editor-abort))) + (values exit-code stdout))) + ;; Auth method unknown — try key auth first + (multiple-value-bind (exit-code stdout) + (run-with-password nil) + (if (ssh-auth-failure-p exit-code) ;; Auth failure → prompt password and retry (let ((pwd (ssh-remember-auth-failure user host))) (if pwd - (let ((args2 (build-ssh-args :ssh user host command :password pwd))) - (%ssh-run user host args2)) + (multiple-value-bind (ec2 out2) (run-with-password pwd) + (if (ssh-auth-failure-p ec2) + (editor-error "Authentication failed for /ssh:~@[~A@~]~A" + (or user "") host) + (values ec2 out2))) (values exit-code stdout))) ;; Key auth succeeded or command failed for other reasons (progn @@ -269,46 +292,100 @@ Returns (values exit-code stdout-string)." ;;; Sudo command execution (pipe-based, no temp files) +(defun sudo-auth-failure-p (stderr) + "Return T if STDERR indicates a sudo authentication failure." + (and (plusp (length stderr)) + (or (search "incorrect password" stderr :test #'char-equal) + (search "try again" stderr :test #'char-equal) + (search "Sorry" stderr :test #'char-equal)))) + (defun %sudo-run (user host args password) - "Run a sudo command via pipe. Returns (values exit-code stdout-string)." - (handler-case - (let* ((process (uiop:launch-program args - :output :stream - :input :stream - :error-output :stream - :ignore-error-status t)) - (in (uiop:process-info-input process)) - (out (uiop:process-info-output process))) - (when password - (write-line password in) - (finish-output in)) - (close in) - (let ((stdout - (with-output-to-string (s) - (loop :for line := (read-line out nil nil) - :while line - :do (write-line line s))))) - (ignore-errors (close out)) - (let ((exit-code (uiop:wait-process process))) - (values exit-code stdout)))) - (error (c) - (values 1 (princ-to-string c))))) + "Run a sudo command via pipe. Returns (values exit-code stdout-string). +On authentication failure, re-prompts for password and retries once." + (labels ((do-run (pwd) + (handler-case + (let* ((process (uiop:launch-program args + :output :stream + :input :stream + :error-output :stream + :ignore-error-status t)) + (in (uiop:process-info-input process)) + (out (uiop:process-info-output process)) + (err (uiop:process-info-error-output process))) + (when pwd + (write-line pwd in) + (finish-output in)) + (close in) + (let ((stdout + (with-output-to-string (s) + (loop :for line := (read-line out nil nil) + :while line + :do (write-line line s)))) + (stderr + (with-output-to-string (s) + (loop :for line := (read-line err nil nil) + :while line + :do (write-line line s))))) + (ignore-errors (close out)) + (ignore-errors (close err)) + (let ((exit-code (uiop:wait-process process))) + (values exit-code stdout stderr)))) + (editor-error (c) (error c)) + (error (c) + (values 1 (princ-to-string c) ""))))) + (multiple-value-bind (exit-code stdout stderr) (do-run password) + (if (and password (not (eql 0 exit-code)) (sudo-auth-failure-p stderr)) + ;; Auth failed — re-prompt and retry once + (let ((new-pwd (progn (clear-password :sudo user host) + (prompt-password :sudo user host)))) + (if new-pwd + (multiple-value-bind (ec2 out2 err2) (do-run new-pwd) + (if (and (not (eql 0 ec2)) (sudo-auth-failure-p err2)) + (editor-error "Authentication failed for /sudo:~@[~A@~]~A" + user host) + (values ec2 out2))) + (error 'editor-abort))) + (values exit-code stdout))))) (defun %sudo-run-exit-code (user host args password) - "Run a sudo command, returning just the exit code." - (handler-case - (let* ((process (uiop:launch-program args - :output nil - :input :stream - :error-output nil - :ignore-error-status t)) - (in (uiop:process-info-input process))) - (when password - (write-line password in) - (finish-output in)) - (close in) - (uiop:wait-process process)) - (error () 1))) + "Run a sudo command, returning just the exit code. +On authentication failure, re-prompts for password and retries once." + (labels ((do-run (pwd) + (handler-case + (let* ((process (uiop:launch-program args + :output nil + :input :stream + :error-output :stream + :ignore-error-status t)) + (in (uiop:process-info-input process)) + (err (uiop:process-info-error-output process))) + (when pwd + (write-line pwd in) + (finish-output in)) + (close in) + (let ((exit-code (uiop:wait-process process))) + (let ((stderr + (with-output-to-string (s) + (loop :for line := (read-line err nil nil) + :while line + :do (write-line line s))))) + (ignore-errors (close err)) + (values exit-code stderr)))) + (editor-error (c) (error c)) + (error () (values 1 ""))))) + (multiple-value-bind (exit-code stderr) (do-run password) + (if (and password (not (eql 0 exit-code)) (sudo-auth-failure-p stderr)) + ;; Auth failed — re-prompt and retry once + (let ((new-pwd (progn (clear-password :sudo user host) + (prompt-password :sudo user host)))) + (if new-pwd + (multiple-value-bind (ec2 err2) (do-run new-pwd) + (if (and (not (eql 0 ec2)) (sudo-auth-failure-p err2)) + (editor-error "Authentication failed for /sudo:~@[~A@~]~A" + user host) + ec2)) + (error 'editor-abort))) + exit-code)))) ;;; Public API From 1691160e4d42175e5ad61be6cbd9fcda4eda4f88 Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 23 Jul 2026 01:35:16 +0800 Subject: [PATCH 13/23] tramp: re-prompt password when input wrong password for ssh --- extensions/tramp/tramp.lisp | 52 ++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 30 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index fb0664f72..19bdd3a9d 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -253,42 +253,34 @@ Exit code 5 = sshpass incorrect password." "Run an SSH command with automatic auth handling. Tries key auth first; on auth failure, clears cached password and retries. Signals editor-error if authentication ultimately fails." - (flet ((run-with-password (pwd) - (let ((args (build-ssh-args :ssh user host command :password pwd))) - (%ssh-run user host args)))) + (labels ((run-with-password (pwd) + (let ((args (build-ssh-args :ssh user host command :password pwd))) + (%ssh-run user host args))) + (run-with-retry (pwd) + (multiple-value-bind (ec out) (run-with-password pwd) + (if (ssh-auth-failure-p ec) + (let ((new-pwd (progn (clear-password :ssh user host) + (prompt-password :ssh user host)))) + (if new-pwd + (multiple-value-bind (ec2 out2) (run-with-password new-pwd) + (if (ssh-auth-failure-p ec2) + (editor-error "Authentication failed for /ssh:~@[~A@~]~A" + (or user "") host) + (values ec2 out2))) + (error 'editor-abort))) + (values ec out))))) (multiple-value-bind (password auth-tried) (ssh-ensure-auth :ssh user host) (if auth-tried - ;; Auth method known — run directly - (multiple-value-bind (exit-code stdout) (run-with-password password) - (if (ssh-auth-failure-p exit-code) - ;; Cached password is wrong — re-prompt and retry once - (let ((new-pwd (progn (clear-password :ssh user host) - (prompt-password :ssh user host)))) - (if new-pwd - (multiple-value-bind (ec2 out2) (run-with-password new-pwd) - (if (ssh-auth-failure-p ec2) - (editor-error "Authentication failed for /ssh:~@[~A@~]~A" - (or user "") host) - (values ec2 out2))) - (error 'editor-abort))) - (values exit-code stdout))) - ;; Auth method unknown — try key auth first - (multiple-value-bind (exit-code stdout) - (run-with-password nil) - (if (ssh-auth-failure-p exit-code) - ;; Auth failure → prompt password and retry + (run-with-retry password) + (multiple-value-bind (ec out) (run-with-password nil) + (if (ssh-auth-failure-p ec) (let ((pwd (ssh-remember-auth-failure user host))) (if pwd - (multiple-value-bind (ec2 out2) (run-with-password pwd) - (if (ssh-auth-failure-p ec2) - (editor-error "Authentication failed for /ssh:~@[~A@~]~A" - (or user "") host) - (values ec2 out2))) - (values exit-code stdout))) - ;; Key auth succeeded or command failed for other reasons + (run-with-retry pwd) + (values ec out))) (progn (ssh-remember-auth-success user host) - (values exit-code stdout)))))))) + (values ec out)))))))) ;;; Sudo command execution (pipe-based, no temp files) From d7af58762073f37b793144c97267266528d96b27 Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 23 Jul 2026 01:56:52 +0800 Subject: [PATCH 14/23] tramp: add comments for virtual file system hooks --- src/buffer/file-utils.lisp | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/src/buffer/file-utils.lisp b/src/buffer/file-utils.lisp index 95376a5cc..5f586e02b 100644 --- a/src/buffer/file-utils.lisp +++ b/src/buffer/file-utils.lisp @@ -163,6 +163,29 @@ (uiop:copy-file from to))))) (rec from to)))) +;;; ------------------------------------------------------------------ +;;; Virtual File System Hooks +;;; ------------------------------------------------------------------ +;;; +;;; These hook lists allow extensions (like lem-tramp) to intercept file +;;; operations for non-local paths (e.g. /ssh:host:/path or /sudo::/path). +;;; +;;; Each hook is a list of functions. When the core needs to operate on a +;;; file, it walks the corresponding list; each function checks whether it +;;; can handle the given path and either returns a result (short-circuiting +;;; the chain) or returns nil (passing to the next handler). If no handler +;;; matches, the operation falls through to the local filesystem. +;;; +;;; Handler contracts: +;;; file-open → (values stream closer) or nil +;;; probe-file → truename or nil +;;; directory-exists-p → directory path or nil +;;; directory-files → list of pathnames or nil +;;; file-metadata → integer (size / mtime / write-date) or nil +;;; expand-file-name → expanded path string or nil +;;; +;;; Example consumer: extensions/tramp/tramp.lisp + (defparameter *virtual-file-open* nil) (defparameter *virtual-probe-file-functions* nil From 90ef8f29279585b60f6d96eef3d0c712c2c1c590 Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 23 Jul 2026 06:53:39 +0800 Subject: [PATCH 15/23] tramp: replace unnessassry :: with : --- extensions/tramp/tramp.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 19bdd3a9d..b36a5144b 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -724,8 +724,8 @@ so we return a safe default (:utf-8 :lf) for remote files." ;; Override completion to handle TRAMP paths (unless *original-completion-function* (setf *original-completion-function* - lem-core::*prompt-file-completion-function*) - (setf lem-core::*prompt-file-completion-function* + lem-core:*prompt-file-completion-function*) + (setf lem-core:*prompt-file-completion-function* 'file-completion))) (defun disable () @@ -747,7 +747,7 @@ so we return a safe default (:utf-8 :lf) for remote files." *original-external-format-function*) (setf *original-external-format-function* nil)) (when *original-completion-function* - (setf lem-core::*prompt-file-completion-function* + (setf lem-core:*prompt-file-completion-function* *original-completion-function*) (setf *original-completion-function* nil))) From 2f568c479e902ca1c903594975bdd9a8d75137e2 Mon Sep 17 00:00:00 2001 From: steiner Date: Fri, 24 Jul 2026 21:12:51 +0800 Subject: [PATCH 16/23] file-utils: extract %call-virtual-handlers to DRY virtual hook dispatch Replace the repeated (or (loop :for f :in *hook* ...) fallback) pattern with a shared helper. Five functions converted, two left as-is (file-size has reader-conditional return-from, open-virtual-file returns multiple values). --- src/buffer/file-utils.lisp | 51 +++++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 23 deletions(-) diff --git a/src/buffer/file-utils.lisp b/src/buffer/file-utils.lisp index 5f586e02b..0f09bfdc8 100644 --- a/src/buffer/file-utils.lisp +++ b/src/buffer/file-utils.lisp @@ -57,11 +57,11 @@ (defun expand-file-name (filename &optional (directory (uiop:getcwd))) (when (pathnamep filename) (setf filename (namestring filename))) - (or (loop :for f :in *virtual-expand-file-name-functions* - :for result := (funcall f filename directory) - :when result :do (return result)) + (%call-virtual-handlers *virtual-expand-file-name-functions* + (list filename directory) + (lambda () (let ((pathname (parse-filename filename (pathname-directory directory)))) - (namestring (merge-pathnames pathname directory))))) + (namestring (merge-pathnames pathname directory)))))) (defun tail-of-pathname (pathname) (let ((pathname (uiop:ensure-absolute-pathname pathname #p"/"))) @@ -82,12 +82,12 @@ x2))))) (defun virtual-probe-file (pathspec &optional (base-dir pathspec)) - (or (loop :for f :in *virtual-probe-file-functions* - :for result := (funcall f pathspec base-dir) - :when result :do (return result)) + (%call-virtual-handlers *virtual-probe-file-functions* + (list pathspec base-dir) + (lambda () (cond ((ppcre:scan "^~/.*" (namestring base-dir)) (probe-file% pathspec)) - (t (probe-file pathspec))))) + (t (probe-file pathspec)))))) (defun sort-files (pathnames &key (key #'namestring) (test #'string<)) "Sort a list of pathnames." @@ -105,14 +105,14 @@ (sort-files files)))) (defun directory-files (pathspec) - (or (loop :for f :in *virtual-directory-files-functions* - :for result := (funcall f pathspec) - :when result :do (return result)) + (%call-virtual-handlers *virtual-directory-files-functions* + (list pathspec) + (lambda () (if (uiop:directory-pathname-p pathspec) (list (pathname pathspec)) (or (mapcar (lambda (x) (virtual-probe-file x pathspec)) (directory pathspec)) - (list pathspec))))) + (list pathspec)))))) (defun list-directory (directory &key directory-only (sort-method :pathname)) (delete nil @@ -139,13 +139,11 @@ (defun file-mtime (pathname) "Return the file's last data modification time." - (or (loop :for f :in *virtual-file-metadata-functions* - :for result := (funcall f pathname :mtime) - :when result :do (return result)) - #+sbcl - (sb-posix:stat-mtime (sb-posix:stat pathname)) - #-sbcl - (error "file-utils: file-mtime is not implemented for your implementation."))) + (%call-virtual-handlers *virtual-file-metadata-functions* + (list pathname :mtime) + (lambda () + #+sbcl (sb-posix:stat-mtime (sb-posix:stat pathname)) + #-sbcl (error "file-utils: file-mtime is not implemented for your implementation.")))) (defun copy-file-or-directory (from to) (let ((base-dir from)) @@ -213,12 +211,19 @@ and should return the value, or nil to pass to the next handler.") Each function receives (directory) and should return the directory if it exists, or nil to pass to the next handler.") +(defun %call-virtual-handlers (handlers args fallback-fn) + "Try each function in HANDLERS with ARGS. Return the first non-nil result. +If no handler matches, call FALLBACK-FN." + (or (loop :for f :in handlers + :for result := (apply f args) + :when result :do (return result)) + (funcall fallback-fn))) + (defun virtual-directory-exists-p (directory) "Check if a directory exists, using virtual filesystem hooks if applicable." - (or (loop :for f :in *virtual-directory-exists-p-functions* - :for result := (funcall f directory) - :when result :do (return result)) - (uiop:directory-exists-p directory))) + (%call-virtual-handlers *virtual-directory-exists-p-functions* + (list directory) + (lambda () (uiop:directory-exists-p directory)))) (defun open-virtual-file (filename &key external-format direction element-type) (apply #'values From 93d85888a01579ddfef58856238f2ee92d686e46 Mon Sep 17 00:00:00 2001 From: steiner Date: Sat, 25 Jul 2026 07:24:13 +0800 Subject: [PATCH 17/23] tramp: replace probe-file with exist-program-p --- extensions/tramp/tramp.lisp | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index b36a5144b..4fd04b232 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -123,13 +123,7 @@ values are cons of (timestamp . result).") (defun sshpass-available-p () "Check if the sshpass utility is available on the system." - (or (eql 0 (nth-value 2 - (uiop:run-program '("which" "sshpass") - :output nil - :error-output nil - :ignore-error-status t))) - (probe-file "/usr/bin/sshpass") - (probe-file "/usr/local/bin/sshpass"))) + (exist-program-p "sshpass")) (defun ssh-ensure-auth (method user host) "Get cached auth state for SSH connection. From d5d04d8e604a1063a2003e2c0626c8c50f17070a Mon Sep 17 00:00:00 2001 From: steiner Date: Sat, 25 Jul 2026 07:30:58 +0800 Subject: [PATCH 18/23] tramp: split ssh-ensure-auth into smaller parts --- extensions/tramp/tramp.lisp | 57 +++++++++++++++++++++---------------- 1 file changed, 33 insertions(+), 24 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 4fd04b232..29a07a1bc 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -125,6 +125,28 @@ values are cons of (timestamp . result).") "Check if the sshpass utility is available on the system." (exist-program-p "sshpass")) +(defun ssh-conn-key (user host) + "Make a cache key string for SSH auth state." + (format nil "~A@~A" (or user "") host)) + +(defun ssh-auth-method (user host) + "Return the known SSH auth method for USER@HOST: :key, :password, or nil." + (gethash (ssh-conn-key user host) *ssh-auth-method-cache*)) + +(defun (setf ssh-auth-method) (value user host) + "Set the known SSH auth method for USER@HOST." + (setf (gethash (ssh-conn-key user host) *ssh-auth-method-cache*) value)) + +(defun ssh-prompt-or-error (user host) + "Prompt for SSH password; signal editor-error if sshpass is unavailable. +Returns (values password t)." + (if (sshpass-available-p) + (let ((pwd (prompt-password :ssh user host))) + (values pwd t)) + (editor-error + "SSH key auth failed for ~A@~A. Install sshpass for password auth." + (or user "") host))) + (defun ssh-ensure-auth (method user host) "Get cached auth state for SSH connection. Returns (values password auth-tried-p): @@ -132,37 +154,24 @@ Returns (values password auth-tried-p): - key auth known to work → (values nil t) - unknown → (values nil nil) — caller should try BatchMode first" (declare (ignore method)) - (let ((conn-key (format nil "~A@~A" (or user "") host))) - (or (let ((pwd (get-password :ssh user host))) - (when pwd (return-from ssh-ensure-auth (values pwd t)))) - (let ((auth-method (gethash conn-key *ssh-auth-method-cache*))) - (ecase auth-method - ((nil) (values nil nil)) ;; unknown — try key first - (:key (values nil t)) ;; key works, no password needed - (:password ;; need password - (if (sshpass-available-p) - (let ((pwd (prompt-password :ssh user host))) - (values pwd t)) - (editor-error - "SSH key auth failed for ~A@~A. Install sshpass for password auth." - (or user "") host)))))))) + (let ((pwd (get-password :ssh user host))) + (when pwd + (return-from ssh-ensure-auth (values pwd t)))) + (ecase (ssh-auth-method user host) + ((nil) (values nil nil)) + (:key (values nil t)) + (:password (ssh-prompt-or-error user host)))) (defun ssh-remember-auth-failure (user host) "Called when a BatchMode SSH command fails (exit 255). Marks connection as needing password and prompts." - (let ((conn-key (format nil "~A@~A" (or user "") host))) - (setf (gethash conn-key *ssh-auth-method-cache*) :password) - (clear-password :ssh user host) - (if (sshpass-available-p) - (prompt-password :ssh user host) - (editor-error - "SSH key auth failed for ~A@~A. Install sshpass for password auth." - (or user "") host)))) + (setf (ssh-auth-method user host) :password) + (clear-password :ssh user host) + (ssh-prompt-or-error user host)) (defun ssh-remember-auth-success (user host) "Called when a BatchMode SSH command succeeds. Marks key auth as working." - (let ((conn-key (format nil "~A@~A" (or user "") host))) - (setf (gethash conn-key *ssh-auth-method-cache*) :key))) + (setf (ssh-auth-method user host) :key)) (defun ensure-password (method user host) "Get cached password or prompt the user. For :ssh returns nil From df6368a6533b65d2b30bbb328fe8fefa762b076a Mon Sep 17 00:00:00 2001 From: steiner Date: Sat, 25 Jul 2026 08:47:59 +0800 Subject: [PATCH 19/23] tramp: simplify file-completion --- extensions/tramp/tramp.lisp | 49 ++++++++++++++++++++----------------- 1 file changed, 27 insertions(+), 22 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 29a07a1bc..c45916c99 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -660,31 +660,36 @@ directory-files directly for the TRAMP directory listing." (let* ((expanded (expand-file-name string directory)) (input-dir (directory-namestring expanded))) (if (path-p input-dir) - (let* ((files (directory-files input-dir)) - ;; Partial filename the user is typing (after the last "/") - (partial (enough-namestring expanded input-dir))) - (when files - (let ((filtered - (if (and partial (not (string= partial ""))) - (remove-if-not - (lambda (f) - (let ((name (enough-namestring (namestring f) input-dir))) - (and name - (> (length name) 0) - (eql 0 (search (string-downcase partial) - (string-downcase name)))))) - files) - files))) - (unless filtered - (return-from file-completion nil)) - (mapcar (lambda (f) - (let ((label (enough-namestring (namestring f) input-dir))) - (lem/completion-mode:make-completion-item - :label (or label (namestring f))))) - filtered)))) + (virtual-path-completions expanded input-dir) (funcall *original-completion-function* string directory :directory-only directory-only)))) +(defun virtual-path-completions (expanded input-dir) + "Return completion items for a virtual-path directory listing. +EXPANDED is the full user input path, INPUT-DIR is its directory part." + (let* ((files (directory-files input-dir)) + (partial (enough-namestring expanded input-dir))) + (when files + (mapcar (lambda (f) + (let ((label (enough-namestring (namestring f) input-dir))) + (lem/completion-mode:make-completion-item + :label (or label (namestring f))))) + (filter-by-filename-prefix files input-dir partial))))) + +(defun filter-by-filename-prefix (files input-dir partial) + "Filter FILES to those whose basename starts with PARTIAL (case-insensitive). +If PARTIAL is nil or empty, return FILES unchanged." + (if (and partial (string/= partial "")) + (remove-if-not + (lambda (f) + (let ((name (enough-namestring (namestring f) input-dir))) + (and name + (> (length name) 0) + (eql 0 (search (string-downcase partial) + (string-downcase name)))))) + files) + files)) + ;;; ------------------------------------------------------------------ ;;; External Format Detection Override ;;; ------------------------------------------------------------------ From c57d2998363c738b4dac49519d872af76494ed87 Mon Sep 17 00:00:00 2001 From: steiner Date: Sun, 26 Jul 2026 22:03:23 +0800 Subject: [PATCH 20/23] tramp: fix file completion replacing entire TRAMP path The prompt buffer's syntax table treats /, :, @ as symbol chars. When virtual-path-completions didn't set :start/:end on completion items, completion-item-range fell back to skip-chars-backward which skipped the entire TRAMP path (all chars are symbol-constituents), replacing it with just the filename label. Fix: - virtual-path-completions now sets :start (after last /) and :end (cursor position) on each completion item, matching the pattern used by prompt-file-completion. Only the filename component is replaced, preserving the TRAMP prefix. - Added virtual-directory-namestring for reliable directory extraction from TRAMP paths, since SBCL's directory-namestring misparses paths like /ssh:host: (treating the host segment as a filename in /). - Check path-p on expanded instead of input-dir to correctly detect TRAMP paths even when directory extraction fails on edge cases. --- extensions/tramp/tramp.lisp | 42 ++++++++++++++++++++++++++++++++----- 1 file changed, 37 insertions(+), 5 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index c45916c99..ba43387a4 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -658,22 +658,54 @@ Bypasses list-directory (no virtual hooks) by calling directory-files directly for the TRAMP directory listing." (declare (ignore directory-only)) (let* ((expanded (expand-file-name string directory)) - (input-dir (directory-namestring expanded))) - (if (path-p input-dir) + (input-dir (virtual-directory-namestring expanded))) + (if (path-p expanded) (virtual-path-completions expanded input-dir) (funcall *original-completion-function* string directory :directory-only directory-only)))) +(defun virtual-directory-namestring (path) + "Return the directory part of a TRAMP path for completion purposes. +Uses string-based extraction because directory-namestring doesn't parse +TRAMP paths (like /ssh:host:) correctly on SBCL — the initial /method: +segment can be misinterpreted as a host component." + (if (path-p path) + ;; String-based extraction: everything up to and including the last / + (let ((pos (position #\/ path :from-end t))) + (if (and pos (> pos 0)) + ;; Normal case: /ssh:host:/home/user/pa → /ssh:host:/home/user/ + (subseq path 0 (1+ pos)) + ;; Bare /ssh:host: (no remote path yet) — ensure trailing / + (if (char= (char path (1- (length path))) #\/) + path + (concatenate 'string path "/")))) + (directory-namestring path))) + (defun virtual-path-completions (expanded input-dir) "Return completion items for a virtual-path directory listing. -EXPANDED is the full user input path, INPUT-DIR is its directory part." +EXPANDED is the full user input path, INPUT-DIR is its directory part. +Sets :start and :end on completion items so that only the filename +component (after the last /) is replaced. Without this, the prompt buffer's +syntax table (which treats /, :, @ as symbol chars) causes +`skip-chars-backward' to consume the entire TRAMP path." (let* ((files (directory-files input-dir)) (partial (enough-namestring expanded input-dir))) (when files (mapcar (lambda (f) (let ((label (enough-namestring (namestring f) input-dir))) - (lem/completion-mode:make-completion-item - :label (or label (namestring f))))) + (with-point ((s (lem/prompt-window::current-prompt-start-point)) + (e (lem/prompt-window::current-prompt-start-point))) + ;; Move to cursor position, then find the filename start + ;; (character after last /), same as prompt-file-completion. + (line-end s) + (unless (search-backward s "/") + (line-start s)) + (character-offset s 1) + (line-end e) + (lem/completion-mode:make-completion-item + :label (or label (namestring f)) + :start s + :end e)))) (filter-by-filename-prefix files input-dir partial))))) (defun filter-by-filename-prefix (files input-dir partial) From 3c8b87a07749c71a5ccf547c846873d182b97900 Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 30 Jul 2026 12:11:34 +0800 Subject: [PATCH 21/23] tramp: fix password leaking into file content on sudo writes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The write path (%make-ssh-input-stream) wrote the sudo password and file content through the same stdin pipe. 'sudo -S' should consume the first line as the password, leaving the rest for 'cat > file', but due to stdio buffering the password ended up in the saved file. This was masked by a read-path workaround in %read-remote-file that stripped the password from stdout — so Lem's buffer showed clean content while the password sat on disk at the top of the file. Fix: pre-authenticate sudo with a one-shot 'sudo -S true' process whose stdin is closed immediately after the password. The actual write command then uses 'sudo -n', so its stdin carries only file content — no password ever touches that pipe. --- extensions/tramp/tramp.lisp | 112 ++++++++++++++++++++++++++---------- 1 file changed, 82 insertions(+), 30 deletions(-) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index ba43387a4..16bcf5243 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -225,8 +225,9 @@ Marks connection as needing password and prompts." cmd-args)))) (:sudo (let ((args (list "sudo"))) - (when use-sudo-s - (push "-S" (cdr args))) + (if use-sudo-s + (push "-S" (cdr args)) ;; read password from stdin + (push "-n" (cdr args))) ;; non-interactive (pre-authed or passwordless) (when user (setf args (append args (list "-u" user)))) (append args (uiop:ensure-list command)))))) @@ -294,6 +295,41 @@ Signals editor-error if authentication ultimately fails." (search "try again" stderr :test #'char-equal) (search "Sorry" stderr :test #'char-equal)))) +(defun %sudo-auth-once (user host password) + "Pre-authenticate sudo with PASSWORD via a one-shot 'sudo -S true' call. +Stdin is closed right after the password — no data can leak to subsequent +commands. After this call succeeds, 'sudo -n' will work for the duration +of the sudo timestamp (typically 5–15 minutes). + +Returns T on success. Returns NIL on authentication failure (caller should +re-prompt and retry)." + (let* ((args `("sudo" "-S" "-p" "" + ,@(when user (list "-u" user)) + "true")) + (process (uiop:launch-program args + :output nil + :input :stream + :error-output :stream + :ignore-error-status t))) + (unwind-protect + (let ((in (uiop:process-info-input process)) + (err (uiop:process-info-error-output process))) + (write-line password in) + (finish-output in) + (close in) + (let* ((stderr-str + (with-output-to-string (s) + (loop :for line := (read-line err nil nil) + :while line + :do (write-line line s)))) + (exit-code (uiop:wait-process process))) + (if (sudo-auth-failure-p stderr-str) + (progn + (clear-password :sudo user host) + nil) + (eql 0 exit-code)))) + (ignore-errors (close (uiop:process-info-error-output process)))))) + (defun %sudo-run (user host args password) "Run a sudo command via pipe. Returns (values exit-code stdout-string). On authentication failure, re-prompts for password and retries once." @@ -429,8 +465,9 @@ On authentication failure, re-prompts for password and retries once." (%sudo-run user host args password) (unless (eql 0 exit-code) (editor-error "Failed to read remote file ~A (exit ~D)" path exit-code)) - ;; Guard: strip password if it leaked into stdout due to - ;; a lem-webview prompt overlay cleanup race. + ;; Defense-in-depth: strip password if it somehow leaked into + ;; stdout (e.g. from an older write-path bug or a + ;; lem-webview prompt overlay cleanup race). (when (and password (plusp (length password))) (when (str:starts-with-p password stdout) (setf stdout (subseq stdout (length password))) @@ -451,38 +488,53 @@ On authentication failure, re-prompts for password and retries once." (declare (ignore s))))))) (defun %make-ssh-input-stream (method user host path) - "Create a stream for writing a remote file via SSH/sudo." + "Create a stream for writing a remote file via SSH/sudo. +For :sudo, pre-authenticates with a one-shot 'sudo -S true' call so the +actual write command (sudo -n) never sees the password on its stdin — +only file content flows through the pipe." (let* ((cmd (ecase method (:ssh (list "/bin/sh" "-c" (format nil "cat > ~A" (escape-shell-arg path)))) (:sudo (list "/bin/sh" "-c" (format nil "cat > ~A" (escape-shell-arg path)))))) - (use-sudo-s (eq method :sudo)) (password (or (get-password method user host) - (ensure-password method user host))) - (args (build-ssh-args method user host cmd - :use-sudo-s use-sudo-s - :password (when (eq method :ssh) password)))) - (handler-case - (let* ((process (uiop:launch-program args - :output nil - :input :stream - :error-output :stream - :ignore-error-status t)) - (stream (uiop:process-info-input process))) - (when (and password (eq method :sudo)) - (write-line password stream) - (finish-output stream)) - (values stream - (lambda (s) - (finish-output s) - (ignore-errors (close s)) - (ignore-errors (uiop:wait-process process))))) - (editor-error (e) - (error e)) - (error (e) - (clear-password method user host) - (editor-error "Failed to write remote file ~A: ~A" path e))))) + (ensure-password method user host)))) + ;; For sudo: pre-authenticate so the write process stdin carries + ;; ONLY file content. The password goes to a throwaway 'sudo -S true' + ;; process whose stdin is closed before we even spawn the write command. + (when (and password (eq method :sudo)) + (unless (%sudo-auth-once user host password) + ;; Auth failed — re-prompt and retry once + (let ((new-pwd (progn (clear-password :sudo user host) + (prompt-password :sudo user host)))) + (if new-pwd + (if (%sudo-auth-once user host new-pwd) + (setf password new-pwd) + (editor-error "sudo authentication failed")) + (error 'editor-abort))))) + (let* ((args (build-ssh-args method user host cmd + ;; sudo -n: pre-authed, no password on stdin + :use-sudo-s nil + :password (when (eq method :ssh) password)))) + (handler-case + (let* ((process (uiop:launch-program args + :output nil + :input :stream + :error-output :stream + :ignore-error-status t)) + (stream (uiop:process-info-input process))) + ;; IMPORTANT: NO password is written to this stream. + ;; The sudo session was established by %sudo-auth-once above. + (values stream + (lambda (s) + (finish-output s) + (ignore-errors (close s)) + (ignore-errors (uiop:wait-process process))))) + (editor-error (e) + (error e)) + (error (e) + (clear-password method user host) + (editor-error "Failed to write remote file ~A: ~A" path e)))))) (defun escape-shell-arg (arg) "Escape ARG for safe use in a shell command (single-quote escaping)." From 7d24c254a0c832dffc4c78c5397247f6c03da7d8 Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 30 Jul 2026 19:46:57 +0800 Subject: [PATCH 22/23] tramp: implement TRAMP-aware terminal support --- extensions/terminal/ffi.lisp | 12 ++++-- extensions/terminal/terminal-mode.lisp | 54 ++++++++++++++++++++++---- extensions/terminal/terminal.lisp | 8 +++- extensions/tramp/tramp.lisp | 44 ++++++++++++++++++++- 4 files changed, 105 insertions(+), 13 deletions(-) diff --git a/extensions/terminal/ffi.lisp b/extensions/terminal/ffi.lisp index 06a7df697..749ce0169 100644 --- a/extensions/terminal/ffi.lisp +++ b/extensions/terminal/ffi.lisp @@ -93,13 +93,19 @@ (cb_sb_pushline :pointer) (cb_sb_popline :pointer)) -(defun terminal-new (directory id rows cols) +(defun terminal-new (directory id rows cols &key program argv) + "Create a new terminal PTY running PROGRAM with ARGV. +When PROGRAM/ARGV are not provided, defaults to the user's shell started +in DIRECTORY (via 'cd ; ')." (let* ((shell (or (uiop:getenv "SHELL") "/bin/bash")) - (argv (list shell "-c" (concatenate 'string "cd " directory "; " shell)))) + (program (or program shell)) + (argv (or argv + (list shell "-c" + (concatenate 'string "cd " directory "; " shell))))) (%terminal-new id rows cols - shell + program argv (cffi:callback cb-damage) (cffi:callback cb-moverect) diff --git a/extensions/terminal/terminal-mode.lisp b/extensions/terminal/terminal-mode.lisp index 664c295b7..ecdd853f9 100644 --- a/extensions/terminal/terminal-mode.lisp +++ b/extensions/terminal/terminal-mode.lisp @@ -26,6 +26,16 @@ lem-core:: lem/frame-multiplexer:frame-multiplexer-advice)) +(defun %remote-terminal-command (path) + "If PATH is a TRAMP-style remote path, return (values program argv) for +launching a terminal on the remote host. Returns nil for non-TRAMP paths. +Looks up lem-tramp:tramp-terminal-command at runtime so no compile-time +dependency on the TRAMP extension is needed." + (let* ((pkg (find-package :lem-tramp)) + (fn (and pkg (find-symbol "TRAMP-TERMINAL-COMMAND" pkg)))) + (when fn + (funcall (symbol-function fn) path)))) + (define-major-mode terminal-mode () (:name "Terminal" :keymap *terminal-mode-keymap*) @@ -81,14 +91,44 @@ (resize-terminal (buffer-terminal buffer) window) (setf (current-window) window))) +(defun create-terminal-with-command (program argv &key (name "*Terminal*")) + "Create a terminal buffer running PROGRAM with ARGV (a list of strings). +Unlike `create-terminal', this launches an arbitrary command instead of the +user's shell started in a directory." + (declare (type (string) program)) + (let* ((buffer (make-buffer (unique-buffer-name name) :enable-undo-p nil)) + (terminal (terminal:create :cols 80 :rows 24 :buffer buffer + :directory "" + :program program :argv argv))) + (setf (buffer-terminal buffer) terminal) + (change-buffer-mode buffer 'terminal-mode) + (let ((window (pop-to-buffer buffer))) + (resize-terminal (buffer-terminal buffer) window) + (setf (current-window) window)))) + (define-command terminal (always-create-terminal-p) (:universal-nil) - (labels ((new-terminal () - (create-terminal (buffer-directory (current-buffer))))) - (if always-create-terminal-p - (new-terminal) - (alexandria:if-let (buffer (terminal:find-terminal-buffer)) - (setf (current-window) (pop-to-buffer buffer)) - (new-terminal))))) + "Open a terminal buffer. When the current buffer visits a TRAMP path +\(e.g. /sudo::/etc or /ssh:user@host:/var/log), the terminal is opened +on the remote host with appropriate privileges. + +With a universal argument, always create a new terminal buffer." + (let* ((buf (current-buffer)) + ;; Check both buffer-filename (file buffers) and buffer-directory + ;; (directory-mode buffers) for a potential TRAMP path. + (path (or (buffer-filename buf) (buffer-directory buf)))) + (multiple-value-bind (program argv) + (%remote-terminal-command path) + (cond + ;; TRAMP/remote path: always create a dedicated terminal + ((and program argv) + (create-terminal-with-command program argv)) + ;; Local: reuse or create + (always-create-terminal-p + (create-terminal (buffer-directory buf))) + (t + (alexandria:if-let (buffer (terminal:find-terminal-buffer)) + (setf (current-window) (pop-to-buffer buffer)) + (create-terminal (buffer-directory buf)))))))) (defun get-current-terminal () (buffer-terminal (current-buffer))) diff --git a/extensions/terminal/terminal.lisp b/extensions/terminal/terminal.lisp index eea08f5dc..4afd9b083 100644 --- a/extensions/terminal/terminal.lisp +++ b/extensions/terminal/terminal.lisp @@ -240,7 +240,9 @@ point is kept for manual/REPL use and tests." (defun create (&key (rows (alexandria:required-argument :rows)) (cols (alexandria:required-argument :cols)) (buffer (alexandria:required-argument :buffer)) - (directory (alexandria:required-argument :directory))) + (directory (alexandria:required-argument :directory)) + (program nil) + (argv nil)) (declare (type (string) directory) (type (integer) rows) (type (integer) cols)) @@ -248,7 +250,9 @@ point is kept for manual/REPL use and tests." (terminal (make-instance 'terminal :id id - :viscus (ffi::terminal-new directory id rows cols) + :viscus (ffi::terminal-new directory id rows cols + :program program + :argv argv) :buffer buffer :rows rows :cols cols))) diff --git a/extensions/tramp/tramp.lisp b/extensions/tramp/tramp.lisp index 16bcf5243..5cf8be6a8 100644 --- a/extensions/tramp/tramp.lisp +++ b/extensions/tramp/tramp.lisp @@ -1,5 +1,10 @@ (defpackage :lem-tramp - (:use :cl :lem)) + (:use :cl :lem) + (:export :tramp-terminal-command + :path-p + :parse-path + :enable + :disable)) (in-package :lem-tramp) (setf (documentation *package* t) @@ -541,6 +546,43 @@ only file content flows through the pipe." (let ((escaped (ppcre:regex-replace-all "'" arg "'\\''"))) (concatenate 'string "'" escaped "'"))) +;;; ------------------------------------------------------------------ +;;; Terminal Integration +;;; ------------------------------------------------------------------ + +(defun tramp-terminal-command (filename) + "Given a TRAMP FILENAME, return (values program argv) for launching a +terminal in that file's remote directory. Returns nil if FILENAME is +not a TRAMP path. + +The caller should pass the returned values to terminal:create via +:program and :argv keyword arguments." + (when (path-p filename) + (multiple-value-bind (method user host remote-path) (parse-path filename) + (let ((dir (escape-shell-arg (directory-namestring remote-path)))) + (ecase method + (:sudo + (let* ((shell (or (uiop:getenv "SHELL") "/bin/bash")) + (shell-cmd (format nil "cd ~A; exec ~A" dir shell)) + (argv `("sudo" + ,@(when user (list "-u" user)) + ,shell + "-c" ,shell-cmd))) + (values (first argv) argv))) + (:ssh + (let* ((target (if user (format nil "~A@~A" user host) host)) + ;; $SHELL is literal in the Lisp string — it passes + ;; untouched through execvp→ssh→sshd and is expanded + ;; by the remote shell. ${SHELL:-/bin/sh} ensures + ;; a working fallback on hosts where $SHELL is unset. + (shell-cmd (format nil "cd ~A; exec ${SHELL:-/bin/sh}" dir)) + (argv `("ssh" "-t" + "-o" "StrictHostKeyChecking=accept-new" + "-o" "ConnectTimeout=3" + ,target + ,shell-cmd))) + (values (first argv) argv)))))))) + ;;; ------------------------------------------------------------------ ;;; Virtual File Open Handler ;;; ------------------------------------------------------------------ From 5553b87562c9341e989066be03f21e8793143439 Mon Sep 17 00:00:00 2001 From: steiner Date: Thu, 30 Jul 2026 19:52:57 +0800 Subject: [PATCH 23/23] tramp: update README --- extensions/tramp/README.md | 23 +++++++++++++++++++---- 1 file changed, 19 insertions(+), 4 deletions(-) diff --git a/extensions/tramp/README.md b/extensions/tramp/README.md index c1ae3b5bd..53811ddc9 100644 --- a/extensions/tramp/README.md +++ b/extensions/tramp/README.md @@ -6,10 +6,10 @@ into `C-x C-f` and edit the file as if it were local. ## Supported Methods -| Method | Syntax | Description | -|--------|--------|-------------| -| `ssh` | `/ssh:user@host:/remote/path` | Edit files on a remote host via SSH | -| `sudo` | `/sudo::/local/path` | Edit local files with root privileges via sudo | +| Method | Syntax | Description | +|:----------:|-----------------------------------|----------------------------------------------------------| +| `ssh` | `/ssh:user@host:/remote/path` | Edit files on a remote host via SSH | +| `sudo` | `/sudo::/local/path` | Edit local files with root privileges via sudo | ## Usage @@ -66,6 +66,21 @@ No temporary files are created on either the local or remote side. - **sshpass** — only needed for SSH password authentication - **flexi-streams**, **str**, **babel**, **ppcre** — Common Lisp libraries +## Terminal Integration + +When a buffer is visiting a TRAMP path, `M-x terminal` opens a terminal +in the remote file's directory on the appropriate host: + +| Buffer path | Terminal command | +|--------------------------------------|--------------------------------------------------------------------------------| +| `/sudo::/etc/nginx/` | `sudo bash -c "cd /etc/nginx; exec bash"` | +| `/sudo:root::/var/log/` | `sudo -u root bash -c "cd /var/log; exec bash"` | +| `/ssh:user@host:/var/log/` | `ssh -t user@host "cd /var/log; exec ${SHELL:-/bin/sh}"` | + +Authentication happens interactively inside the terminal PTY — sudo and +ssh prompt for passwords naturally, without involving TRAMP's password +management. Key-based SSH auth works transparently. + ## Performance SSH connections use `ControlMaster` multiplexing — the first command