Merge pull request #15 from NinjaTrappeur/nin/do-not-create-dir-on-fa…

…ilure

[bugfix] Do not create an empty dir when git clone fails

Makefile

@@ -5,7 +5,7 @@
 EMACS ?= emacs
 
 # A space-separated list of required package names
-NEEDED_PACKAGES = package-lint seq inheritenv
+NEEDED_PACKAGES = package-lint seq inheritenv ert-async
 
 INIT_PACKAGES="(progn \
   (require 'package) \

my-repo-pins-tests.el

@@ -27,6 +27,7 @@
 ;;; Code:
 
 (require 'ert)
+(require 'ert-async)
 (require 'my-repo-pins)
 
 ;; Test Helpers
@@ -39,13 +40,14 @@ FUNC gets called with the temp dir as parameter.
 The directory gets deleted once we exit FUNC."
   (let ((temp-dir (make-temp-file "my-repo-pins-test-" t)))
     (unwind-protect
-          (funcall func (file-name-as-directory temp-dir))
+        (funcall func (file-name-as-directory temp-dir))
       (delete-directory temp-dir t))))
 
 (defun my-repo-pins--tests-init-fake-git-repo (dir)
   "Create a dummy git repo at DIR.
-
-If DIR doesn't exists, we create it first."
+If DIR doesn't exists, we create it first.
+The created git repository won't contain any tracked file nor
+commits."
   (let* ((d (file-name-as-directory dir))
          (git-process
           (progn
@@ -60,6 +62,24 @@ If DIR doesn't exists, we create it first."
       ;; before moving on.
       (while (accept-process-output git-process)))))
 
+(defun my-repo-pins--tests-init-fake-git-repo-with-commit (dir)
+  "Create a dummy git repo having a valid commit at DIR.
+If DIR doesn't exists, we create it first.
+This function is functionally similar to
+‘my-repo-pins--tests-init-fake-git-repo’, however it's more expensive
+to execute. Only use it when you need a git repository containing some
+commits."
+  (let* ((d (file-name-as-directory dir))
+         (dummy-git-repo "./tests/fixtures/dummy-git-repo"))
+    (unless (file-directory-p d) (make-directory d t))
+    ;; This is a nasty trick. We can't easily generate a git commit on
+    ;; runtime. We also can't check-in a git repository in a git
+    ;; repository.
+    ;; We rename the .git subfolder in the fixture to .git-to-rename
+    ;; to trick git into thinking this is not a git repo.
+    (copy-directory dummy-git-repo d nil nil t)
+    (rename-file (concat d "/.git-to-rename") (concat d "/.git"))))
+
 ;; Test Dirs Setup
 ;;;;;;;;;;;;;;;;;
 
@@ -271,7 +291,49 @@ For reference: a empty test root looks like this:
       ((results (my-repo-pins--get-code-root-projects "/does/not/exist" 3)))
     (should (seq-empty-p results))))
 
+;; Clone Tests
+;;;;;;;;;;;;;;
 
+(ert-deftest-async my-repo-pins--test-git-clone-in-dir-valid-url (done)
+  "Test the ‘my-repo-pins--git-clone-in-dir’ function on a valid repository URL.
+
+Note: this function is async, we can't use
+my--repo-pins--tests-with-temp-dir to create the temporary directory:
+it'll get deleted before the end of the test."
+  (let* ((tmpdir (make-temp-file "my-repo-pins-test-" t))
+         (source (concat tmpdir "/source"))
+         (destination (concat tmpdir "/destination")))
+    (make-directory source)
+    (my-repo-pins--tests-init-fake-git-repo-with-commit source)
+    (my-repo-pins--git-clone-in-dir
+     (concat "file://" source)
+     destination
+     (lambda (exit-code)
+       (message "tmpdir: %s" tmpdir)
+       (should (eq exit-code 0))
+       (should (file-exists-p (concat tmpdir "/destination/hello")))
+       (delete-directory tmpdir t)
+       (funcall done)))))
+
+(ert-deftest-async my-repo-pins--test-git-clone-in-dir-invalid-url (done)
+  "Test the ‘my-repo-pins--git-clone-in-dir’ function on a valid repository URL.
+
+Note: this function is async, we can't use
+my--repo-pins--tests-with-temp-dir to create the temporary directory:
+it'll get deleted before the end of the test."
+  (let* ((tmpdir (make-temp-file "my-repo-pins-test-" t))
+         (source (concat tmpdir "/source"))
+         (destination (concat tmpdir "/destination")))
+    (make-directory source)
+    (my-repo-pins--tests-init-fake-git-repo-with-commit source)
+    (my-repo-pins--git-clone-in-dir
+     (concat "file://" source "doesnotexists")
+     destination
+     (lambda (exit-code)
+       (should (not (eq exit-code 0)))
+       (should (not (file-exists-p (concat tmpdir "/destination"))))
+       (delete-directory tmpdir t)
+       (funcall done)))))
 ;; Test Fetchers
 ;;;;;;;;;;;;;;;;;
 
@@ -340,20 +402,6 @@ For reference: a empty test root looks like this:
   (should (equal (my-repo-pins--filepath-from-clone-url "[email protected]:NinjaTrappeur/my-repo-pins.el.git") "github.com/NinjaTrappeur/my-repo-pins.el"))
   (should (equal (my-repo-pins--filepath-from-clone-url "[email protected]:NinjaTrappeur/my-repo-pins.el") "github.com/NinjaTrappeur/my-repo-pins.el")))
 
-(ert-deftest my-repo-pins--test-git-clone-in-dir ()
-  "Test the my-repo-pins--git-clone-in-dir function."
-    (my-repo-pins--tests-run-on-testroot-1
-     (lambda (dir)
-       (let*
-           ((tmpdir (make-temp-file "my-repo-pins-test-" t))
-            (git-process (my-repo-pins--git-clone-in-dir
-                          (format "file://%s" (concat dir "example1.tld/user1/proj1/"))
-                          tmpdir)))
-         (progn
-           (while (accept-process-output git-process))
-           (should (file-exists-p (format "%s/.git" tmpdir)))
-           (delete-directory tmpdir t))))))
-
 ;;; State Management tests
 
 (ert-deftest my-repo-pins--test-init-forges-state ()

my-repo-pins.el

@@ -142,8 +142,22 @@ Returns the git PROCESS object."
 (defun my-repo-pins--git-clone-in-dir (clone-url checkout-filepath &optional callback)
   "Clone the CLONE-URL repo at CHECKOUT-FILEPATH.
 
+Call CALLBACK with the git exit code once the git subprocess exits.
+Checks first whether or not CLONE-URL is valid using
+‘my-repo-pins--git-ls-remote-in-dir’ to prevent git clone from
+creating an empty directory at CHECKOUT-FILEPATH."
+  (my-repo-pins--git-ls-remote-in-dir
+   clone-url
+   (lambda (exit-code)
+     (if (eq exit-code 0)
+         (my-repo-pins--call-git-in-dir "~/" callback "clone" clone-url checkout-filepath)
+       (funcall callback exit-code)))))
+
+(defun my-repo-pins--git-ls-remote-in-dir (clone-url &optional callback)
+  "Check if a CLONE-URL is valid using git ls-remote.
+
 Call CALLBACK with no arguments once the git subprocess exists."
-  (my-repo-pins--call-git-in-dir "~/" callback "clone" clone-url checkout-filepath))
+  (my-repo-pins--call-git-in-dir "~/" callback "ls-remote" "-q" "--exit-code" clone-url))
 
 ;;===========================
 ;; Internal: builtin fetchers
@@ -722,6 +736,25 @@ url."
                         (find-file dest-dir)))))))
         (clone-ssh))))
 
