diff options
Diffstat (limited to 'src/cuirass/base.scm')
| -rw-r--r-- | src/cuirass/base.scm | 65 |
1 files changed, 41 insertions, 24 deletions
diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index 00b58f6..c986d37 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -129,6 +129,7 @@ directory and the sha1 of the top level commit in this directory." (tag (and=> (assq-ref spec #:tag) (lambda (t) `(tag . ,t))))) + (peek "FETCHING LATEST " url) (latest-repository-commit store url #:cache-directory (%package-cachedir) #:ref (or branch commit tag)))) @@ -159,26 +160,32 @@ directory and the sha1 of the top level commit in this directory." (define (evaluate store db spec) "Evaluate and build package derivations. Return a list of jobs." - (let* ((port (open-pipe* OPEN_READ - "evaluate" - (string-append (%package-cachedir) "/" - (assq-ref spec #:name) "/" - (assq-ref spec #:load-path)) - (%guix-package-path) - (%package-cachedir) - (object->string spec) - (%package-database))) - (jobs (match (read port) - ;; If an error occured during evaluation report it, - ;; otherwise, suppose that data read from port are - ;; correct and keep things going. - ((? eof-object?) - (raise (condition - (&evaluation-error - (name (assq-ref spec #:name)))))) - (data data)))) - (close-pipe port) - jobs)) + (with-directory-excursion + (string-append (%package-cachedir) "/" + (assq-ref spec #:name)) + (let* ((command (or (string-split + (assq-ref (peek "spec" spec) #:evaluate) + #\space) + (list "evaluate" + (string-append (%package-cachedir) "/" + (assq-ref spec #:name) "/" + (assq-ref spec #:load-path)) + (%guix-package-path) + (%package-cachedir) + (object->string spec) + (%package-database)))) + (port (apply open-pipe* OPEN_READ command)) + (jobs (match (peek "RESULT: " (read port)) + ;; If an error occured during evaluation report it, + ;; otherwise, suppose that data read from port are + ;; correct and keep things going. + ((? eof-object?) + (raise (condition + (&evaluation-error + (name (assq-ref spec #:name)))))) + (data data)))) + (close-pipe port) + jobs))) (define (build-packages store db jobs) "Build JOBS and return a list of Build results." @@ -219,6 +226,14 @@ directory and the sha1 of the top level commit in this directory." ;; database potentially long after things have been built. (map register jobs)) +(define (store-jobs db jobs) + (for-each (lambda (job) + (eval-id (db-add-evaluation db eval))) + + ) + jobs)) + + (define (process-specs db jobspecs) "Evaluate and build JOBSPECS and store results in DB." (define (process spec) @@ -232,8 +247,8 @@ directory and the sha1 of the top level commit in this directory." (set-tls-certificate-locations! certs))) (receive (checkout commit) (fetch-repository store spec) - (when commit - (unless (string=? commit stamp) + (when (peek "COMMIT " commit) + (unless (string=? commit (peek "STAMP" stamp)) (copy-repository-cache checkout spec) (unless (assq-ref spec #:no-compile?) @@ -250,10 +265,12 @@ directory and the sha1 of the top level commit in this directory." (format #t "Failed to evaluate ~s specification.~%" (evaluation-error-spec-name c)) #f)) - (let* ((spec* (acons #:current-commit commit spec)) + (let* ((spec* (peek "spec*" (acons #:current-commit commit spec))) (jobs (evaluate store db spec*))) + (eval-id (db-add-evaluation db eval))) + (build-packages store db jobs)))) - (db-add-stamp db spec commit))))))) + (db-add-stamp db spec commit)) (for-each process jobspecs)) |