From abd52046d5eefe9b7be8bc8ba04b2489cbe59ca5 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sun, 29 Jan 2017 11:25:13 +0100
Subject: base: Handle 'git clone' errors correctly.

Fixes https://notabug.org/mthl/cuirass/issues/1.

* src/cuirass/base.scm (fetch-repository): Return #f when 'git clone' fails.
(process-specs): Test if commit is not #f before using its value.

Signed-off-by: Mathieu Lirzin <mthl@gnu.org>
---
 src/cuirass/base.scm | 42 ++++++++++++++++++++++--------------------
 1 file changed, 22 insertions(+), 20 deletions(-)

diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index 2fde19b..21f53e0 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -77,7 +77,7 @@ values."
 
 (define (fetch-repository spec)
   "Get the latest version of repository specified in SPEC.  Clone repository
-if required."
+if required.  Return the last commit ID on success, #f otherwise."
   (define (current-commit)
     (let* ((pipe   (open-input-pipe "git log -n1"))
            (log    (read-string pipe))
@@ -93,14 +93,15 @@ if required."
             (branch (assq-ref spec #:branch))
             (commit (assq-ref spec #:commit))
             (tag    (assq-ref spec #:tag)))
-        (or (file-exists? name) (system* "git" "clone" url name))
-        (with-directory-excursion name
-          (and (zero? (system* "git" "fetch"))
-               (zero? (system* "git" "reset" "--hard"
-                               (or tag
-                                   commit
-                                   (string-append "origin/" branch))))
-               (current-commit)))))))
+        (and (or (file-exists? name)
+                 (zero? (system* "git" "clone" url name)))
+             (with-directory-excursion name
+               (and (zero? (system* "git" "fetch"))
+                    (zero? (system* "git" "reset" "--hard"
+                                    (or tag
+                                        commit
+                                        (string-append "origin/" branch))))
+                    (current-commit))))))))
 
 (define (compile dir)
   ;; Required for fetching Guix bootstrap tarballs.
@@ -166,17 +167,18 @@ if required."
   (define (process spec)
     (let ((commit (fetch-repository spec))
           (stamp  (db-get-stamp db spec)))
-      (unless (string=? commit stamp)
-        (unless (assq-ref spec #:no-compile?)
-          (compile (string-append (%package-cachedir) "/"
-                                  (assq-ref spec #:name))))
-        (with-store store
-          (let* ((spec* (acons #:current-commit commit spec))
-                 (jobs  (evaluate store db spec*)))
-            (unless (%use-substitutes?)
-              (set-build-options store #:use-substitutes? #f))
-            (build-packages store db jobs))))
-      (db-add-stamp db spec commit)))
+      (when commit
+        (unless (string=? commit stamp)
+          (unless (assq-ref spec #:no-compile?)
+            (compile (string-append (%package-cachedir) "/"
+                                    (assq-ref spec #:name))))
+          (with-store store
+            (let* ((spec* (acons #:current-commit commit spec))
+                   (jobs  (evaluate store db spec*)))
+              (unless (%use-substitutes?)
+                (set-build-options store #:use-substitutes? #f))
+              (build-packages store db jobs))))
+        (db-add-stamp db spec commit))))
 
   (for-each process jobspecs))
 
-- 
cgit v1.2.3