322 lines
15 KiB
EmacsLisp
322 lines
15 KiB
EmacsLisp
;;; eshell-detach.el
|
||
|
||
;; Instead of sending the command prompt to Eshell, send it to a bash shell run in a dtach session.
|
||
;; dtach allows the user to disconnect (quit Eshell or even Emacs) while the command keeps going.
|
||
;; Stderr and stdout can be both displayed on screen and redirected to a file thanks to the `tee' program.
|
||
;;
|
||
;; dtach allows the command line processor (that is, Bash) to run in the background.
|
||
;; Bash allows for:
|
||
;; - using `tee' to separate stdout/stderr, output both in files and on screen;
|
||
;; - executing pipe lines (e.g. grep foo | sed ... | cut | wc). dtach cannot do that alone.
|
||
;;
|
||
;; Bash is necessary here. If we want to run Eshell within dtach, we would need
|
||
;; to run Emacs in --batch mode:
|
||
;;
|
||
;; emacs --batch --eval '(progn (eshell) (insert "echo hello") (eshell-send-input))'
|
||
;;
|
||
;; Issues: Eshell mixes stdout and stderr. (--batch sends to stderr.) How do we redirect the output to the real stdout/stderr?
|
||
|
||
;; TODO: Support Eshell nonetheless?
|
||
;; TODO: Move eshell to a lower level of abstraction. This package should be called "detach.el".
|
||
;; TODO: Remove bash / tee / dtach dependencies? I don't think dtach can be removed.
|
||
|
||
;;; See if `make-process' is the way to go: it supports stderr/stdout separation and stop/cont.
|
||
;;; Re-use `eshell-gather-process-output'? Re-implement?
|
||
|
||
;; TODO: Add list of regexp matches for which detach should automatically be used.
|
||
|
||
(defvar eshell-detach-program "dtach"
|
||
"The `dtach' program.")
|
||
|
||
(defvar eshell-detach-redraw-method nil
|
||
"If nil, use the default value.
|
||
Value must be a string.
|
||
See dtach(1) for possible values.")
|
||
|
||
(defvar eshell-detach-shell "bash"
|
||
"Shell to run the command in.
|
||
Should be bash-compatible.
|
||
The end command will be
|
||
|
||
\"`eshell-detach-shell' -c { { <command>; } > >(tee stdout) } 2> >(tee stderr) | tee stdout+stderr\"")
|
||
|
||
;; TODO: Set the detach character? No need when `C-c C-c` suffices.
|
||
;; (defvar eshell-detach-detach-character "^\\"
|
||
;; "Charcter to press to detach dtach, i.e. leave the process run in the background.
|
||
;; The character syntax follows terminal notations, not Emacs.")
|
||
;;
|
||
;; (defvar eshell-detach-detach-character-binding "C-\\"
|
||
;; "The Emacs binding matching `eshell-detach-detach-character'.")
|
||
|
||
(defvar eshell-detach-socket-ext ".socket"
|
||
"The file name extension for the socket fo `eshell-detach-program'.")
|
||
|
||
(defvar eshell-detach-stdout-ext ".stdout"
|
||
"If non-nil and a string, stdout will also be saved to file named after the socket with this extension appened.
|
||
The 'tee' program is required.")
|
||
|
||
(defvar eshell-detach-stderr-ext ".stderr"
|
||
"If non-nil and a string, stderr will also be saved to file named after the socket with this extension appened.
|
||
The 'tee' program is required.")
|
||
|
||
(defvar eshell-detach-stdout+stderr-ext ".stdout+stderr"
|
||
"If non-nil and a string, stdout and stderr will also be saved to file named after the socket with this extension appened.
|
||
The 'tee' program is required.")
|
||
|
||
;; TODO: Turn into a defcustom, and offer `user-emacs-directory' as well.
|
||
(defvar eshell-detach-directory (if server-socket-dir server-socket-dir temporary-file-directory)
|
||
"The directory where to store the dtach socket and the logs.")
|
||
|
||
(defvar eshell-detach-file-pattern-function 'eshell-detach-default-file-pattern
|
||
"Function that takes the commandline as argument and returns
|
||
the name of all the dtach-related files (output and socket).")
|
||
|
||
(defun eshell-detach-default-file-pattern (commandline)
|
||
"Create a pattern made of the alphanumerical translation of the commandline.
|
||
Characters that don't fit are replaced with '_'.
|
||
An ISO date string is appended.
|
||
|
||
Suitable for `eshell-detach-file-pattern-function'."
|
||
(format "-%s-%s-"
|
||
(replace-regexp-in-string "[^A-Za-z0-9=-]" "_" commandline)
|
||
(format-time-string "%F-%R:%S")))
|
||
|
||
;; `eshell-named-command-hook' is not the way to go as it won't take pipelines. What about
|
||
;; `eshell-rewrite-command-hook'?
|
||
(defun eshell-detach-rewrite-input (input)
|
||
"Rewrite INPUT so that it is ready for detaching."
|
||
;; Since sockets get killed on termination, there won't be any leftover if
|
||
;; there is no log. Thus it is cleaner to _not_ create a sub-directory.
|
||
;; `tee' creates log files even if nothing is output. We cleanup on exit by
|
||
;; deleting 0-byte files.
|
||
(let* (
|
||
;; TODO: temp-file should not exist for dtach to start? That forces us
|
||
;; to use make-temp-file which is vulnerable to race condition.
|
||
;; TODO: Read `input' safely. E.g. from a file.
|
||
(socket (make-temp-name
|
||
(expand-file-name
|
||
(concat "dtach" (funcall eshell-detach-file-pattern-function input))
|
||
eshell-detach-directory)))
|
||
(stdout (and eshell-detach-stdout-ext (concat socket eshell-detach-stdout-ext)))
|
||
(stderr (and eshell-detach-stderr-ext (concat socket eshell-detach-stderr-ext)))
|
||
(stdout+stderr (and eshell-detach-stdout+stderr-ext (concat socket eshell-detach-stdout+stderr-ext)))
|
||
(socket (concat socket eshell-detach-socket-ext))
|
||
;; The following bash command was inspired by
|
||
;; https://stackoverflow.com/questions/21465297/tee-stdout-and-stderr-to-separate-files-while-retaining-them-on-their-respective.
|
||
;;
|
||
;; { { echo stdout; echo stderr >&2; } > >(tee stdout.txt ); } 2> >(tee stderr.txt ) | tee stdout+stderr.txt
|
||
(commandline (format "{ { %s; }%s }%s %s; for i in %s %s %s; do [ ! -s \"$i\" ] && rm -- \"$i\"; done"
|
||
input
|
||
;; TODO: Move `tee' to a defvar.
|
||
(if stdout (format " > >(tee %s );" stdout) "")
|
||
(if stderr (format " 2> >(tee %s )" stderr) "")
|
||
(if stdout+stderr (format " | tee %s" stdout+stderr) "")
|
||
(shell-quote-argument (or stdout ""))
|
||
(shell-quote-argument (or stderr ""))
|
||
(shell-quote-argument (or stdout+stderr "")))))
|
||
(format "%s -c %s -z %s -c %s" eshell-detach-program socket eshell-detach-shell (shell-quote-argument commandline))))
|
||
|
||
(defun eshell-detach--list-sockets ()
|
||
"List sockets of `eshell-detach-program'."
|
||
(file-expand-wildcards (concat
|
||
(expand-file-name "dtach-"
|
||
eshell-detach-directory)
|
||
"*" eshell-detach-socket-ext)))
|
||
|
||
(defun eshell-detach-attach ()
|
||
"Attach to a running session of `eshell-detach-program'."
|
||
(interactive)
|
||
(let ((socket (completing-read "Attach to session: " (eshell-detach--list-sockets) nil t)))
|
||
(when socket
|
||
(when (or (eshell-interactive-process)
|
||
(/= (point) eshell-last-output-end))
|
||
(eshell-interrupt-process))
|
||
(goto-char (point-max))
|
||
;; TODO: Redraw method?
|
||
(insert eshell-detach-program " -a " (shell-quote-argument socket))
|
||
(eshell-send-input))))
|
||
|
||
;;; This is almost an exact copy of `eshell-send-input'.
|
||
(defun eshell-detach-send-input (&optional use-region queue-p no-newline)
|
||
"Send the input received to Eshell for parsing and processing.
|
||
After `eshell-last-output-end', sends all text from that marker to
|
||
point as input. Before that marker, calls `eshell-get-old-input' to
|
||
retrieve old input, copies it to the end of the buffer, and sends it.
|
||
|
||
If USE-REGION is non-nil, the current region (between point and mark)
|
||
will be used as input.
|
||
|
||
If QUEUE-P is non-nil, input will be queued until the next prompt,
|
||
rather than sent to the currently active process. If no process, the
|
||
input is processed immediately.
|
||
|
||
If NO-NEWLINE is non-nil, the input is sent without an implied final
|
||
newline."
|
||
(interactive "P")
|
||
;; Note that the input string does not include its terminal newline.
|
||
(let ((proc-running-p (and (eshell-interactive-process)
|
||
(not queue-p)))
|
||
(inhibit-point-motion-hooks t)
|
||
(inhibit-modification-hooks t))
|
||
(unless (and proc-running-p
|
||
(not (eq (process-status
|
||
(eshell-interactive-process))
|
||
'run)))
|
||
(if (or proc-running-p
|
||
(>= (point) eshell-last-output-end))
|
||
(goto-char (point-max))
|
||
(let ((copy (eshell-get-old-input use-region)))
|
||
(goto-char eshell-last-output-end)
|
||
(insert-and-inherit copy)))
|
||
(unless (or no-newline
|
||
(and eshell-send-direct-to-subprocesses
|
||
proc-running-p))
|
||
(insert-before-markers-and-inherit ?\n))
|
||
(if proc-running-p
|
||
(progn
|
||
(eshell-update-markers eshell-last-output-end)
|
||
(if (or eshell-send-direct-to-subprocesses
|
||
(= eshell-last-input-start eshell-last-input-end))
|
||
(unless no-newline
|
||
(process-send-string (eshell-interactive-process) "\n"))
|
||
(process-send-region (eshell-interactive-process)
|
||
eshell-last-input-start
|
||
eshell-last-input-end)))
|
||
(if (= eshell-last-output-end (point))
|
||
(run-hooks 'eshell-post-command-hook)
|
||
(let (input)
|
||
(eshell-condition-case err
|
||
(progn
|
||
(setq input (buffer-substring-no-properties
|
||
eshell-last-output-end (1- (point))))
|
||
(run-hook-with-args 'eshell-expand-input-functions
|
||
eshell-last-output-end (1- (point)))
|
||
(let ((cmd
|
||
;; TODO: This is the modification. Report upstream the
|
||
;; lack of flexibility.
|
||
;; (eshell-parse-command-input
|
||
;; eshell-last-output-end (1- (point)))))
|
||
(eshell-parse-command
|
||
(eshell-detach-rewrite-input input) nil t)))
|
||
(when cmd
|
||
(eshell-update-markers eshell-last-output-end)
|
||
(setq input (buffer-substring-no-properties
|
||
eshell-last-input-start
|
||
(1- eshell-last-input-end)))
|
||
(run-hooks 'eshell-input-filter-functions)
|
||
(and (catch 'eshell-terminal
|
||
(ignore
|
||
(if (eshell-invoke-directly cmd)
|
||
(eval cmd)
|
||
(eshell-eval-command cmd input))))
|
||
(eshell-life-is-too-much)))))
|
||
(quit
|
||
(eshell-reset t)
|
||
(run-hooks 'eshell-post-command-hook)
|
||
(signal 'quit nil))
|
||
(error
|
||
(eshell-reset t)
|
||
(eshell-interactive-print
|
||
(concat (error-message-string err) "\n"))
|
||
(run-hooks 'eshell-post-command-hook)
|
||
(insert-and-inherit input)))))))))
|
||
|
||
|
||
|
||
;; TODO: Pause/resume on Eshell.
|
||
;; Bash is one way:
|
||
;; (local-set-key (kbd "C-z") 'self-insert-command)
|
||
;; Pressing self-inserted "C-z RET" works.
|
||
;; This only works for interactive shells, not with `bash -c'.
|
||
;;; esh-proc.el has `eshell-stop-process' but this does not seem to work. Maybe it
|
||
;;; does not propagate properly.
|
||
|
||
;; TODO: Order by deepest child first so that we kill in order? Not sure it matters.
|
||
(defun eshell-detach-children ()
|
||
"Return the list of recursive children of dtach except the dtach daemon."
|
||
;; The process graph when a dtach session is first created is as follows:
|
||
;;
|
||
;; dtach (client)
|
||
;; - dtach (daemon)
|
||
;; - bash (tee of stdout+stderr)
|
||
;; - bash (process)
|
||
;; - bash (tee of stdout)
|
||
;; - bash (tee of stderr)
|
||
;;
|
||
;; When attached to, dtach (the client) is no longer the parent of the daemon.
|
||
;; We want to send a signal to "bash (process)". We cannot predict how many
|
||
;; processes the command will start so we need to send signals to all children.
|
||
(let* ((dtach-client (process-id (eshell-interactive-process)))
|
||
dtach-daemon
|
||
result
|
||
pids
|
||
ppids)
|
||
(if (or (null dtach-client) (not (string= (alist-get 'comm (process-attributes dtach-client)) "dtach")))
|
||
(message "Current interactive process is not dtach")
|
||
(setq pids (list-system-processes)
|
||
ppids (mapcar (lambda (p) (cons (alist-get 'ppid (process-attributes p)) p)) pids))
|
||
;; Query dtach daemon.
|
||
;; Could be the child of the client.
|
||
(setq dtach-daemon (alist-get dtach-client ppids))
|
||
(when (null dtach-daemon)
|
||
;; If we are attaching to a socket, the client daemon is forked and thus
|
||
;; it is not a child of the client.
|
||
;; WARNING: Brittle trick ahead: We find the daemon by finding the
|
||
;; "dtach" process which 3 argument is the same socket as the client.
|
||
(let ((pids pids) ; Save `pids'.
|
||
(dtach-client-socket (nth 2 (split-string (alist-get 'args (process-attributes dtach-client))))))
|
||
(while (and pids (null dtach-daemon))
|
||
(let ((attr (process-attributes (car pids))))
|
||
(when (and (/= (car pids) dtach-client)
|
||
(string= (alist-get 'comm attr) "dtach")
|
||
;; Socket is the third substring.
|
||
(string= (nth 2 (split-string (alist-get 'args attr))) dtach-client-socket))
|
||
(setq dtach-daemon (car pids))))
|
||
(setq pids (cdr pids)))))
|
||
|
||
;; Query children.
|
||
(if (null dtach-daemon)
|
||
(message "Cannot find associated dtach daemon")
|
||
;; The first (and only) child of dtach is the main bash session.
|
||
(push (alist-get dtach-daemon ppids) result)
|
||
;; Add all recursive children of the main bash session to `result'.
|
||
(let ((l 0))
|
||
(while (/= l (length ppids))
|
||
(setq l (length ppids))
|
||
(let (newppids)
|
||
(while ppids
|
||
(when (member (caar ppids) result)
|
||
(push (cdar ppids) result))
|
||
(pop ppids))
|
||
(setq ppids newppids))))))
|
||
result))
|
||
|
||
(defun eshell-detach-stop ()
|
||
"If `eshell-interactive-process' is dtach, pause all children processes.
|
||
The processes can be resumed with `eshell-detach-continue'."
|
||
(interactive)
|
||
;; The TSTP is not the right signal since we are not "at terminal".
|
||
(let ((children (eshell-detach-children)))
|
||
(when children
|
||
(eshell-detach-signal 'STOP children))))
|
||
|
||
(defun eshell-detach-continue ()
|
||
"If `eshell-interactive-process' is dtach, resume all children processes.
|
||
The processes can be pause with `eshell-detach-stop'."
|
||
(interactive)
|
||
(let ((children (eshell-detach-children)))
|
||
(when children
|
||
(eshell-detach-signal 'CONT children))))
|
||
|
||
;; Inpsired by `helm-top-sh'.
|
||
(defun eshell-detach-signal (sig pids)
|
||
"Run `kill' shell command with signal SIG on PIDs.
|
||
PIDs is a list of numbers."
|
||
(let ((pids (mapcar 'number-to-string pids)))
|
||
(message "kill -%s %s exited with status %s"
|
||
sig (mapconcat 'identity pids " ")
|
||
(apply #'call-process
|
||
"kill" nil nil nil (format "-%s" sig) pids))))
|
||
|
||
(provide 'package-eshell-detach)
|