From d9abfb423bff620dee15d204f4bab48e2ec8dc4e Mon Sep 17 00:00:00 2001 From: Bruno BARBIER Date: Sat, 18 Jun 2022 09:48:01 +0200 Subject: [PATCH] ob-shell: Use 'process-file' when stdin or cmdline lib/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. 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/. --- lisp/ob-shell.el | 16 +++++++----- testing/lisp/test-ob-shell.el | 49 +++++++++++++++++++++++++++++++++++ testing/org-test.el | 29 +++++++++++++++++++++ 3 files changed, 88 insertions(+), 6 deletions(-) diff --git a/lisp/ob-shell.el b/lisp/ob-shell.el index 44efb4ea1..51071d40a 100644 --- a/lisp/ob-shell.el +++ b/lisp/ob-shell.el @@ -279,12 +279,16 @@ (defun org-babel-sh-evaluate (session body &optional params stdin cmdline) (set-file-modes script-file #o755) (with-temp-file stdin-file (insert (or stdin ""))) (with-temp-buffer - (call-process-shell-command - (concat (if shebang script-file - (format "%s %s" shell-file-name script-file)) - (and cmdline (concat " " cmdline))) - stdin-file - (current-buffer)) + (with-connection-local-variables + (apply #'process-file + (if shebang (file-local-name script-file) + shell-file-name) + stdin-file + (current-buffer) + nil + (if shebang (when cmdline (list cmdline)) + (list shell-command-switch + (concat (file-local-name script-file) " " cmdline))))) (buffer-string)))) (session ; session evaluation (mapconcat diff --git a/testing/lisp/test-ob-shell.el b/testing/lisp/test-ob-shell.el index 2f346f699..442e70372 100644 --- a/testing/lisp/test-ob-shell.el +++ b/testing/lisp/test-ob-shell.el @@ -106,6 +106,55 @@ (ert-deftest ob-shell/simple-list () "#+BEGIN_SRC sh :results output :var l='(1 2)\necho ${l}\n#+END_SRC" (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 "" + "#+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) ;;; test-ob-shell.el ends here diff --git a/testing/org-test.el b/testing/org-test.el index 0520e82f9..7e5d60e63 100644 --- a/testing/org-test.el +++ b/testing/org-test.el @@ -284,6 +284,35 @@ (defun org-test-table-target-expect (target &optional expect laps ;; on multiple lines in the ERT results buffer. (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 -- 2.35.1