diff options
| -rw-r--r-- | build-aux/guix.scm | 1 | ||||
| -rw-r--r-- | configure.ac | 4 | ||||
| -rw-r--r-- | 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)) |