+(defun my-repo-pins--clone-from-full-url (full-url &optional callback)
+  "Clone a repository from a fully-qualified FULL-URL git URL.
+
+CALLBACK is called once the git process exited. It takes a single
+exit-code parameter containing the process exit code."
+  (let*
+      ((code-root (my-repo-pins--safe-get-code-root))
+       (dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url full-url))))
+    (if (not (file-directory-p dest-dir))
+        (my-repo-pins--git-clone-in-dir
+         full-url
+         dest-dir
+         (lambda (exit-code)
+           (if callback
+               (funcall callback exit-code))
+           (if (equal exit-code 0)
+               (find-file dest-dir)
+             (error "Cannot clone %s" full-url))))
+      (error "%s does not seem to be a valid git repository URL " full-url))))
 
 ;;=========================================
 ;; Internal: improving builtin autocomplete
@@ -768,9 +801,7 @@ USER-QUERY was the original query for this state update."
 
 
 (defun my-repo-pins--query-forge-fetchers (repo-query)
-  "Find repo matches to the relevant forges for REPO-QUERY then query forge.
-
-TODO: split that mess before 1.0. We shouldn't query here."
+  "Find repo matches to the relevant forges for REPO-QUERY then query forge."
   (let* ((parsed-repo-query (my-repo-pins--parse-repo-identifier repo-query))
          (repo-query-kind (alist-get 'tag parsed-repo-query)))
     (cond
@@ -790,19 +821,7 @@ TODO: split that mess before 1.0. We shouldn't query here."
                         (my-repo-pins--update-forges-state ,forge-str new-state ,repo-query)))))))
        my-repo-pins-forge-fetchers))
      ((equal repo-query-kind 'repo) (user-error "Can't checkout %s (for now), please specify a owner" repo-query))
-     ((equal repo-query-kind 'full-url)
-      (let*
-          ((code-root (my-repo-pins--safe-get-code-root))
-           (dest-dir (concat code-root (my-repo-pins--filepath-from-clone-url repo-query))))
-        (if (not (file-directory-p dest-dir))
-            (my-repo-pins--git-clone-in-dir
-             repo-query
-             dest-dir
-             (lambda (exit-code)
-               (if (equal exit-code 0)
-                   (find-file dest-dir)
-                 (error "Cannot clone %s" repo-query))))
-          (find-file dest-dir))))
+     ((equal repo-query-kind 'full-url) (my-repo-pins--clone-from-full-url repo-query))
      (t (error repo-query-kind)))))
 
 ;;=====================

tests/fixtures/dummy-git-repo/.git-to-rename/COMMIT_EDITMSG

@@ -0,0 +1,11 @@
+hello world
+# Veuillez saisir le message de validation pour vos modifications. Les lignes
+# commençant par '#' seront ignorées, et un message vide abandonne la validation.
+#
+# Sur la branche master
+#
+# Validation initiale
+#
+# Modifications qui seront validées :
+#	nouveau fichier : hello
+#

tests/fixtures/dummy-git-repo/.git-to-rename/HEAD

@@ -0,0 +1 @@
+ref: refs/heads/master

tests/fixtures/dummy-git-repo/.git-to-rename/config

@@ -0,0 +1,5 @@
+[core]
+	repositoryformatversion = 0
+	filemode = true
+	bare = false
+	logallrefupdates = true

tests/fixtures/dummy-git-repo/.git-to-rename/description

@@ -0,0 +1 @@
+Unnamed repository; edit this file 'description' to name the repository.

tests/fixtures/dummy-git-repo/.git-to-rename/hooks/applypatch-msg.sample

@@ -0,0 +1,15 @@
+#!/nix/store/y0g1mvsr6vygr61f9znljik9kl0x0inc-bash-5.1-p16/bin/bash
+#
+# An example hook script to check the commit log message taken by
+# applypatch from an e-mail message.
+#
+# The hook should exit with non-zero status after issuing an
+# appropriate message if it wants to stop the commit.  The hook is
+# allowed to edit the commit message file.
+#
+# To enable this hook, rename this file to "applypatch-msg".
+
+. git-sh-setup
+commitmsg="$(git rev-parse --git-path hooks/commit-msg)"
+test -x "$commitmsg" && exec "$commitmsg" ${1+"$@"}
+:

tests/fixtures/dummy-git-repo/.git-to-rename/hooks/commit-msg.sample

@@ -0,0 +1,24 @@
+#!/nix/store/y0g1mvsr6vygr61f9znljik9kl0x0inc-bash-5.1-p16/bin/bash
+#
+# An example hook script to check the commit log message.
+# Called by "git commit" with one argument, the name of the file
+# that has the commit message.  The hook should exit with non-zero
+# status after issuing an appropriate message if it wants to stop the
+# commit.  The hook is allowed to edit the commit message file.
+#
+# To enable this hook, rename this file to "commit-msg".
+
+# Uncomment the below to add a Signed-off-by line to the message.
+# Doing this in a hook is a bad idea in general, but the prepare-commit-msg
+# hook is more suited to it.
+#
+# SOB=$(git var GIT_AUTHOR_IDENT | sed -n 's/^\(.*>\).*$/Signed-off-by: \1/p')
+# grep -qs "^$SOB" "$1" || echo "$SOB" >> "$1"
+
+# This example catches duplicate Signed-off-by lines.
+
+test "" = "$(grep '^Signed-off-by: ' "$1" |
+	 sort | uniq -c | sed -e '/^[ 	]*1[ 	]/d')" || {
+	echo >&2 Duplicate Signed-off-by lines.
+	exit 1
+}