diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cuirass/base.scm | 65 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 9 | ||||
| -rw-r--r-- | src/schema.sql | 1 |
3 files changed, 47 insertions, 28 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)) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 31f78b1..f58a788 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -115,11 +115,11 @@ database object." (define (db-add-specification db spec) "Store specification SPEC in database DB and return its ID." (apply sqlite-exec db "\ -INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \ +INSERT OR IGNORE INTO Specifications (repo_name, url, evaluate, load_path, file, \ proc, arguments, branch, tag, revision, no_compile_p) \ - VALUES ('~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A', ~A);" + VALUES ('~A', '~A', '~A', '~A', '~A', '~S', '~S', '~A', '~A', '~A', ~A);" (append - (assq-refs spec '(#:name #:url #:load-path #:file #:proc #:arguments)) + (assq-refs spec '(#:name #:url #:evaluate #:load-path #:file #:proc #:arguments)) (assq-refs spec '(#:branch #:tag #:commit) "NULL") (list (if (assq-ref spec #:no-compile?) "1" "0")))) (last-insert-rowid db)) @@ -129,11 +129,12 @@ INSERT OR IGNORE INTO Specifications (repo_name, url, load_path, file, \ (specs '())) (match rows (() specs) - ((#(name url load-path file proc args branch tag rev no-compile?) + ((#(name url evaluate load-path file proc args branch tag rev no-compile?) . rest) (loop rest (cons `((#:name . ,name) (#:url . ,url) + (#:evaluate . ,evaluate) (#:load-path . ,load-path) (#:file . ,file) (#:proc . ,(with-input-from-string proc read)) diff --git a/src/schema.sql b/src/schema.sql index 329d89d..5cdd8c6 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -3,6 +3,7 @@ BEGIN TRANSACTION; CREATE TABLE Specifications ( repo_name TEXT NOT NULL PRIMARY KEY, url TEXT NOT NULL, + evaluate TEXT NOT NULL, load_path TEXT NOT NULL, file TEXT NOT NULL, proc TEXT NOT NULL, |