Links

devops-test.el

@@ -93,8 +93,12 @@ The directory is removed afterwards."
         (should-not (devops-unload-function))
         (should-not devops-mode)
         (should-not (advice-member-p #'devops--execute-on-target
-                                     'org-babel-execute-src-block)))
-    (devops-mode 1)))
+                                     'org-babel-execute-src-block))
+        (should-not (assoc "target" org-link-parameters)))
+    (devops-mode 1)
+    (org-link-set-parameters "target"
+                             :follow #'devops--target-link-follow
+                             :complete #'devops--target-link-complete)))
 
 ;;; Keyword parsing
 
@@ -321,6 +325,54 @@ The directory is removed afterwards."
     (devops-set-header-args-from-tags)
     (should (equal (org-entry-get nil "header-args") ":dir /srv/one/"))))
 
+;;; target: links
+
+(ert-deftest devops--target-link-destination-test ()
+  "A link joins files as tangling does, and URLs with one slash."
+  (should (equal (devops--target-link-destination "/ssh:host:" "etc/x.conf")
+                 "/ssh:host:etc/x.conf"))
+  (should (equal (devops--target-link-destination "/ssh:host:/srv" "/etc/x")
+                 "/ssh:host:/etc/x"))
+  (should (equal (devops--target-link-destination "/ssh:host:/srv" "")
+                 "/ssh:host:/srv"))
+  (should (equal (devops--target-link-destination "https://grafana.example.com/"
+                                                  "/d/abc")
+                 "https://grafana.example.com/d/abc"))
+  (should (equal (devops--target-link-destination "https://example.com" "a/b")
+                 "https://example.com/a/b")))
+
+(ert-deftest devops--target-link-resolve-test ()
+  "A link resolves its tag through the buffer's #+TARGET keywords."
+  (devops-test--with-org
+      (concat "#+TARGET: web /ssh:web1:/srv/\n"
+              "#+TARGET: dash https://dash.example.com\n")
+    (should (equal (devops--target-link-resolve "web:app/x.conf")
+                   "/ssh:web1:/srv/app/x.conf"))
+    (should (equal (devops--target-link-resolve "web") "/ssh:web1:/srv/"))
+    (should (equal (devops--target-link-resolve "dash:status")
+                   "https://dash.example.com/status"))
+    (should-error (devops--target-link-resolve "nope:x") :type 'user-error)))
+
+(ert-deftest devops-target-link-follow-test ()
+  "Following a link visits the file, or browses a URL."
+  (devops-test--with-local-target target
+    (with-temp-file (expand-file-name "x.txt" target) (insert "hi\n"))
+    (devops-test--with-org
+        (format "#+TARGET: local %s\n#+TARGET: dash https://d.example\n"
+                target)
+      (let ((org-buf (current-buffer))
+            browsed)
+        (devops--target-link-follow "local:x.txt" nil)
+        (unwind-protect
+            (should (equal buffer-file-name
+                           (expand-file-name "x.txt" target)))
+          (kill-buffer))
+        (with-current-buffer org-buf
+          (cl-letf (((symbol-function 'browse-url)
+                     (lambda (url &rest _) (setq browsed url))))
+            (devops--target-link-follow "dash:a" nil)))
+        (should (equal browsed "https://d.example/a"))))))
+
 ;;; Target/path joining
 
 (ert-deftest devops--join-target-test ()

devops.el

@@ -62,6 +62,11 @@
 ;; - `devops-drift'              (if loaded) report diff between blocks
 ;;                               and tangled files
 ;;
+;; Links:
+;;
+;; - [[target:TAG:PATH]]         PATH under TAG's target: a file, or a
+;;                               page when the target is a URL
+;;
 ;; If async is enabled (recommended)
 ;; - `devops-goto-session'       show the target's shell session
 ;; - `devops-restart-session'    kill the target's sessions
@@ -849,6 +854,47 @@ ARG, visit it in another window."
      (t
       (message "No tangle paths found.")))))
 
+(defun devops--url-p (target)
+  "Non-nil if TARGET is a URL such as https://host/ rather than a file."
+  (string-match-p "\\`[[:alpha:]][[:alnum:]+.-]*://" target))
+
+(defun devops--target-link-destination (target path)
+  "Return where a target: link to PATH under TARGET points.
+TARGET is a resolved #+TARGET value.  A URL gets PATH appended after a
+single slash; anything else is joined as `:tangle' paths are."
+  (cond
+   ((string-empty-p path) target)
+   ((devops--url-p target)
+    (concat (string-trim-right target "/") "/" (string-trim-left path "/")))
+   (t (devops--join-target target path))))
+
+(defun devops--target-link-resolve (link)
+  "Resolve LINK, the part of a target: link after the colon.
+LINK is TAG or TAG:PATH, TAG being a tag in a #+TARGET keyword of the
+current buffer."
+  (let* ((sep (string-search ":" link))
+         (tag (substring link 0 sep))
+         (path (if sep (substring link (1+ sep)) ""))
+         (target (or (devops-with-sync (devops--resolve-target-for-tag tag))
+                     (user-error "No #+TARGET for tag %s" tag))))
+    (devops--target-link-destination target path)))
+
+(defun devops--target-link-follow (link _arg)
+  "Open LINK, a target: link, in a browser if a URL or else as a file."
+  (let ((dest (devops--target-link-resolve link)))
+    (if (devops--url-p dest)
+        (browse-url dest)
+      (find-file dest))))
+
+(defun devops--target-link-complete ()
+  "Read a target: link, a #+TARGET tag then a path under it."
+  (let ((tag (completing-read "Target: " (devops-target-tag-alist) nil t)))
+    (concat "target:" tag ":" (read-string (format "Path under %s: " tag)))))
+
+(org-link-set-parameters "target"
+                         :follow #'devops--target-link-follow
+                         :complete #'devops--target-link-complete)
+
 (defun devops--ghostty-command (dir &optional env-vars)
   "Return a ghostty command line opening a shell in DIR.
 DIR may be remote, in which case ghostty runs ssh to its host.  ENV-VARS
@@ -1039,6 +1085,8 @@ block's :var arguments are exported first."
   "Turn `devops-mode' off, removing its advice before unloading.
 Return nil, so the rest of the unloading proceeds as usual."
   (devops-mode -1)
+  (setq org-link-parameters (assoc-delete-all "target" org-link-parameters))
+  (org-link-make-regexps)
   nil)
 
 (provide 'devops)

examples/1_commands.org

@@ -57,3 +57,21 @@ When you execute this, you will get a prompt to choose which server
 #+begin_src sh :results output
 ls
 #+end_src
+
+* Linking to a target
+
+A =target:= link points at a path under a target, so a link survives the
+target moving to a new host.  =C-c C-o= opens it: a file through TRAMP,
+or a browser page when the target is a URL.
+
+#+begin_example
+#+TARGET: grafana https://grafana.example.com
+
+[[target:server1:/etc/nginx/nginx.conf][nginx config on server1]]
+[[target:grafana:d/node-exporter][node dashboard]]
+#+end_example
+
+[[target:server1:/etc/nginx/nginx.conf][nginx config on server1]]
+
+=C-c C-l target: RET= picks a tag and asks for the path.
+