fix(vc): harden clipboard git-clone process and path handling

cj/git-clone-clipboard-url shelled out via shell-command and derived the clone directory with file-name-nondirectory, which mishandles scp-style SSH URLs with no slash (git@host:repo.git became git@host:repo). It also ran git in default-directory and only checked whether the clone dir appeared afterward, so a failed clone was silent.

The clone now runs as a direct git process (call-process, no shell) with clone -- url dir so a URL beginning with - cannot be read as a flag. The destination path comes from cj/--git-clone-dir-name, which takes the last component splitting on / and :, handling HTTPS, scp-style and ssh:// SSH, and local paths. It validates the clipboard is non-empty and the target is a writable directory that does not already contain the destination, and surfaces a non-zero git exit as a user-error with the *git-clone* output. Tests cover the deriver across URL schemes plus the empty-clipboard and clone-failure paths.

2 files changed, 122 insertions, 13 deletions

diff --git a/modules/vc-config.el b/modules/vc-config.el
index c76e714e..45aec73b 100644
--- a/modules/vc-config.el
+++ b/modules/vc-config.el
@@ -137,6 +137,17 @@ interactive selection to jump to any changed line in the buffer."
 ;; Quick git clone from clipboard URL
 ;; Based on: https://xenodium.com/bending-emacs-episode-3-git-clone-the-lazy-way
 
