diff options
| -rw-r--r-- | bin/cuirass.in | 30 | ||||
| -rw-r--r-- | src/cuirass/database.scm | 22 | ||||
| -rw-r--r-- | src/schema.sql | 6 |
3 files changed, 49 insertions, 9 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index 43f4661..9d8a39e 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -28,7 +28,8 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (guix derivations) (guix store) (ice-9 getopt-long) - (ice-9 popen)) + (ice-9 popen) + (ice-9 rdelim)) (define (show-help) (format #t "Usage: ~a [OPTIONS] SPECFILE~%" (%program-name)) @@ -54,6 +55,13 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (define (fetch-repository spec) "Get the latest version of repository specified in SPEC. Clone repository if required." + (define (current-commit) + (let* ((pipe (open-input-pipe "git log -n1")) + (log (read-string pipe)) + (commit (cadr (string-split log char-set:whitespace)))) + (close-pipe pipe) + commit)) + (let ((cachedir (%package-cachedir))) (or (file-exists? cachedir) (mkdir cachedir)) (with-directory-excursion cachedir @@ -68,7 +76,8 @@ if required." (zero? (system* "git" "reset" "--hard" (or tag commit - (string-append "origin/" branch)))))))))) + (string-append "origin/" branch)))) + (current-commit))))))) (define (compile dir) ;; Required for fetching Guix bootstrap tarballs. @@ -116,13 +125,16 @@ if required." (define (process-specs db jobspecs) "Evaluate and build JOBSPECS and store results in DB." (for-each (λ (spec) - (fetch-repository spec) - (compile (string-append (%package-cachedir) "/" - (assq-ref spec #:name))) - (with-store store - (let ((jobs (evaluate store db spec))) - (set-build-options store #:use-substitutes? #f) - (build-packages store db jobs)))) + (let ((commit (fetch-repository spec)) + (stamp (db-get-stamp db spec))) + (unless (string=? commit stamp) + (compile (string-append (%package-cachedir) "/" + (assq-ref spec #:name))) + (with-store store + (let ((jobs (evaluate store db spec))) + (set-build-options store #:use-substitutes? #f) + (build-packages store db jobs)))) + (db-add-stamp db spec commit))) jobspecs)) diff --git a/src/cuirass/database.scm b/src/cuirass/database.scm index 3b8ffb9..dbbe00a 100644 --- a/src/cuirass/database.scm +++ b/src/cuirass/database.scm @@ -29,6 +29,8 @@ db-close db-add-specification db-get-specifications + db-add-stamp + db-get-stamp evaluation-exists? db-add-evaluation db-get-evaluation @@ -188,3 +190,23 @@ INSERT INTO Builds (derivation, log, output) VALUES ('~A', '~A', '~A');" (assq-ref build #:log) (assq-ref build #:output)) (last-insert-rowid db)) + +(define (db-get-stamp db spec) + "Return a stamp corresponding to specification SPEC in database DB." + (let ((res (sqlite-exec db "SELECT * FROM Stamps WHERE specification='~A';" + (assq-ref spec #:id)))) + (match res + (() "") + ((#(spec commit)) commit)))) + +(define (db-add-stamp db spec commit) + "Associate stamp COMMIT to specification SPEC in database DB." + (if (string-null? (db-get-stamp db spec)) + (sqlite-exec db "\ +INSERT INTO Stamps (specification, stamp) VALUES ('~A', '~A');" + (assq-ref spec #:id) + commit) + (sqlite-exec db "\ +UPDATE Stamps SET stamp='~A' WHERE specification='~A';" + commit + (assq-ref spec #:id)))) diff --git a/src/schema.sql b/src/schema.sql index 9cc7167..d5c1f00 100644 --- a/src/schema.sql +++ b/src/schema.sql @@ -14,6 +14,12 @@ CREATE TABLE Specifications ( revision TEXT ); +CREATE TABLE Stamps ( + specification INTEGER NOT NULL PRIMARY KEY, + stamp TEXT NOT NULL, + FOREIGN KEY (specification) REFERENCES Specifications (id) +); + CREATE TABLE Evaluations ( derivation TEXT NOT NULL PRIMARY KEY, job_name TEXT NOT NULL, |