diff --git a/README.md b/README.md index 0c867e4..72bbdb5 100644 --- a/README.md +++ b/README.md @@ -51,7 +51,7 @@ api-key: <> ``` -(Note the parenteses in `API-KEY()`). +(Note the parentheses in `API-KEY()`). ## Limitations @@ -122,9 +122,37 @@ At the moment, if you have more than one server tag, and you press `C-c C-c`, yo for the server using completing-read. In the future, it would be nice to run multiple commands in parallel, though I haven't identified yet how to best do this. +### Disabling with :target nil + +Sometimes you may want to "turn off" the target for a single block with `:target nil`. + +As an example, let's say we have a container `TARGET`: + +``` +#+TARGET: /ssh:server.com|podman:my-container: (container) +``` + +We can run a command and then use filter the results locally: + +``` +* Tailscale status :container: + +#+NAME: status +#+BEGIN_SRC sh +some-cli status --json +#+END_SRC + +#+BEGIN_SRC sh :stdin status :target nil +jq -r '.services | keys' +#+END_SRC +``` + +This will work even if the `jq` command was not installed in the container, since we added +`:target nil` to the second block. + ### Tangling -Tangling obeys the same target tags. This will create `~/foo.txt` in `server1`: +Tangling obeys the same targets. This will create `~/foo.txt` in `server1`: ``` * Upload a file to server1 :server1: diff --git a/devops-test.el b/devops-test.el index 74693fb..7bcd807 100644 --- a/devops-test.el +++ b/devops-test.el @@ -437,6 +437,107 @@ targets land next to the org file rather than in the system temp dir." (should (equal (file-name-as-directory (file-truename (org-trim result))) (file-name-as-directory (file-truename target)))))))) +(ert-deftest devops-execute-src-block-explicit-dir-wins-test () + "An explicit :dir on the block overrides the heading's target." + (devops-test--with-local-target target + (devops-test--with-local-target other + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Run\t\t:local:\n\n" + "#+begin_src sh :dir %s\npwd\n#+end_src\n") + target other) + (goto-char (point-min)) + (re-search-forward "begin_src") + (let* ((org-confirm-babel-evaluate nil) + (result (org-babel-execute-src-block))) + (should (equal (file-name-as-directory (file-truename (org-trim result))) + (file-name-as-directory (file-truename other))))))))) + +(ert-deftest devops-execute-src-block-explicit-dir-skips-prompt-test () + "With an explicit :dir, multiple target tags do not prompt for a target." + (devops-test--with-local-target other + (devops-test--with-org + (format (concat "#+TARGET: /srv/one/ (t1)\n" + "#+TARGET: /srv/two/ (t2)\n\n" + "* Run\t\t:t1:t2:\n\n" + "#+begin_src sh :dir %s\npwd\n#+end_src\n") + other) + (goto-char (point-min)) + (re-search-forward "begin_src") + (let ((org-confirm-babel-evaluate nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) (error "Should not prompt for a target")))) + (should (equal (file-name-as-directory + (file-truename (org-trim (org-babel-execute-src-block)))) + (file-name-as-directory (file-truename other))))))))) + +(ert-deftest devops-execute-src-block-target-nil-runs-locally-test () + "`:target nil' opts the block out of the heading's target." + (devops-test--with-local-target target + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Run\t\t:local:\n\n" + "#+begin_src sh :target nil\npwd\n#+end_src\n") + target) + (goto-char (point-min)) + (re-search-forward "begin_src") + (let* ((here default-directory) + (org-confirm-babel-evaluate nil) + (result (file-name-as-directory + (file-truename (org-trim (org-babel-execute-src-block)))))) + (should (equal result (file-name-as-directory (file-truename here)))) + (should-not (equal result + (file-name-as-directory (file-truename target)))))))) + +(ert-deftest devops-execute-src-block-target-nil-skips-prompt-test () + "With `:target nil', multiple target tags do not prompt for a target." + (devops-test--with-org + (concat "#+TARGET: /srv/one/ (t1)\n" + "#+TARGET: /srv/two/ (t2)\n\n" + "* Run\t\t:t1:t2:\n\n" + "#+begin_src sh :target nil\npwd\n#+end_src\n") + (goto-char (point-min)) + (re-search-forward "begin_src") + (let ((here default-directory) + (org-confirm-babel-evaluate nil)) + (cl-letf (((symbol-function 'completing-read) + (lambda (&rest _) (error "Should not prompt for a target")))) + (should (equal (file-name-as-directory + (file-truename (org-trim (org-babel-execute-src-block)))) + (file-name-as-directory (file-truename here)))))))) + +(ert-deftest devops-execute-src-block-target-nil-from-property-test () + "`:target nil' works when inherited from a `header-args' property." + (devops-test--with-local-target target + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Run\t\t:local:\n" + ":PROPERTIES:\n" + ":header-args: :target nil\n" + ":END:\n\n" + "#+begin_src sh\npwd\n#+end_src\n") + target) + (goto-char (point-min)) + (re-search-forward "begin_src") + (let ((here default-directory) + (org-confirm-babel-evaluate nil)) + (should (equal (file-name-as-directory + (file-truename (org-trim (org-babel-execute-src-block)))) + (file-name-as-directory (file-truename here)))))))) + +(ert-deftest devops-execute-src-block-unknown-target-errors-test () + "An unrecognized :target value errors rather than falling back to the tag." + (devops-test--with-local-target target + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Run\t\t:local:\n\n" + "#+begin_src sh :target elsewhere\npwd\n#+end_src\n") + target) + (goto-char (point-min)) + (re-search-forward "begin_src") + (let ((org-confirm-babel-evaluate nil)) + (should-error (org-babel-execute-src-block) :type 'user-error))))) + ;;; Multi-target tangling (README: same file to several servers) (ert-deftest devops-tangle-multi-target-test () diff --git a/devops.el b/devops.el index dc8ebb7..db7cdf5 100644 --- a/devops.el +++ b/devops.el @@ -90,13 +90,55 @@ user to select one." (let ((dir (devops--heading-target-dir))) (org-entry-put nil "header-args" (format ":dir %s" dir)))) -(defun devops--inject-header-args-from-tags (orig-fn &optional arg info params _babel-call) - "Advise org-babel-execute-src-block to inject :dir" - (let* ((dir (devops--heading-target-dir)) +(defconst devops--target-none-values '(nil "nil" "none") + "Values of a :target header argument that mean \"no target\". +Org reads a header value as a string, so a block written `:target nil' +arrives as \"nil\". A genuine nil is accepted too, for params passed to +`org-babel-execute-src-block' from Lisp.") + +(defun devops--block-params (info) + "Return the header arguments of the src block being executed. +INFO is the src block info given to `org-babel-execute-src-block', or nil +when point is on the block. Covers header arguments on the block itself, +on a #+header: line, inherited from a `header-args' property, and the +defaults in `org-babel-default-header-args'." + (nth 2 (or info + (ignore-errors + (org-babel-get-src-block-info 'no-eval))))) + +(defun devops--header-cell (key params block-params) + "Return the (KEY . VALUE) header argument in effect, or nil. +PARAMS is the override alist given to `org-babel-execute-src-block' and +BLOCK-PARAMS the block's own header arguments. PARAMS wins, as it does +in `org-babel-merge-params'." + (or (assq key params) + (assq key block-params))) + +(defun devops--target-opted-out-p (params block-params) + "Return non-nil if a :target header opts the block out of its heading's target. +PARAMS and BLOCK-PARAMS are as in `devops--header-cell'. Signal an error +for any :target value other than those in `devops--target-none-values': +running on the heading's target is the wrong answer when the block asked +for something else, and silence would hide the mistake until it landed on +a server." + (when-let* ((cell (devops--header-cell :target params block-params))) + (or (member (cdr cell) devops--target-none-values) + (user-error "Unknown :target value %S (expected nil)" (cdr cell))))) + +(defun devops--inject-header-args-from-tags (orig-fn &optional arg info params executor-type) + "Advise org-babel-execute-src-block to inject :dir from #+TARGET tags. +An explicit :dir wins: the heading's target is neither resolved nor +prompted for when the block already carries one. `:target nil' opts the +block out of the heading's target without naming a directory, leaving +:dir to org." + (let* ((block-params (devops--block-params info)) + (dir (unless (or (devops--target-opted-out-p params block-params) + (devops--header-cell :dir params block-params)) + (devops--heading-target-dir))) (params (if dir (cons (cons :dir dir) params) params))) - (funcall orig-fn arg info params))) + (apply orig-fn arg info params (and executor-type (list executor-type))))) (advice-add 'org-babel-execute-src-block :around #'devops--inject-header-args-from-tags)