+(defun cj/--git-clone-dir-name (url)
+  "Return the repository directory name implied by git clone URL.
+Handles HTTPS, scp-style SSH (git@host:user/repo.git or host:repo.git),
+ssh:// URLs, and local paths by taking the last path component — splitting
+on both `/' and `:' so scp-style URLs without a `/' work — and stripping a
+trailing .git.  `file-name-nondirectory' alone mishandles the colon-only
+scp form."
+  (let* ((trimmed (string-trim url))
+         (last (car (last (split-string trimmed "[/:]" t)))))
+    (and last (file-name-sans-extension last))))
+
 (defun cj/git-clone-clipboard-url (url target-dir)
   "Clone git repository from clipboard URL to TARGET-DIR.
 
@@ -144,7 +155,11 @@ With no prefix argument: uses first directory in `cj/git-clone-dirs'.
 With \\[universal-argument]: choose from `cj/git-clone-dirs'.
 With \\[universal-argument] \\[universal-argument]: choose any directory.
 
-After cloning, opens the repository's README file if found."
+Clones with a direct `git' process (no shell), into a path derived
+robustly from URL.  Aborts with a clear message when the clipboard is
+empty, the target is not a writable directory, the destination already
+exists, or `git' exits non-zero.  After a successful clone, opens the
+repository's README if found, else `dired's the clone."
   (interactive
    (list (current-kill 0)  ;; Get URL from clipboard
          (cond
@@ -157,20 +172,26 @@ After cloning, opens the repository's README file if found."
           ;; No prefix: Use default (first in list)
           (t (car cj/git-clone-dirs)))))
 
-  (let* ((default-directory target-dir)
-         (repo-name (file-name-sans-extension
-                     (file-name-nondirectory url)))
-         (clone-dir (expand-file-name repo-name target-dir)))
-
-    ;; Clone the repository
-    (message "Cloning %s to %s..." url target-dir)
-    (shell-command (format "git clone %s" (shell-quote-argument url)))
-
-    ;; Find and open README
-    (when (file-directory-p clone-dir)
+  (let ((url (string-trim (or url ""))))
+    (when (string-empty-p url)
+      (user-error "Clipboard does not contain a URL to clone"))
+    (unless (and (file-directory-p target-dir) (file-writable-p target-dir))
+      (user-error "Clone target is not a writable directory: %s" target-dir))
+    (let ((clone-dir (expand-file-name (cj/--git-clone-dir-name url) target-dir)))
+      (when (file-exists-p clone-dir)
+        (user-error "Clone destination already exists: %s" clone-dir))
+      (message "Cloning %s into %s..." url clone-dir)
+      ;; Direct process, no shell.  `--' stops option parsing so a URL
+      ;; beginning with `-' can't be read as a git flag.
+      (let ((status (call-process "git" nil "*git-clone*" nil
+                                  "clone" "--" url clone-dir)))
+        (unless (zerop status)
+          (pop-to-buffer "*git-clone*")
+          (user-error "git clone failed (exit %d); see *git-clone*" status)))
+      ;; Find and open README
       (let ((readme (seq-find
                      (lambda (file)
-                       (string-match-p "^README" (upcase file)))
+                       (string-match-p "\\`README" (upcase file)))
                      (directory-files clone-dir))))
         (if readme
             (find-file (expand-file-name readme clone-dir))
diff --git a/tests/test-vc-config--git-clone.el b/tests/test-vc-config--git-clone.el
new file mode 100644
index 00000000..3b39ece2
--- /dev/null
+++ b/tests/test-vc-config--git-clone.el
@@ -0,0 +1,88 @@
+;;; test-vc-config--git-clone.el --- Tests for clipboard git-clone hardening -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Unit tests for cj/--git-clone-dir-name (robust repo-dir derivation across
+;; HTTPS, scp-style SSH, ssh:// and local URLs) and for cj/git-clone-clipboard-url
+;; reporting a failed clone from the process exit status instead of silently
+;; assuming the directory appeared.
+
+;;; Code:
+
+(require 'ert)
+(require 'cl-lib)
+
+(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory))
+(require 'vc-config)
+
+;;; cj/--git-clone-dir-name — Normal Cases
+
+(ert-deftest test-vc-git-clone-dir-name-https-with-git-suffix ()
+  "Normal: an HTTPS URL with a .git suffix yields the bare repo name."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "https://example.com/user/repo.git"))))
+
+(ert-deftest test-vc-git-clone-dir-name-https-without-git-suffix ()
+  "Normal: an HTTPS URL without a .git suffix yields the bare repo name."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "https://example.com/user/repo"))))
+
+(ert-deftest test-vc-git-clone-dir-name-ssh-scp-with-user ()
+  "Normal: scp-style SSH with a user path yields the repo name."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "git@example.com:user/repo.git"))))
+
+(ert-deftest test-vc-git-clone-dir-name-ssh-url-scheme ()
+  "Normal: an ssh:// URL yields the repo name."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "ssh://git@example.com/user/repo.git"))))
+
+;;; Boundary Cases
+
+(ert-deftest test-vc-git-clone-dir-name-ssh-scp-without-user ()
+  "Boundary: scp-style SSH with no user path (host:repo.git) still works.
+This is the case the old file-name-nondirectory derivation got wrong,
+since there is no `/' separator."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "git@example.com:repo.git"))))
+
+(ert-deftest test-vc-git-clone-dir-name-local-path ()
+  "Boundary: a local filesystem path yields the repo name."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "/home/me/src/repo.git"))))
+
+(ert-deftest test-vc-git-clone-dir-name-trailing-slash ()
+  "Boundary: a trailing slash does not swallow the repo name."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "https://example.com/user/repo.git/"))))
+
+(ert-deftest test-vc-git-clone-dir-name-surrounding-whitespace ()
+  "Boundary: clipboard whitespace around the URL is trimmed."
+  (should (equal "repo"
+                 (cj/--git-clone-dir-name "  https://example.com/user/repo.git\n"))))
+
+;;; cj/git-clone-clipboard-url — Error Cases
+
+(ert-deftest test-vc-git-clone-clipboard-url-reports-clone-failure ()
+  "Error: a nonzero git exit status surfaces a user-error, not silence.
+Uses a real writable temp dir as the target (so the file predicates run
+for real) and mocks only the clone process to fail."
+  (let ((target (make-temp-file "cj-clone-fail-" t)))
+    (unwind-protect
+        (cl-letf (((symbol-function 'call-process) (lambda (&rest _) 128))
+                  ((symbol-function 'pop-to-buffer) #'ignore)
+                  ((symbol-function 'message) #'ignore))
+          (should-error
+           (cj/git-clone-clipboard-url "https://example.com/user/repo.git" target)
+           :type 'user-error))
+      (delete-directory target t))))
+
+(ert-deftest test-vc-git-clone-clipboard-url-empty-clipboard-errors ()
+  "Error: an empty clipboard URL aborts before any clone attempt."
+  (let ((cloned nil))
+    (cl-letf (((symbol-function 'call-process)
+               (lambda (&rest _) (setq cloned t) 0)))
+      (should-error (cj/git-clone-clipboard-url "   " "/tmp") :type 'user-error))
+    (should-not cloned)))
+
+(provide 'test-vc-config--git-clone)
+;;; test-vc-config--git-clone.el ends here