From fe5415e10002cc55b8f3816b51aef4f33d7823db Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Tue, 11 Aug 2026 13:11:41 -0600 Subject: [PATCH 1/7] feat: explicit :dir overrides heading target tag The babel advice consed its resolved target onto params, so it won over any :dir on the block itself, and multi-tag headings prompted for a target even when the block already had one. Skip resolution entirely when a :dir is present in the override params or the block's resolved params (block, #+header: line, or header-args property); :dir nil opts a block out of injection. Also pass executor-type through to the advised function instead of dropping it. Co-Authored-By: Claude Opus 5 (1M context) --- README.md | 14 ++++++++++++++ devops-test.el | 34 ++++++++++++++++++++++++++++++++++ devops.el | 22 ++++++++++++++++++---- 3 files changed, 66 insertions(+), 4 deletions(-) diff --git a/README.md b/README.md index 0c867e4..98f5a45 100644 --- a/README.md +++ b/README.md @@ -122,6 +122,20 @@ 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. +An explicit `:dir` wins over the heading's target tag. This block runs in `/tmp`, not on +`example1.com`, and no target prompt appears even under a multi-tag heading: + +``` +* Do something on server1 :server1: + +#+BEGIN_SRC sh :dir /tmp +hostname +#+END_SRC +``` + +This works for a `:dir` on the block, on a `#+header:` line, or inherited from a `header-args` +property. Use `:dir nil` to run a single block locally while keeping the heading's tag. + ### Tangling Tangling obeys the same target tags. This will create `~/foo.txt` in `server1`: diff --git a/devops-test.el b/devops-test.el index 74693fb..4927caa 100644 --- a/devops-test.el +++ b/devops-test.el @@ -437,6 +437,40 @@ 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))))))))) + ;;; 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..c35b431 100644 --- a/devops.el +++ b/devops.el @@ -90,13 +90,27 @@ 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)) +(defun devops--explicit-dir-p (info params) + "Return non-nil if the block being executed already specifies :dir. +PARAMS is the override alist given to `org-babel-execute-src-block' and +INFO its src block info, or nil when point is on the block. Covers a +:dir on the block itself, on a #+header: line, or inherited from a +`header-args' property." + (or (assq :dir params) + (assq :dir (nth 2 (or info + (ignore-errors + (org-babel-get-src-block-info 'no-eval))))))) + +(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." + (let* ((dir (unless (devops--explicit-dir-p info 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) From ce5dddd2f66c0f65432a592fafccd304eb78f86f Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Tue, 11 Aug 2026 15:04:11 -0600 Subject: [PATCH 2/7] update README --- README.md | 30 ++++++++++++++++------ devops-test.el | 67 ++++++++++++++++++++++++++++++++++++++++++++++++++ devops.el | 50 ++++++++++++++++++++++++++++--------- 3 files changed, 128 insertions(+), 19 deletions(-) diff --git a/README.md b/README.md index 98f5a45..2e399a1 100644 --- a/README.md +++ b/README.md @@ -122,23 +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. -An explicit `:dir` wins over the heading's target tag. This block runs in `/tmp`, not on -`example1.com`, and no target prompt appears even under a multi-tag heading: +### 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) ``` -* Do something on server1 :server1: -#+BEGIN_SRC sh :dir /tmp -hostname +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 works for a `:dir` on the block, on a `#+header:` line, or inherited from a `header-args` -property. Use `:dir nil` to run a single block locally while keeping the heading's tag. +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 4927caa..7bcd807 100644 --- a/devops-test.el +++ b/devops-test.el @@ -471,6 +471,73 @@ targets land next to the org file rather than in the system temp dir." (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 c35b431..db7cdf5 100644 --- a/devops.el +++ b/devops.el @@ -90,22 +90,50 @@ user to select one." (let ((dir (devops--heading-target-dir))) (org-entry-put nil "header-args" (format ":dir %s" dir)))) -(defun devops--explicit-dir-p (info params) - "Return non-nil if the block being executed already specifies :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 -INFO its src block info, or nil when point is on the block. Covers a -:dir on the block itself, on a #+header: line, or inherited from a -`header-args' property." - (or (assq :dir params) - (assq :dir (nth 2 (or info - (ignore-errors - (org-babel-get-src-block-info 'no-eval))))))) +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." - (let* ((dir (unless (devops--explicit-dir-p info params) +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) From e9f55eca7683e7bbb22a47c4497ec7b4584d732d Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Tue, 11 Aug 2026 15:05:31 -0600 Subject: [PATCH 3/7] [skip ci] Fix typo --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 2e399a1..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 From 69d55b6e9126927fc8f8f9fa53148d22fe979a0c Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Sun, 16 Aug 2026 14:17:49 -0600 Subject: [PATCH 4/7] Clean up target handling a bit --- README.md | 41 +++++++++ devops-drift.el | 39 ++++++--- devops-test.el | 219 +++++++++++++++++++++++++++++++++++++++++++++++- devops.el | 153 +++++++++++++++++++++++---------- 4 files changed, 394 insertions(+), 58 deletions(-) diff --git a/README.md b/README.md index 72bbdb5..068630d 100644 --- a/README.md +++ b/README.md @@ -150,6 +150,9 @@ jq -r '.services | keys' This will work even if the `jq` command was not installed in the container, since we added `:target nil` to the second block. +`:target nil` tangles locally. See +[Tangling with :target nil](#tangling-with-target-nil). + ### Tangling Tangling obeys the same targets. This will create `~/foo.txt` in `server1`: @@ -173,6 +176,44 @@ You can tangle a file to multiple servers. This will create `~/foo.txt` on both #+END_SRC ``` +### How :tangle paths are read + +`#+TARGET: /ssh:example1.com:/opt/app (server1)`, `:tangle` resolves +as follows: + +| `:tangle` | resolves to | +|------------------|-------------------------------------------| +| `foo.txt` | `/ssh:example1.com:/opt/app/foo.txt` | +| `conf/foo.txt` | `/ssh:example1.com:/opt/app/conf/foo.txt` | +| `./conf/foo.txt` | same as above — the `./` is dropped | +| `/etc/foo.txt` | `/ssh:example1.com:/etc/foo.txt` | +| `~/foo.txt` | `/ssh:example1.com:~/foo.txt` | + +Absolute and `~` paths are already absolute on the target's machine, so they +replace the target's directory and keep only its host. + +For a local directory target such as `#+TARGET: /srv/app/ (staging)` there is +no host to keep, so `:tangle /etc/foo.txt` writes to `/etc/foo.txt` — outside +the target directory. + +### Tangling with :target nil + +`:target nil` behaves like `org-babel-tangle`. + +``` +* Deploy :server1: + +#+BEGIN_SRC conf :tangle app.conf +... goes to server1 ... +#+END_SRC + +#+BEGIN_SRC yaml :target nil :tangle inventory.yaml +... stays next to the org file ... +#+END_SRC +``` + +Use `:tangle no` if you want a block not to tangle at all. + ## Drift detection Tangling pushes the org file out to its targets. `devops-drift` asks the diff --git a/devops-drift.el b/devops-drift.el index b2f10d4..5692a85 100644 --- a/devops-drift.el +++ b/devops-drift.el @@ -64,8 +64,16 @@ original :tangle value, LOCAL the rewritten local file and REMOTE the file the path denotes at TARGET. A PATH that is already a TRAMP path keeps itself as REMOTE but is still redirected to LOCAL-ROOT: a drift check must never write to a remote. Skips :tangle no and :tangle yes. + +A block that opted out with `:target nil' has no target to be compared +against, so it is left out of the mapping and its header is neutralized +to :tangle no. Neutralizing it matters as much as omitting it: the +block's own path is a real local file, and tangling it here would make a +read-only check write to the user's filesystem. + Modifies buffer text." - (let (mapping) + (let ((opted-out (devops--target-opted-out-regions)) + mapping) (save-excursion (goto-char (point-max)) (while (re-search-backward ":tangle +\\([^ \t\n]+\\)" nil t) @@ -76,18 +84,23 @@ Modifies buffer text." (end (match-end 0)) (path (match-string 1))) (unless (member path '("no" "yes")) - (let ((remote (if (tramp-tramp-file-p path) - path - (devops--join-target target path))) - (local (expand-file-name - (devops--drift-localize-path path) local-root))) - (delete-region beg end) - (goto-char beg) - (insert ":tangle " local) - ;; Step before the rewrite so the backward search keeps - ;; making progress (the rewritten path matches the regexp). - (goto-char beg) - (push (list path local remote) mapping)))))) + (if (devops--in-regions-p beg opted-out) + (progn + (delete-region beg end) + (goto-char beg) + (insert ":tangle no")) + (let ((remote (if (tramp-tramp-file-p path) + path + (devops--join-target target path))) + (local (expand-file-name + (devops--drift-localize-path path) local-root))) + (delete-region beg end) + (goto-char beg) + (insert ":tangle " local) + (push (list path local remote) mapping))) + ;; Step before the rewrite so the backward search keeps + ;; making progress (the rewritten path matches the regexp). + (goto-char beg))))) mapping)) (defun devops--drift-tangle-heading (source-buf heading-pos tag target local-root) diff --git a/devops-test.el b/devops-test.el index 3a02cd1..add3171 100644 --- a/devops-test.el +++ b/devops-test.el @@ -126,7 +126,52 @@ The directory is removed afterwards." (should (equal (devops--join-target "/ssh:host:/etc" "foo.txt") "/ssh:host:/etc/foo.txt")) (should (equal (devops--join-target "/ssh:host:/etc/" "foo.txt") - "/ssh:host:/etc/foo.txt"))) + "/ssh:host:/etc/foo.txt")) + ;; A relative subdirectory keeps its shape, spelled either way. + (should (equal (devops--join-target "/ssh:host:" "dir/foo.txt") + "/ssh:host:dir/foo.txt")) + (should (equal (devops--join-target "/ssh:host:" "./dir/foo.txt") + "/ssh:host:dir/foo.txt")) + (should (equal (devops--join-target "/srv/app" "./dir/foo.txt") + "/srv/app/dir/foo.txt")) + ;; "." as a target and "./" on the path collapse to one "./". + (should (equal (devops--join-target "." "./foo.txt") "./foo.txt"))) + +(ert-deftest devops--split-target-test () + "Split a target into its TRAMP prefix and its directory part." + (should (equal (devops--split-target "/srv/app") '("" . "/srv/app"))) + (should (equal (devops--split-target ".") '("" . "."))) + (should (equal (devops--split-target "/ssh:host:") '("/ssh:host:" . ""))) + (should (equal (devops--split-target "/ssh:host:/etc") '("/ssh:host:" . "/etc"))) + ;; Multi-hop: the whole hop chain is the prefix (`file-remote-p' would + ;; report only "/podman:box:"). + (should (equal (devops--split-target "/ssh:host|podman:box:") + '("/ssh:host|podman:box:" . "")))) + +(ert-deftest devops--join-target-absolute-path-test () + "An absolute :tangle path is absolute on the target's machine." + ;; The TRAMP prefix survives; the target's directory does not. + (should (equal (devops--join-target "/ssh:host:" "/etc/app.conf") + "/ssh:host:/etc/app.conf")) + (should (equal (devops--join-target "/ssh:host:/opt/app" "/etc/app.conf") + "/ssh:host:/etc/app.conf")) + (should (equal (devops--join-target "/ssh:host|podman:box:/opt" "/etc/app.conf") + "/ssh:host|podman:box:/etc/app.conf")) + ;; A local directory target has no prefix to keep, so the path stands alone. + (should (equal (devops--join-target "/srv/app/" "/etc/app.conf") + "/etc/app.conf")) + (should (equal (devops--join-target "." "/etc/app.conf") "/etc/app.conf"))) + +(ert-deftest devops--join-target-home-path-test () + "A \"~\" :tangle path is the home directory on the target's machine." + (should (equal (devops--join-target "/ssh:host:" "~/foo.txt") + "/ssh:host:~/foo.txt")) + ;; Not "/ssh:host:/opt/app/~/foo.txt", which names a directory called "~". + (should (equal (devops--join-target "/ssh:host:/opt/app" "~/foo.txt") + "/ssh:host:~/foo.txt")) + (should (equal (devops--join-target "/ssh:host:/opt/app" "~admin/foo.txt") + "/ssh:host:~admin/foo.txt")) + (should (equal (devops--join-target "/srv/app/" "~/foo.txt") "~/foo.txt"))) ;;; Tangle-path rewriting @@ -189,6 +234,73 @@ The directory is removed afterwards." (goto-char (point-min)) (should-not (search-forward ":tangle .foo.txt" nil t)))) +(ert-deftest devops--rewrite-tangle-paths-subdirectory-test () + "A relative subdirectory is prefixed, spelled with or without \"./\"." + (devops-test--with-org + (concat "* Heading\n\n" + "#+begin_src sh :tangle dir/foo.txt\n" + "echo hi\n#+end_src\n\n" + "#+begin_src sh :tangle ./dir/bar.txt\n" + "echo hi\n#+end_src\n") + (devops--rewrite-tangle-paths "/ssh:host1:") + (goto-char (point-min)) + (should (search-forward ":tangle /ssh:host1:dir/foo.txt" nil t)) + (goto-char (point-min)) + (should (search-forward ":tangle /ssh:host1:dir/bar.txt" nil t)))) + +(ert-deftest devops--rewrite-tangle-paths-absolute-test () + "An absolute path is absolute on the target, not nested under it." + (devops-test--with-org + (concat "* Heading\n\n" + "#+begin_src sh :tangle /etc/app.conf\n" + "key=val\n#+end_src\n") + (devops--rewrite-tangle-paths "/ssh:host1:/opt/app") + (goto-char (point-min)) + (should (search-forward ":tangle /ssh:host1:/etc/app.conf" nil t)) + (goto-char (point-min)) + (should-not (search-forward "/opt/app/etc" nil t)))) + +(ert-deftest devops--rewrite-tangle-paths-target-nil-test () + "A block that opted out with `:target nil' keeps its own local path." + (devops-test--with-org + (concat "* Heading\n\n" + "#+begin_src sh :tangle foo.txt\n" + "echo hi\n#+end_src\n\n" + "#+begin_src sh :target nil :tangle bar.txt\n" + "echo hi\n#+end_src\n") + (devops--rewrite-tangle-paths "/ssh:host1:" "/home/me/notes/") + (goto-char (point-min)) + (should (search-forward ":tangle /ssh:host1:foo.txt" nil t)) + ;; Relative, so expanded against LOCAL-DIR rather than the temp buffer. + (goto-char (point-min)) + (should (search-forward ":tangle /home/me/notes/bar.txt" nil t)) + (goto-char (point-min)) + (should-not (search-forward ":tangle /ssh:host1:bar.txt" nil t)))) + +(ert-deftest devops--rewrite-tangle-paths-target-nil-absolute-test () + "An opted-out block's absolute path is left as it stands." + (devops-test--with-org + (concat "* Heading\n\n" + "#+begin_src sh :target nil :tangle ~/bar.txt\n" + "echo hi\n#+end_src\n") + (devops--rewrite-tangle-paths "/ssh:host1:" "/home/me/notes/") + (goto-char (point-min)) + (should (search-forward (concat ":tangle " (expand-file-name "~/bar.txt")) + nil t)))) + +(ert-deftest devops--rewrite-tangle-paths-target-nil-from-property-test () + "A `:target nil' inherited from a `header-args' property opts out too." + (devops-test--with-org + (concat "* Heading\n" + ":PROPERTIES:\n" + ":header-args: :target nil\n" + ":END:\n\n" + "#+begin_src sh :tangle bar.txt\n" + "echo hi\n#+end_src\n") + (devops--rewrite-tangle-paths "/ssh:host1:" "/home/me/notes/") + (goto-char (point-min)) + (should (search-forward ":tangle /home/me/notes/bar.txt" nil t)))) + (ert-deftest devops--rewrite-tangle-paths-skip-yes-test () "Don't rewrite :tangle yes (the default-filename flag, not a path)." (devops-test--with-org @@ -556,6 +668,70 @@ targets land next to the org file rather than in the system temp dir." (should (file-exists-p (concat t1 "foo.txt"))) (should (file-exists-p (concat t2 "foo.txt")))))))) +(ert-deftest devops-tangle-absolute-path-escapes-target-dir-test () + "An absolute :tangle path is not nested under a directory target." + (devops-test--with-local-target target + (devops-test--with-local-target elsewhere + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Deploy\t\t:local:\n\n" + "#+begin_src txt :tangle %sapp.conf\n" + "key=val\n#+end_src\n") + target elsewhere) + (devops-tangle-headline (current-buffer) "Deploy") + (should (file-exists-p (concat elsewhere "app.conf"))) + ;; Not TARGET + ELSEWHERE glued together. + (should-not (file-exists-p + (concat target (substring elsewhere 1) "app.conf"))))))) + +(ert-deftest devops-tangle-subdirectory-test () + "A relative subdirectory lands under the target, spelled either way." + (devops-test--with-local-target target + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Deploy\t\t:local:\n\n" + "#+begin_src txt :tangle conf/a.txt :mkdirp yes\n" + "a\n#+end_src\n\n" + "#+begin_src txt :tangle ./conf/b.txt :mkdirp yes\n" + "b\n#+end_src\n") + target) + (devops-tangle-headline (current-buffer) "Deploy") + (should (file-exists-p (concat target "conf/a.txt"))) + (should (file-exists-p (concat target "conf/b.txt")))))) + +(ert-deftest devops-tangle-target-nil-tangles-locally-test () + "`:target nil' tangles beside the org file, leaving the target alone." + (devops-test--with-local-target target + (devops-test--with-local-target here + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Deploy\t\t:local:\n\n" + "#+begin_src txt :tangle remote.txt\n" + "to the server\n#+end_src\n\n" + "#+begin_src txt :target nil :tangle local.txt\n" + "stays here\n#+end_src\n") + target) + (let ((default-directory here)) + (devops-tangle-headline (current-buffer) "Deploy")) + (should (file-exists-p (concat target "remote.txt"))) + (should (file-exists-p (concat here "local.txt"))) + ;; The opted-out block is not pushed to the target... + (should-not (file-exists-p (concat target "local.txt"))) + ;; ...and the targeted one is not left behind locally. + (should-not (file-exists-p (concat here "remote.txt"))))))) + +(ert-deftest devops-tangle-paths-target-nil-test () + "`devops--tangle-paths' names one local file for an opted-out block." + (devops-test--with-org + (concat "#+TARGET: /srv/one/ (t1)\n" + "#+TARGET: /srv/two/ (t2)\n\n" + "* Deploy\t\t:t1:t2:\n\n" + "#+begin_src txt :target nil :tangle foo.txt\nhi\n#+end_src\n") + (goto-char (point-min)) + (re-search-forward "begin_src") + (should (equal (devops--tangle-paths) + (list (expand-file-name "foo.txt")))))) + ;;; Noweb (README: secrets via <>, per-server blocks) (ert-deftest devops-tangle-noweb-executes-block-test () @@ -718,6 +894,47 @@ afterwards), in an org buffer visiting the formatted text." (goto-char (point-min)) (should-not (search-forward ":tangle /ssh:other:" nil t))))) +(ert-deftest devops--drift-rewrite-tangle-paths-target-nil-test () + "An opted-out block is left out of the mapping and neutralized." + (devops-test--with-org + (concat "* Heading\n\n" + "#+begin_src sh :tangle ~/foo.txt\n" + "echo hi\n#+end_src\n\n" + "#+begin_src sh :target nil :tangle ~/bar.txt\n" + "echo hi\n#+end_src\n") + (let ((mapping (devops--drift-rewrite-tangle-paths "/ssh:host1:" "/tmp/root"))) + (should (= 1 (length mapping))) + (should (equal (car mapping) + '("~/foo.txt" "/tmp/root/home/foo.txt" + "/ssh:host1:~/foo.txt"))) + ;; Neutralized, not merely unmapped: a drift check must not write + ;; the block's own path either. + (goto-char (point-min)) + (should (search-forward ":tangle no" nil t)) + (goto-char (point-min)) + (should-not (search-forward ":tangle ~/bar.txt" nil t))))) + +(ert-deftest devops-drift-check-target-nil-skipped-test () + "A block that opted out of the target is not drift-checked." + (devops-test--with-local-target target + (devops-test--with-local-target here + (devops-test--with-org + (format (concat "#+TARGET: %s (local)\n\n" + "* Deploy\t\t:local:\n\n" + "#+begin_src txt :tangle foo.txt\nhello\n#+end_src\n\n" + "#+begin_src txt :target nil :tangle local.txt\n" + "stays here\n#+end_src\n") + target) + (let ((default-directory here)) + (devops-tangle-headline (current-buffer) "Deploy")) + (let* ((result (devops--drift-check (current-buffer) t)) + (entries (cdr result))) + (unwind-protect + (progn + (should (= 1 (length entries))) + (should (equal (plist-get (car entries) :path) "foo.txt"))) + (delete-directory (car result) t))))))) + (ert-deftest devops-drift-check-in-sync-test () "A target that matches its tangled output reports `same'." (devops-test--with-local-target target diff --git a/devops.el b/devops.el index db7cdf5..78b063e 100644 --- a/devops.el +++ b/devops.el @@ -125,6 +125,28 @@ a server." (or (member (cdr cell) devops--target-none-values) (user-error "Unknown :target value %S (expected nil)" (cdr cell))))) +(defun devops--target-opted-out-regions () + "Return (BEG . END) for each src block that opts out of its heading's target. +Covers the accessible portion of the buffer, so a narrowed subtree yields +only its own blocks. Header arguments are read with the same merge rules +as execution, so a `:target nil' inherited from a `header-args' property +counts. The regions let a textual :tangle rewrite tell an opted-out +block's header from any other." + (org-element-map (org-element-parse-buffer 'element) 'src-block + (lambda (el) + (save-excursion + (goto-char (org-element-property :post-affiliated el)) + (when (devops--target-opted-out-p nil (devops--block-params nil)) + (cons (org-element-property :begin el) + (org-element-property :end el))))))) + +(defun devops--in-regions-p (pos regions) + "Return non-nil if POS falls inside one of REGIONS, a list of (BEG . END)." + (catch 'hit + (dolist (region regions) + (when (and (>= pos (car region)) (< pos (cdr region))) + (throw 'hit t))))) + (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 @@ -159,40 +181,77 @@ Blocks matching other tags get renamed to avoid resolution." (concat prefix basename) (concat prefix "_devops-excluded-" basename "-" block-tag))))))) +(defun devops--split-target (target) + "Split TARGET into a (PREFIX . ROOT) cons. +PREFIX is the TRAMP method/host header and ROOT the directory part: +\"/ssh:host:\" splits into (\"/ssh:host:\" . \"\"), \"/ssh:host:/etc\" into +\(\"/ssh:host:\" . \"/etc\"), and a local \"/srv/app\" into +\(\"\" . \"/srv/app\"). The split goes through `tramp-dissect-file-name' +rather than `file-remote-p', which reports only the last hop of a +multi-hop target like \"/ssh:host|podman:box:\"." + (if (tramp-tramp-file-p target) + (let ((root (tramp-file-name-localname (tramp-dissect-file-name target)))) + (cons (substring target 0 (- (length target) (length root))) root)) + (cons "" target))) + (defun devops--join-target (target path) - "Join TARGET prefix onto a relative :tangle PATH with one separator. -TARGET is a #+TARGET value (a directory or TRAMP prefix); PATH is a -relative :tangle filename. A \"/\" is inserted between them unless TARGET -already ends in \"/\" or \":\". A trailing \":\" marks a TRAMP method/host -prefix (e.g. \"/ssh:host:\") whose bare form already means the remote -login directory, so no separator is added there. - -This keeps awkward targets honest: \".\" yields \"./PATH\" (not the hidden -file \".PATH\") and \"/srv/app\" yields \"/srv/app/PATH\" (not -\"/srv/appPATH\")." - (if (or (string-suffix-p "/" target) - (string-suffix-p ":" target)) - (concat target path) - (concat target "/" path))) - -(defun devops--rewrite-tangle-paths (tramp-prefix) + "Join TARGET onto a :tangle PATH, reading PATH as its machine would. +TARGET is a #+TARGET value: a TRAMP prefix, a directory, or both. + +A relative PATH lands under TARGET's directory, with exactly one +separator between them. This keeps awkward targets honest: \".\" yields +\"./PATH\" (not the hidden file \".PATH\") and \"/srv/app\" yields +\"/srv/app/PATH\" (not \"/srv/appPATH\"). A leading \"./\" is dropped, so +\"./dir/f\" and \"dir/f\" name one file rather than two spellings of it. + +An absolute PATH (\"/etc/f\") or a home-relative one (\"~/f\") is already +absolute on TARGET's machine, so it replaces TARGET's directory and keeps +only its TRAMP prefix: at \"/ssh:host:/opt\", \"/etc/f\" is +\"/ssh:host:/etc/f\", not \"/ssh:host:/opt/etc/f\". \"~\" is left for TRAMP +to expand when the file is written, on the machine it belongs to." + (let* ((split (devops--split-target target)) + (prefix (car split)) + (root (cdr split)) + (path (if (string-prefix-p "./" path) (substring path 2) path))) + (cond + ((or (string-prefix-p "/" path) + (string-prefix-p "~" path)) + (concat prefix path)) + ((or (string= "" root) + (string-suffix-p "/" root)) + (concat prefix root path)) + (t + (concat prefix root "/" path))))) + +(defun devops--rewrite-tangle-paths (tramp-prefix &optional local-dir) "Rewrite :tangle header args in buffer to include TRAMP-PREFIX. Modifies buffer text. Skips :tangle no, :tangle yes, and paths already -containing a TRAMP prefix." - (save-excursion - (goto-char (point-max)) - (while (re-search-backward - ":tangle +\\([^ \t\n]+\\)" - nil t) - (let ((path (match-string 1))) - (when (and (not (member path '("no" "yes"))) - (not (tramp-tramp-file-p path))) - (replace-match (concat ":tangle " - (devops--join-target tramp-prefix path))) - ;; Step before the rewrite so the backward search keeps making - ;; progress. Otherwise a local (non-TRAMP) prefix would leave the - ;; rewritten path matchable and we'd re-prefix it forever. - (goto-char (match-beginning 0))))))) +containing a TRAMP prefix. + +A block that opted out with `:target nil' keeps its own path: the target +is off for tangling exactly as it is for execution, so the file lands +locally. Such a relative path is expanded against LOCAL-DIR, since +tangling runs in a temp buffer whose directory is the system temp dir and +`org-babel-tangle' would otherwise resolve it there." + (let ((opted-out (devops--target-opted-out-regions))) + (save-excursion + (goto-char (point-max)) + (while (re-search-backward + ":tangle +\\([^ \t\n]+\\)" + nil t) + (let ((path (match-string 1)) + (beg (match-beginning 0))) + (when (and (not (member path '("no" "yes"))) + (not (tramp-tramp-file-p path))) + (replace-match + (concat ":tangle " + (if (devops--in-regions-p beg opted-out) + (if local-dir (expand-file-name path local-dir) path) + (devops--join-target tramp-prefix path)))) + ;; Step before the rewrite so the backward search keeps making + ;; progress. Otherwise a local (non-TRAMP) prefix would leave the + ;; rewritten path matchable and we'd re-prefix it forever. + (goto-char beg))))))) (defun devops--tangle-heading (source-buf heading-pos tag target) "Tangle subtree at HEADING-POS from SOURCE-BUF to TARGET. @@ -203,11 +262,12 @@ A relative local TARGET (e.g. \".\" or \"../foo\") is expanded against SOURCE-BUF's directory before tangling. Tangling runs in a temp buffer whose file lives in the system temp dir, so without this a relative target would silently resolve against the temp dir instead of the org -file. TRAMP targets are left untouched." - (let* ((target (if (tramp-tramp-file-p target) +file. TRAMP targets are left untouched. Blocks that opted out of the +target with `:target nil' resolve against that same directory." + (let* ((local-dir (buffer-local-value 'default-directory source-buf)) + (target (if (tramp-tramp-file-p target) target - (expand-file-name - target (buffer-local-value 'default-directory source-buf)))) + (expand-file-name target local-dir))) (tmp-file (make-temp-file "devops-tangle-" nil ".org")) (tmp-buf (find-file-noselect tmp-file))) (unwind-protect @@ -219,7 +279,7 @@ file. TRAMP targets are left untouched." (org-narrow-to-subtree) (let* ((files (progn (devops--specialize-noweb-blocks tag) - (devops--rewrite-tangle-paths target) + (devops--rewrite-tangle-paths target local-dir) (org-babel-tangle)))) (widen) (when files (length files))))) @@ -335,18 +395,23 @@ argument. SOURCE-BUF must be an org-mode buffer." (devops--tangle-spec-execute source-buf (devops--tangle-spec t)))) (defun devops--tangle-paths () - "Return a list of file paths expanded with each target" - (let* ((spec (devops--tangle-spec)) - (params (nth 2 (org-babel-get-src-block-info))) + "Return a list of file paths expanded with each target. +A block that opted out with `:target nil' names one local file, resolved +like any other path in this buffer, rather than one file per target." + (let* ((params (nth 2 (org-babel-get-src-block-info))) (path (cdr (assq :tangle params)))) - (if (or (not path) - (member path '("no" "yes")) - (tramp-tramp-file-p path)) - nil + (cond + ((or (not path) + (member path '("no" "yes")) + (tramp-tramp-file-p path)) + nil) + ((devops--target-opted-out-p nil params) + (list (expand-file-name path))) + (t (mapcar (lambda (entry) (let ((target (plist-get entry :target))) (devops--join-target target path))) - spec)))) + (devops--tangle-spec)))))) (defun devops-visit-file (&optional arg) "Go to file at of source code block at point. From e1c23e3634962dfff7ef2aa8695cceb79810abf6 Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Sun, 16 Aug 2026 14:42:43 -0600 Subject: [PATCH 5/7] Clean up README a bit --- README.md | 67 +++++++++++++++++++++++++------------------------------ 1 file changed, 31 insertions(+), 36 deletions(-) diff --git a/README.md b/README.md index 068630d..b0d39c8 100644 --- a/README.md +++ b/README.md @@ -122,37 +122,6 @@ 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. - -`:target nil` tangles locally. See -[Tangling with :target nil](#tangling-with-target-nil). - ### Tangling Tangling obeys the same targets. This will create `~/foo.txt` in `server1`: @@ -193,12 +162,40 @@ Absolute and `~` paths are already absolute on the target's machine, so they replace the target's directory and keep only its host. For a local directory target such as `#+TARGET: /srv/app/ (staging)` there is -no host to keep, so `:tangle /etc/foo.txt` writes to `/etc/foo.txt` — outside +no host to keep, so `:tangle /etc/foo.txt` writes to `/etc/foo.txt` outside the target directory. -### Tangling with :target nil +## Disabling with :target nil -`:target nil` behaves like `org-babel-tangle`. +Sometimes you may want to "turn off" the target for a single block. + +As an example, let's say we have a container `TARGET`: + +``` +#+TARGET: /ssh:server.com|podman:my-container: (container) +``` + +We can filter the results locally by adding `target: nil` to a second block: + +``` +* Service status :container: + +#+NAME: status +#+BEGIN_SRC sh +some-cli status --json +#+END_SRC + +#+BEGIN_SRC sh :stdin status :target nil +jq -r '.services + | to_entries[] + | select(.value.state != "running") + | "\(.key)\t\(.value.state)\t\(.value.health)"' +#+END_SRC +``` + +This will work even if the `jq` command is not installed in the container. + +Tangling with `:target nil` behaves like `org-babel-tangle`. ``` * Deploy :server1: @@ -212,8 +209,6 @@ the target directory. #+END_SRC ``` -Use `:tangle no` if you want a block not to tangle at all. - ## Drift detection Tangling pushes the org file out to its targets. `devops-drift` asks the From f1a0db694253778184285a5a697e17f4f6c0c635 Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Sun, 16 Aug 2026 14:52:31 -0600 Subject: [PATCH 6/7] Shorten README --- README.md | 26 ++++---------------------- 1 file changed, 4 insertions(+), 22 deletions(-) diff --git a/README.md b/README.md index b0d39c8..270ccb6 100644 --- a/README.md +++ b/README.md @@ -145,10 +145,11 @@ You can tangle a file to multiple servers. This will create `~/foo.txt` on both #+END_SRC ``` -### How :tangle paths are read +Given -`#+TARGET: /ssh:example1.com:/opt/app (server1)`, `:tangle` resolves -as follows: +`#+TARGET: /ssh:example1.com:/opt/app (server1)`, + +`:tangle` resolves to a path within the host: | `:tangle` | resolves to | |------------------|-------------------------------------------| @@ -158,13 +159,6 @@ as follows: | `/etc/foo.txt` | `/ssh:example1.com:/etc/foo.txt` | | `~/foo.txt` | `/ssh:example1.com:~/foo.txt` | -Absolute and `~` paths are already absolute on the target's machine, so they -replace the target's directory and keep only its host. - -For a local directory target such as `#+TARGET: /srv/app/ (staging)` there is -no host to keep, so `:tangle /etc/foo.txt` writes to `/etc/foo.txt` outside -the target directory. - ## Disabling with :target nil Sometimes you may want to "turn off" the target for a single block. @@ -197,18 +191,6 @@ This will work even if the `jq` command is not installed in the container. Tangling with `:target nil` behaves like `org-babel-tangle`. -``` -* Deploy :server1: - -#+BEGIN_SRC conf :tangle app.conf -... goes to server1 ... -#+END_SRC - -#+BEGIN_SRC yaml :target nil :tangle inventory.yaml -... stays next to the org file ... -#+END_SRC -``` - ## Drift detection Tangling pushes the org file out to its targets. `devops-drift` asks the From 5b0012a819d063b16e44dc9f96342eaa40ad5afc Mon Sep 17 00:00:00 2001 From: Kyle S Passarelli Date: Sun, 16 Aug 2026 14:53:51 -0600 Subject: [PATCH 7/7] [skip ci] Last one --- README.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/README.md b/README.md index 270ccb6..98f0680 100644 --- a/README.md +++ b/README.md @@ -187,9 +187,7 @@ jq -r '.services #+END_SRC ``` -This will work even if the `jq` command is not installed in the container. - -Tangling with `:target nil` behaves like `org-babel-tangle`. +This will work even if the `jq` command is not installed in the container :) ## Drift detection