From a919c25328daed45a13ed98d848fb6c51617bfbb Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Mon, 31 Jul 2017 11:08:32 +0200
Subject: base: Report git errors.

* src/cuirass/base.scm (report-git-error): New procedure.
(with-git-error-handling): New macro.
(process-specs): Use with-git-error-handling to catch and report git errors.
* build-aux/guix.scm (package)[inputs]: Add guile-git.
* configure.ac: Check for (git) module. Also check that (git) exports
git-error-message procedure.
---
 build-aux/guix.scm   |  1 +
 configure.ac         |  4 ++++
 src/cuirass/base.scm | 59 ++++++++++++++++++++++++++++++++--------------------
 3 files changed, 42 insertions(+), 22 deletions(-)

diff --git a/build-aux/guix.scm b/build-aux/guix.scm
index 583ef7e..c2f6cdb 100644
--- a/build-aux/guix.scm
+++ b/build-aux/guix.scm
@@ -80,6 +80,7 @@
         '("guile@2.2"
           "guile-json"
           "guile-sqlite3"
+          "guile-git"
           "guix")))
   (native-inputs
    (map spec+package-list
diff --git a/configure.ac b/configure.ac
index d7f111c..9c6a597 100644
--- a/configure.ac
+++ b/configure.ac
@@ -48,9 +48,13 @@ AS_IF([test -z "$ac_cv_path_GUILD"],
 
 GUILE_MODULE_REQUIRED([guix])
 GUILE_MODULE_REQUIRED([guix git])
+GUILE_MODULE_REQUIRED([git])
 GUILE_MODULE_REQUIRED([json])
 GUILE_MODULE_REQUIRED([sqlite3])
 
+# We depend on new Guile-Git errors.
+GUILE_MODULE_REQUIRED_EXPORT([(git)], git-error-message)
+
 AC_CONFIG_FILES([Makefile])
 AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in],
   [chmod +x pre-inst-env])
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm
index cc3dd39..6abf871 100644
--- a/src/cuirass/base.scm
+++ b/src/cuirass/base.scm
@@ -25,6 +25,7 @@
   #:use-module (guix derivations)
   #:use-module (guix store)
   #:use-module (guix git)
+  #:use-module (git)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 popen)
@@ -92,6 +93,18 @@ values."
                 duration)
         (acons #:duration duration result)))))
 
+(define (report-git-error error)
+  "Report the given Guile-Git error."
+  (format (current-error-port)
+          "Git error: ~a~%" (git-error-message error)))
+
+(define-syntax-rule (with-git-error-handling body ...)
+  (catch 'git-error
+    (lambda ()
+      body ...)
+    (lambda (key err)
+      (report-git-error err))))
+
 (define (fetch-repository store spec)
   "Get the latest version of repository specified in SPEC.  Return two
 values: the content of the git repository at URL copied into a store
@@ -209,30 +222,32 @@ directory and the sha1 of the top level commit in this directory."
   (define (process spec)
     (with-store store
       (let ((stamp (db-get-stamp db spec)))
-        (receive (checkout commit)
-            (fetch-repository store spec)
-          (when commit
-            (unless (string=? commit stamp)
-              (copy-repository-cache checkout spec)
+        ;; Catch and report git errors.
+        (with-git-error-handling
+         (receive (checkout commit)
+             (fetch-repository store spec)
+           (when commit
+             (unless (string=? commit stamp)
+               (copy-repository-cache checkout spec)
 
-              (unless (assq-ref spec #:no-compile?)
-                (compile (string-append (%package-cachedir) "/"
-                                        (assq-ref spec #:name))))
-              ;; Always set #:keep-going? so we don't stop on the first build
-              ;; failure.
-              (set-build-options store
-                                 #:use-substitutes? (%use-substitutes?)
-                                 #:fallback? (%fallback?)
-                                 #:keep-going? #t)
+               (unless (assq-ref spec #:no-compile?)
+                 (compile (string-append (%package-cachedir) "/"
+                                         (assq-ref spec #:name))))
+               ;; Always set #:keep-going? so we don't stop on the first build
+               ;; failure.
+               (set-build-options store
+                                  #:use-substitutes? (%use-substitutes?)
+                                  #:fallback? (%fallback?)
+                                  #:keep-going? #t)
 
-              (guard (c ((evaluation-error? c)
-                         (format #t "Failed to evaluate ~s specification.~%"
-                                 (evaluation-error-spec-name c))
-                         #f))
-                (let* ((spec* (acons #:current-commit commit spec))
-                       (jobs  (evaluate store db spec*)))
-                  (build-packages store db jobs))))
-            (db-add-stamp db spec commit))))))
+               (guard (c ((evaluation-error? c)
+                          (format #t "Failed to evaluate ~s specification.~%"
+                                  (evaluation-error-spec-name c))
+                          #f))
+                 (let* ((spec* (acons #:current-commit commit spec))
+                        (jobs  (evaluate store db spec*)))
+                   (build-packages store db jobs))))
+             (db-add-stamp db spec commit)))))))
 
   (for-each process jobspecs))
 
-- 
cgit v1.2.3