guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Initialize libgit's TLS certificate directory once and for all. 

* src/cuirass/base.scm (prepare-git): New procedure.  Body moved from...
(process-specs): ... here.  Remove it.
* bin/cuirass.in (main): Call 'prepare-git'.
This commit is contained in:
Ludovic Courtès 2018-01-22 13:04:20 +01:00
parent 1f701262e1
commit 327d7be013
2 changed files with 15 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
bin/cuirass.in
View File

@ -92,6 +92,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(host (option-ref opts 'listen "localhost"))
(interval (string->number (option-ref opts 'interval "10")))
(specfile (option-ref opts 'specifications #f)))
(prepare-git)
(with-database db
(and specfile
(let ((new-specs (save-module-excursion

25
src/cuirass/base.scm
View File

@ -46,6 +46,7 @@
compile
evaluate
build-packages
prepare-git
process-specs
set-guix-package-path!
;; Parameters.
@ -339,21 +340,23 @@ and so on. "
(format #t "success: ~a, fail: ~a\n" success fail)
results))
(define (prepare-git)
"Prepare Guile-Git's TLS support and all."
;; Catch and report git errors.
(with-git-error-handling
;; Try the 'GIT_SSL_CAINFO' or 'SSL_CERT_FILE' file first, then search the
;; 'SSL_CERT_DIR' directory.
(let ((directory (getenv "SSL_CERT_DIR"))
(file (or (getenv "GIT_SSL_CAINFO")
(getenv "SSL_CERT_FILE"))))
(when (or directory file)
(set-tls-certificate-locations! directory file)))))
(define (process-specs db jobspecs)
"Evaluate and build JOBSPECS and store results in DB."
(define (process spec)
(with-store store
(let ((stamp (db-get-stamp db spec)))
;; Catch and report git errors.
(with-git-error-handling
;; Try the 'GIT_SSL_CAINFO' or 'SSL_CERT_FILE' file first, then
;; search the 'SSL_CERT_DIR' directory.
(let ((directory (getenv "SSL_CERT_DIR"))
(file (or (getenv "GIT_SSL_CAINFO")
(getenv "SSL_CERT_FILE"))))
(when (or directory file)
(set-tls-certificate-locations! directory file)))
(receive (checkout commit)
(fetch-repository store spec)
(when commit
@ -377,7 +380,7 @@ and so on. "
(let* ((spec* (acons #:current-commit commit spec))
(jobs (evaluate store db spec*)))
(build-packages store db jobs))))
(db-add-stamp db spec commit)))))))
(db-add-stamp db spec commit))))))
(for-each process jobspecs))