فهرست منبع

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/.
Bruno BARBIER 2 سال پیش
والد
کامیت
8151d52574
4فایلهای تغییر یافته به همراه98 افزوده شده و 6 حذف شده
  1. 10 6
      lisp/ob-shell.el
  2. 10 0
      lisp/org-compat.el
  3. 49 0
      testing/lisp/test-ob-shell.el
  4. 29 0
      testing/org-test.el

+ 10 - 6
lisp/ob-shell.el

@@ -283,12 +283,16 @@ return the value of the last statement in BODY."
 	      (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

+ 10 - 0
lisp/org-compat.el

@@ -224,6 +224,16 @@ extension beyond end of line was not controllable."
 (define-obsolete-function-alias 'org-babel-edit-distance 'org-string-distance
   "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
 

+ 49 - 0
testing/lisp/test-ob-shell.el

@@ -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"
 	   (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)
 
 ;;; test-ob-shell.el ends here

+ 29 - 0
testing/org-test.el

@@ -284,6 +284,35 @@ setting `pp-escape-newlines' to nil manually."
 	;; 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