ob-shell: Use `process-file' when stdin or cmdline
lisp/ob-shell.el (org-babel-sh-evaluate): Use `process-file' (instead of `call-process-shell-command') so that `org-babel-sh-evaluate' will invoke file name handlers based on `default-directory', if needed, like when using a remote directory. lisp/org-compat.el (with-connection-local-variables): New compatibility macro. testing/lisp/test-ob-shell.el (ob-shell/remote-with-stdin-or-cmdline): New test. testing/org-test.el (org-test-with-tramp-remote-dir): New macro. Fixes https://list.orgmode.org/CKMOBWBK709F.1RUN69SRWB64U@laptop/.
This commit is contained in:
parent
eeb4fa8c09
commit
8151d52574
|
@ -283,12 +283,16 @@ return the value of the last statement in BODY."
|
||||||
(set-file-modes script-file #o755)
|
(set-file-modes script-file #o755)
|
||||||
(with-temp-file stdin-file (insert (or stdin "")))
|
(with-temp-file stdin-file (insert (or stdin "")))
|
||||||
(with-temp-buffer
|
(with-temp-buffer
|
||||||
(call-process-shell-command
|
(with-connection-local-variables
|
||||||
(concat (if shebang script-file
|
(apply #'process-file
|
||||||
(format "%s %s" shell-file-name script-file))
|
(if shebang (file-local-name script-file)
|
||||||
(and cmdline (concat " " cmdline)))
|
shell-file-name)
|
||||||
stdin-file
|
stdin-file
|
||||||
(current-buffer))
|
(current-buffer)
|
||||||
|
nil
|
||||||
|
(if shebang (when cmdline (list cmdline))
|
||||||
|
(list shell-command-switch
|
||||||
|
(concat (file-local-name script-file) " " cmdline)))))
|
||||||
(buffer-string))))
|
(buffer-string))))
|
||||||
(session ; session evaluation
|
(session ; session evaluation
|
||||||
(mapconcat
|
(mapconcat
|
||||||
|
|
|
@ -224,6 +224,16 @@ extension beyond end of line was not controllable."
|
||||||
(define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
|
(define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
|
||||||
"9.5")
|
"9.5")
|
||||||
|
|
||||||
|
(unless (fboundp 'with-connection-local-variables)
|
||||||
|
;; Added in Emacs 27: commit:21f54feee8, 2019-03-09.
|
||||||
|
;; Redefining it using the old function `with-connection-local-profiles'.
|
||||||
|
(defmacro with-connection-local-variables (&rest body)
|
||||||
|
"Apply connection-local variables according to `default-directory'.
|
||||||
|
Execute BODY, and unwind connection-local variables."
|
||||||
|
(declare (debug t))
|
||||||
|
`(with-connection-local-profiles (connection-local-get-profiles)
|
||||||
|
,@body)))
|
||||||
|
|
||||||
|
|
||||||
;;; Emacs < 26.1 compatibility
|
;;; Emacs < 26.1 compatibility
|
||||||
|
|
||||||
|
|
|
@ -106,6 +106,55 @@ ob-comint.el, which was not previously tested."
|
||||||
"#+BEGIN_SRC sh :results output :var l='(1 2)\necho ${l}\n#+END_SRC"
|
"#+BEGIN_SRC sh :results output :var l='(1 2)\necho ${l}\n#+END_SRC"
|
||||||
(org-trim (org-babel-execute-src-block))))))
|
(org-trim (org-babel-execute-src-block))))))
|
||||||
|
|
||||||
|
(ert-deftest ob-shell/remote-with-stdin-or-cmdline ()
|
||||||
|
"Test :stdin and :cmdline with a remote directory."
|
||||||
|
;; We assume `default-directory' is a local directory.
|
||||||
|
(skip-unless (not (memq system-type '(ms-dos windows-nt))))
|
||||||
|
(org-test-with-tramp-remote-dir remote-dir
|
||||||
|
(dolist (spec `( ()
|
||||||
|
(:dir ,remote-dir)
|
||||||
|
(:dir ,remote-dir :cmdline t)
|
||||||
|
(:dir ,remote-dir :stdin t)
|
||||||
|
(:dir ,remote-dir :cmdline t :shebang t)
|
||||||
|
(:dir ,remote-dir :stdin t :shebang t)
|
||||||
|
(:dir ,remote-dir :cmdline t :stdin t :shebang t)
|
||||||
|
(:cmdline t)
|
||||||
|
(:stdin t)
|
||||||
|
(:cmdline t :shebang t)
|
||||||
|
(:stdin t :shebang t)
|
||||||
|
(:cmdline t :stdin t :shebang t)))
|
||||||
|
(let ((default-directory (or (plist-get spec :dir) default-directory))
|
||||||
|
(org-confirm-babel-evaluate nil)
|
||||||
|
(params-line "")
|
||||||
|
(who-line " export who=tramp")
|
||||||
|
(args-line " echo ARGS: --verbose 23 71"))
|
||||||
|
(when-let ((dir (plist-get spec :dir)))
|
||||||
|
(setq params-line (concat params-line " " ":dir " dir)))
|
||||||
|
(when (plist-get spec :stdin)
|
||||||
|
(setq who-line " read -r who")
|
||||||
|
(setq params-line (concat params-line " :stdin input")))
|
||||||
|
(when (plist-get spec :cmdline)
|
||||||
|
(setq args-line " echo \"ARGS: $*\"")
|
||||||
|
(setq params-line (concat params-line " :cmdline \"--verbose 23 71\"")))
|
||||||
|
(when (plist-get spec :shebang)
|
||||||
|
(setq params-line (concat params-line " :shebang \"#!/bin/sh\"")))
|
||||||
|
(let* ((result (org-test-with-temp-text
|
||||||
|
(mapconcat #'identity
|
||||||
|
(list "#+name: input"
|
||||||
|
"tramp"
|
||||||
|
""
|
||||||
|
(concat "<point>"
|
||||||
|
"#+begin_src sh :results output " params-line)
|
||||||
|
args-line
|
||||||
|
who-line
|
||||||
|
" echo \"hello $who from $(pwd)/\""
|
||||||
|
"#+end_src")
|
||||||
|
"\n")
|
||||||
|
(org-trim (org-babel-execute-src-block))))
|
||||||
|
(expected (concat "ARGS: --verbose 23 71"
|
||||||
|
"\nhello tramp from " (file-local-name default-directory))))
|
||||||
|
(should (equal result expected)))))))
|
||||||
|
|
||||||
(provide 'test-ob-shell)
|
(provide 'test-ob-shell)
|
||||||
|
|
||||||
;;; test-ob-shell.el ends here
|
;;; test-ob-shell.el ends here
|
||||||
|
|
|
@ -284,6 +284,35 @@ setting `pp-escape-newlines' to nil manually."
|
||||||
;; on multiple lines in the ERT results buffer.
|
;; on multiple lines in the ERT results buffer.
|
||||||
(setq pp-escape-newlines back)))))
|
(setq pp-escape-newlines back)))))
|
||||||
|
|
||||||
|
(defun org-test-with-tramp-remote-dir--worker (body)
|
||||||
|
"Worker for `org-test-with-tramp-remote-dir'."
|
||||||
|
(let ((env-def (getenv "REMOTE_TEMPORARY_FILE_DIRECTORY")))
|
||||||
|
(cond
|
||||||
|
(env-def (funcall body env-def))
|
||||||
|
((eq system-type 'windows-nt) (funcall body null-device))
|
||||||
|
(t (require 'tramp)
|
||||||
|
(let ((tramp-methods
|
||||||
|
(cons '("mock"
|
||||||
|
(tramp-login-program "sh")
|
||||||
|
(tramp-login-args (("-i")))
|
||||||
|
(tramp-remote-shell "/bin/sh")
|
||||||
|
(tramp-remote-shell-args ("-c"))
|
||||||
|
(tramp-connection-timeout 10))
|
||||||
|
tramp-methods))
|
||||||
|
(tramp-default-host-alist
|
||||||
|
`(("\\`mock\\'" nil ,(system-name)))))
|
||||||
|
(funcall body (format "/mock::%s" temporary-file-directory)))))))
|
||||||
|
|
||||||
|
(defmacro org-test-with-tramp-remote-dir (dir &rest body)
|
||||||
|
"Bind the symbol DIR to a remote directory and execute BODY.
|
||||||
|
Return the value of the last form in BODY. The directory DIR
|
||||||
|
will be something like \"/mock::/tmp/\", which allows to test
|
||||||
|
Tramp related features. We mostly follow
|
||||||
|
`tramp-test-temporary-file-directory' from GNU Emacs tests."
|
||||||
|
(declare (debug (sexp body)) (indent 2))
|
||||||
|
`(org-test-with-tramp-remote-dir--worker (lambda (,dir) ,@body)))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; Navigation Functions
|
;;; Navigation Functions
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue