From 9bd9808d279274eade5494e7536a3bb37cdd112e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sun, 29 Jan 2017 11:25:13 +0100
Subject: [PATCH] cuirass: Handle git clone errors correctly.

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

* src/cuirass/base.scm (fetch-repository): Add a comment to warn
user that the function may return #f.
Return #f in git clone does not return 0.
(compile): Test if commit is not #f before testing its value.
---
 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 8a14ddc..eb670ab 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -73,7 +73,8 @@ values."
 
 (define (fetch-repository spec)
   "Get the latest version of repository specified in SPEC.  Clone repository
-if required."
+if required.
+Return the last commit sha1's on success, #f otherwise."
   (define (current-commit)
     (let* ((pipe   (open-input-pipe "git log -n1"))
            (log    (read-string pipe))
@@ -89,14 +90,14 @@ 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.
@@ -161,16 +162,17 @@ 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))