aboutsummaryrefslogtreecommitdiff
path: root/modules/vc-config.el
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-24 04:27:54 -0500
committerCraig Jennings <c@cjennings.net>2026-05-24 04:27:54 -0500
commit35e4d70116c8a2a5b82eaf4b8c58889dc02cbe46 (patch)
treee3a9a35d84d307b364741423d22221954886ff55 /modules/vc-config.el
parent49038c418ead0adc83ffc8fce43c0cb6da9813df (diff)
downloaddotemacs-35e4d70116c8a2a5b82eaf4b8c58889dc02cbe46.tar.gz
dotemacs-35e4d70116c8a2a5b82eaf4b8c58889dc02cbe46.zip
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.
Diffstat (limited to 'modules/vc-config.el')
-rw-r--r--modules/vc-config.el47
1 files changed, 34 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))