mirrors
/
cuirass
mirror of https://notabug.org/mthl/cuirass.git
1
0
Fork 0
Code Issues Releases Wiki Activity

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.
pull/4/head
Mathieu Othacehe 2017-01-29 11:25:13 +01:00
parent d0a5801e39
commit 9bd9808d27
1 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/cuirass/base.scm
View File

@ -73,7 +73,8 @@ values."
(define (fetch-repository spec) (define (fetch-repository spec)
"Get the latest version of repository specified in SPEC. Clone repository "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) (define (current-commit)
(let* ((pipe (open-input-pipe "git log -n1")) (let* ((pipe (open-input-pipe "git log -n1"))
(log (read-string pipe)) (log (read-string pipe))
@ -89,14 +90,14 @@ if required."
(branch (assq-ref spec #:branch)) (branch (assq-ref spec #:branch))
(commit (assq-ref spec #:commit)) (commit (assq-ref spec #:commit))
(tag (assq-ref spec #:tag))) (tag (assq-ref spec #:tag)))
(or (file-exists? name) (system* "git" "clone" url name)) (and (or (file-exists? name) (zero? (system* "git" "clone" url name)))
(with-directory-excursion name (with-directory-excursion name
(and (zero? (system* "git" "fetch")) (and (zero? (system* "git" "fetch"))
(zero? (system* "git" "reset" "--hard" (zero? (system* "git" "reset" "--hard"
(or tag (or tag
commit commit
(string-append "origin/" branch)))) (string-append "origin/" branch))))
(current-commit))))))) (current-commit))))))))
(define (compile dir) (define (compile dir)
;; Required for fetching Guix bootstrap tarballs. ;; Required for fetching Guix bootstrap tarballs.
@ -161,16 +162,17 @@ if required."
(define (process spec) (define (process spec)
(let ((commit (fetch-repository spec)) (let ((commit (fetch-repository spec))
(stamp (db-get-stamp db spec))) (stamp (db-get-stamp db spec)))
(unless (string=? commit stamp) (when commit
(unless (assq-ref spec #:no-compile?) (unless (string=? commit stamp)
(compile (string-append (%package-cachedir) "/" (unless (assq-ref spec #:no-compile?)
(assq-ref spec #:name)))) (compile (string-append (%package-cachedir) "/"
(with-store store (assq-ref spec #:name))))
(let* ((spec* (acons #:current-commit commit spec)) (with-store store
(jobs (evaluate store db spec*))) (let* ((spec* (acons #:current-commit commit spec))
(unless (%use-substitutes?) (jobs (evaluate store db spec*)))
(set-build-options store #:use-substitutes? #f)) (unless (%use-substitutes?)
(build-packages store db jobs)))) (set-build-options store #:use-substitutes? #f))
(db-add-stamp db spec commit))) (build-packages store db jobs))))
(db-add-stamp db spec commit))))
(for-each process jobspecs)) (for-each process jobspecs))